...
 
Commits (4)
......@@ -70,6 +70,8 @@ Home/end
+ If the box is accepting text input, move the caret.
+ If choicematic is active in that box, move the highlight.
+ If the box is freely scrollable, scroll the box to top or bottom.
- If mouseoverables without -mouseonly exist, find the closest above or
below to the left from current mousexy and move the cursor there.
Ctrl+Home/end
- If textboxes are hidden, ignore.
......@@ -81,6 +83,8 @@ Pageup/pagedown
- For each box from topmost...
+ If choicematic is active in that box, move the highlight.
+ If the box is freely scrollable, scroll the box by a pageful.
- If mouseoverables without -mouseonly exist, find the closest above or
below to the right from current mousexy and move the cursor there.
Cursor keys left/right
- If textboxes are hidden, ignore.
......@@ -196,6 +200,8 @@ Confirm button (low position)
Cancel button (right position)
- If skip seen text mode is enabled, disable it.
- If textboxes are hidden, make them visible.
- If metastate is showing the metainfo box, remove the box and return to
normal metastate.
- If the game transcript is visible, pop out the box.
- If choicematic is active, and not on top choice level, go up a level.
- If a pageable box needs to show more content, scroll the box.
......@@ -206,6 +212,8 @@ Cancel button (right position)
Menu button (high position)
- If skip seen text mode is enabled, disable it.
- If textboxes are hidden, make them visible.
- If metastate is showing the metainfo box, remove the box and return to
normal metastate.
- If the game transcript is visible, pop out the box.
- If an esc-interrupt is defined, trigger it.
- If metastate is normal, enter the metamenu metastate.
......@@ -226,15 +234,15 @@ Left/Right/Up/Down
Left stick
- If textboxes are hidden, ignore.
- For each box from topmost...
+ If choicematic is active in this box and has more than one column, and the
stick points predominantly left or right, move the highlight. Delay between
moves depends on stick position, with 1000ms at center, 120ms? at extreme.
+ If choicematic is active in this box, and the stick points predominantly up
or down, move the highlight. Delay appropriately.
- If still delaying after a previous stick action, ignore.
- If choicematic is active and the choice box is visible...
+ If the box has more than one column, and the stick points predominantly left
or right, move the highlight. Delay between moves is a constant 400ms for
first, 160ms for subsequent.
+ If the stick points predominantly up or down, move the highlight. Same delay.
- If mouseoverables without -mouseonly exist, find the closest in the pointed
direction from current mousexy and mouseon it, mouseoffing current overable
if any.
if any. Same delay.
- If a script polls the cursor key state for purposes of continuous movement,
the left stick's position is used.
(Actual cursor keys are checked first, then pad direction buttons, only
......@@ -242,12 +250,13 @@ Left stick
-32k to +32k, where cursor keys and direction buttons are always at digital
extremes; the script can decide how to interpret the value for itself.)
- For each box from topmost...
+ If the box is freely scrollable, scroll the box up/down.
+ If the box is freely scrollable, scroll the box up/down. Scroll speed should
use squared stick values for best precision.
Right stick
- If textboxes are hidden, ignore.
- For each box from topmost...
+ If the box is freely scrollable, scroll the box up/down.
+ If the box is freely scrollable, scroll the box up/down; squared stick values.
Mouse
......
......@@ -122,7 +122,6 @@ end;
procedure MainLoop;
var tickcount, tickmark : ptruint;
i : dword;
begin
tickmark := GetMsecTime;
while TRUE do begin
......@@ -139,18 +138,10 @@ begin
if sysvar.pauseState = PS_PAUSED then tickcount := 0;
// Process timer events, if any.
if (length(event.timer) <> 0) and (tickcount <> 0) then
for i := 0 to high(event.timer) do
with event.timer[i] do begin
inc(timerCounter, tickcount);
while timerCounter >= triggerFreq do begin
dec(timerCounter, triggerFreq);
TFiber.Create(triggerLabel, '');
end;
end;
if tickcount <> 0 then Eventmatic.AdvanceTimers(tickcount);
// User input etc.
event.hasTriggeredInterrupt := FALSE;
Eventmatic.hasTriggeredInterrupt := FALSE;
sysvar.keysDown := 0;
while KeyPressed do HandleConEvent(ReadKey);
if sakuparam.autoTest then UserInput_Auto;
......@@ -220,10 +211,11 @@ begin
// Free whatever other memory was reserved.
if seengfxp <> NIL then begin freemem(seengfxp); seengfxp := NIL; end;
Savematic.Destroy;
EffectHub.Destroy;
FiberHub.Destroy;
GobHub.Destroy;
SetNumViewports(0);
Viewportmatic.Destroy;
// Print out the error message if exiting unnaturally.
if (erroraddr <> NIL) or (exitcode <> 0) then begin
......
......@@ -396,7 +396,6 @@ end;
procedure MainLoop;
var evd : TSDL_event;
tickcount, tickmark : ptruint;
i : dword;
begin
tickmark := SDL_GetTicks;
while TRUE do begin
......@@ -413,18 +412,10 @@ begin
if sysvar.pauseState = PS_PAUSED then tickcount := 0;
// Process timer events, if any.
if (length(event.timer) <> 0) and (tickcount <> 0) then
for i := high(event.timer) downto 0 do
with event.timer[i] do begin
inc(timercounter, tickcount);
while timercounter >= triggerfreq do begin
dec(timercounter, triggerfreq);
TFiber.Create(triggerlabel, '');
end;
end;
if tickcount <> 0 then Eventmatic.AdvanceTimers(tickcount);
// User input etc.
event.hasTriggeredInterrupt := FALSE;
Eventmatic.hasTriggeredInterrupt := FALSE;
sysvar.swallowRemainingUserInput := FALSE;
while SDL_PollEvent(@evd) <> 0 do HandleSDLevent(@evd);
with sysvar do begin
......@@ -520,10 +511,11 @@ begin
// Free whatever other memory was reserved.
if seengfxp <> NIL then begin freemem(seengfxp); seengfxp := NIL; end;
Savematic.Destroy;
EffectHub.Destroy;
FiberHub.Destroy;
GobHub.Destroy;
SetNumViewports(0);
Viewportmatic.Destroy;
// Print out the error message if exiting unnaturally.
if (erroraddr <> NIL) or (exitcode <> 0) then begin
......
......@@ -319,6 +319,8 @@ type TBoxHub = object
procedure PrintTranscriptBuffer;
procedure SetNumberOfTextBoxes(newnumber : longint);
procedure TextBoxer(tickcount : dword);
function Serialise(var outbuf : pointer) : dword;
procedure Deserialise(inbuf : pointer; bufbytes : dword);
procedure Destroy;
end;
......
......@@ -350,6 +350,14 @@ begin
end;
end;
function TBoxHub.Serialise(var outbuf : pointer) : dword;
begin
end;
procedure TBoxHub.Deserialise(inbuf : pointer; bufbytes : dword);
begin
end;
procedure TBoxHub.Destroy;
var i : dword;
begin
......
......@@ -70,6 +70,8 @@ type TChoicematic = object
procedure AddToChoiceList(const addtxt : array of UTF8string; index : longint; const jumplist, trackvar : UTF8string);
procedure RemoveFromChoiceList(removetxt : UTF8string);
procedure ToggleChoices(txt : UTF8string; avail : boolean);
function Serialise(var outbuf : pointer) : dword;
procedure Deserialise(inbuf : pointer; bufbytes : dword);
end;
var Choicematic : TChoicematic;
......@@ -542,3 +542,12 @@ begin
choiceList[i].disabledLock := choiceList[i].disabledLock or 2;
end;
end;
function TChoicematic.Serialise(var outbuf : pointer) : dword;
begin
end;
procedure TChoicematic.Deserialise(inbuf : pointer; bufbytes : dword);
begin
end;
......@@ -189,7 +189,7 @@ type
{$include sakufiber-header.pas}
{$include sakuevents.pas}
{$include sakueventmatic-header.pas}
// Commandline parameters.
var sakuparam : record
......@@ -382,44 +382,34 @@ begin
// We'll start with 16 variable buckets, plenty for most purposes.
VarmonInit(length(languageList), 16);
// Reset effects.
EffectHub.Reset;
// Reset viewports.
SetNumViewports(1);
// Stop accepting SDL text input, if appropriate.
{$ifndef sakucon}
if SDL_IsTextInputActive = SDL_TRUE then SDL_StopTextInput;
{$endif}
// Reset state variables.
sysvar.pauseState := PS_NORMAL;
sysvar.metaState := MS_NORMAL;
with gamevar do begin
defaultTextbox := 1;
dialogueTitleBox := 1;
defaultViewport := 0;
activeTextInput := 0;
end;
Choicematic.Init;
sysvar.pauseState := PS_NORMAL;
sysvar.metaState := MS_NORMAL;
// Reset events.
ResetEvents;
EffectHub.Reset;
Viewportmatic.SetNumViewports(1);
Choicematic.Init;
Eventmatic.ResetEvents;
// Reset fibers.
if FiberHub.fiberCount <> 0 then with FiberHub do begin
for i := fiberCount - 1 downto 0 do fiber[i].Destroy;
setlength(fiber, 0);
fiberCount := 0;
end;
// Reset gobs.
GobHub.Destroy;
setlength(GobHub.gob, 12);
// Textboxes.
BoxHub.SetNumberOfTextBoxes(3);
for i := 0 to 2 do TTextBox.Create(i);
......
......@@ -118,6 +118,8 @@ type TEffectHub = object
procedure Reset;
procedure Update(tickcount : dword);
function Serialise(var outbuf : pointer) : dword;
procedure Deserialise(inbuf : pointer; bufbytes : dword);
procedure Destroy;
end;
......
......@@ -43,6 +43,14 @@ begin
end;
end;
function TEffectHub.Serialise(var outbuf : pointer) : dword;
begin
end;
procedure TEffectHub.Deserialise(inbuf : pointer; bufbytes : dword);
begin
end;
procedure TEffectHub.Destroy;
begin
Log('Destroying effect hub');
......
......@@ -17,29 +17,29 @@
{ along with SuperSakura. If not, see <https://www.gnu.org/licenses/>. }
{ }
var event : record
type TEventMatic = object
// Various callbacks triggered by user action or by timer.
// Must be separated by type for most efficient iteration.
area : array of record
namu : UTF8string;
inViewport : dword;
eventArea : array of record
eventName : UTF8string;
areaInViewport : dword;
areaLoc : TEdgeCoords; // 32k relative to viewport, pixel value relative to game window
centerPoint : TCoordP; // precalculated area center, pixel value relative to game window
triggerLabel, mouseOnLabel, mouseOffLabel : UTF8string;
state : byte; // 1 if currently overed, 0 if not
eventState : byte; // 1 if currently overed, 0 if not
mouseOnly : boolean;
end;
gob : array of record
namu : UTF8string;
eventGob : array of record
eventName : UTF8string;
gobNamu : UTF8string;
gobNum : dword;
triggerLabel, mouseOnLabel, mouseOffLabel : UTF8string;
state : byte; // 1 if currently overed, 0 if not
eventState : byte; // 1 if currently overed, 0 if not
mouseOnly : boolean;
end;
timer : array of record
namu : UTF8string;
triggerFreq : dword; // timers trigger every x msecs
eventTimer : array of record
eventName : UTF8string;
triggerPeriod : dword; // timers trigger every x msecs
timerCounter : dword; // accumulates every frame
triggerLabel : UTF8string; // on trigger, this is run in a new fiber
end;
......@@ -50,14 +50,20 @@ var event : record
triggerLabel : UTF8string;
end;
hasTriggeredInterrupt : boolean; // TRUE if an interrupt was triggered this frame
end;
procedure ResetEvents;
begin
setlength(event.area, 0);
setlength(event.gob, 0);
setlength(event.timer, 0);
event.normalInterrupt.triggerLabel := '';
event.escInterrupt.triggerLabel := '';
procedure AddAreaEvent(name : UTF8string; inviewport : dword; locx, locy : longint; sizex, sizey : dword;
_triggerlabel, _mouseonlabel, _mouseofflabel : UTF8string; _mouseonly : boolean);
procedure AddGobEvent(name, gobname : UTF8string; _gobnum : dword;
_triggerlabel, _mouseonlabel, _mouseofflabel : UTF8string; _mouseonly : boolean);
procedure AddTimerEvent(name : UTF8string; _triggerperiod : dword; _triggerlabel : UTF8string);
procedure CheckOverables;
function TriggerOverables(usingmouse : boolean) : dword;
procedure AdvanceTimers(tickcount : dword);
procedure ResetEvents;
procedure Remove(name : UTF8string);
function Serialise(var outbuf : pointer) : dword;
procedure Deserialise(inbuf : pointer; bufbytes : dword);
end;
var Eventmatic : TEventmatic;
{ }
{ Copyright 2009 :: Kirinn Bunnylin / Mooncore }
{ }
{ This file is part of SuperSakura. }
{ }
{ SuperSakura is free software: you can redistribute it and/or modify }
{ it under the terms of the GNU General Public License as published by }
{ the Free Software Foundation, either version 3 of the License, or }
{ (at your option) any later version. }
{ }
{ SuperSakura is distributed in the hope that it will be useful, }
{ but WITHOUT ANY WARRANTY; without even the implied warranty of }
{ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the }
{ GNU General Public License for more details. }
{ }
{ You should have received a copy of the GNU General Public License }
{ along with SuperSakura. If not, see <https://www.gnu.org/licenses/>. }
{ }
procedure TEventmatic.AddAreaEvent(name : UTF8string; inviewport : dword; locx, locy : longint; sizex, sizey : dword;
_triggerlabel, _mouseonlabel, _mouseofflabel : UTF8string; _mouseonly : boolean);
begin
setlength(eventArea, length(eventArea) + 1);
with eventArea[high(eventArea)] do begin
eventName := upcase(name);
areaInViewport := inviewport;
areaLoc.left := locx;
areaLoc.right := locx + longint(sizex);
areaLoc.top := locy;
areaLoc.bottom := locy + longint(sizey);
areaLoc.DerivePixelsFrom32k(viewport[areaInViewport].viewportSizeP);
centerPoint.x := (areaLoc.leftp + areaLoc.rightp) div 2;
centerPoint.y := (areaLoc.topp + areaLoc.bottomp) div 2;
triggerLabel := _triggerlabel;
mouseOnLabel := _mouseonlabel;
mouseOffLabel := _mouseofflabel;
eventState := 0;
mouseOnly := _mouseonly;
end;
end;
procedure TEventmatic.AddGobEvent(name, gobname : UTF8string; _gobnum : dword;
_triggerlabel, _mouseonlabel, _mouseofflabel : UTF8string; _mouseonly : boolean);
begin
setlength(eventGob, length(eventGob) + 1);
with eventGob[high(eventGob)] do begin
eventName := name;
gobNamu := gobname;
gobNum := _gobnum;
triggerLabel := _triggerlabel;
mouseOnLabel := _mouseonlabel;
mouseOffLabel := _mouseofflabel;
eventState := 0;
mouseOnly := _mouseonly;
end;
end;
procedure TEventmatic.AddTimerEvent(name : UTF8string; _triggerperiod : dword; _triggerlabel : UTF8string);
begin
setlength(eventTimer, length(eventTimer) + 1);
with eventTimer[high(eventTimer)] do begin
eventName := name;
triggerPeriod := _triggerperiod;
timercounter := 0;
triggerLabel := _triggerlabel;
end;
end;
procedure TEventmatic.CheckOverables;
// Checks if the current mouse cursor location is over any overable areas or gobs. Spawns mouseon and mouseoff fibers
// appropriately.
var i : dword;
overnewarea : boolean = FALSE;
overnewgob : boolean = FALSE;
begin
// Check mouseoverable areas.
if length(eventArea) <> 0 then
for i := high(eventArea) downto 0 do with eventArea[i] do begin
if (sysvar.mouseLocP.x >= areaLoc.leftp) and (sysvar.mouseLocP.x < areaLoc.rightp)
and (sysvar.mouseLocP.y >= areaLoc.topp) and (sysvar.MouseLocP.y < areaLoc.bottomp)
then begin
// Area is being overed!
if eventState = 0 then begin
// It wasn't overed before, so prepare to trigger mouseon.
eventState := 1;
if mouseOnLabel <> '' then begin
overnewarea := TRUE;
eventState := 2;
end;
end;
end
else begin
// Area is not being overed!
if eventState <> 0 then begin
// It was overed before, so trigger mouseoff.
eventState := 0;
if mouseOffLabel <> '' then TFiber.Create(mouseOffLabel, '');
end;
end;
end;
// Check mouseoverable gobs.
if length(eventGob) <> 0 then for i := high(eventGob) downto 0 do with eventGob[i] do
with GobHub.gob[gobNum] do begin
// Check if the cursor is over the gob.
if (sysvar.mouseLocP.x >= gobLoc.xp) and (sysvar.mouseLocP.x < gobLoc.xp + longint(gobSizeP.w))
and (sysvar.mouseLocP.y >= gobLoc.yp) and (sysvar.mouseLocP.y < gobLoc.yp + longint(gobSizeP.h))
then begin
// Gob is being overed!
if eventState = 0 then begin
// It wasn't overed before, so prepare to trigger mouseon.
eventState := 1;
if mouseOnLabel <> '' then begin
overnewgob := TRUE;
eventState := 2;
end;
end;
end
else begin
// Gob is not being overed!
if eventState <> 0 then begin
// It was overed before, so trigger mouseoff.
eventState := 0;
if mouseOffLabel <> '' then TFiber.Create(mouseOffLabel, '');
end;
end;
end;
// Trigger mouseon labels. This must be done as a separate step afterward to ensure all mouseoffs have been spawned first.
if overnewgob then
for i := 0 to high(eventGob) do
if eventGob[i].eventState = 2 then begin
eventGob[i].eventState := 1;
TFiber.Create(eventGob[i].mouseOnLabel, '');
end;
if overnewarea then
for i := 0 to high(eventArea) do
if eventArea[i].eventState = 2 then begin
eventArea[i].eventState := 1;
TFiber.Create(eventArea[i].mouseOnLabel, '');
end;
end;
function TEventmatic.TriggerOverables(usingmouse : boolean) : dword;
// Spawns a trigger fiber for every area or gob that are currently in a mouseovered state. Returns number of fibers triggered.
// Some overables are mouse-only, so if triggering via keyboard/gamepad, usingmouse should be false to ignore those overables.
var i : dword;
begin
result := 0;
if length(eventGob) <> 0 then
for i := 0 to high(eventGob) do with eventGob[i] do
if (eventState <> 0) and (triggerLabel <> '') and ((usingmouse) or (mouseOnly = FALSE)) then begin
TFiber.Create(triggerLabel, '');
inc(result);
end;
if length(eventArea) <> 0 then
for i := 0 to high(eventArea) do with eventArea[i] do
if (eventState <> 0) and (triggerLabel <> '') and ((usingmouse) or (mouseOnly = FALSE)) then begin
TFiber.Create(triggerLabel, '');
inc(result);
end;
end;
procedure TEventmatic.AdvanceTimers(tickcount : dword);
// Advances all defined timer events by tickcount and triggers any that have reached their trigger period. Timers can trigger
// more than once during this call if the period is short or tickcount is high.
var i : dword;
begin
if length(eventTimer) <> 0 then
for i := 0 to high(eventTimer) do with eventTimer[i] do begin
inc(timerCounter, tickcount);
while timerCounter >= triggerPeriod do begin
dec(timerCounter, triggerPeriod);
TFiber.Create(triggerLabel, '');
end;
end;
end;
procedure TEventmatic.ResetEvents;
begin
setlength(eventArea, 0);
setlength(eventGob, 0);
setlength(eventTimer, 0);
normalInterrupt.triggerLabel := '';
escInterrupt.triggerLabel := '';
end;
procedure TEventmatic.Remove(name : UTF8string);
// Removes all area, gob, and timer events by the given name. Name must be uppercased before calling.
var i, j : dword;
begin
if length(eventArea) <> 0 then for i := high(eventArea) downto 0 do
if eventArea[i].eventName = name then begin
j := high(eventArea);
if i < j then eventArea[i] := eventArea[j];
setlength(eventArea, j);
end;
if length(eventGob) <> 0 then for i := high(eventGob) downto 0 do
if eventGob[i].eventName = name then begin
j := high(eventGob);
if i < j then eventGob[i] := eventGob[j];
setlength(eventGob, j);
end;
if length(eventTimer) <> 0 then for i := high(eventTimer) downto 0 do
if eventTimer[i].eventName = name then begin
j := high(eventTimer);
if i < j then eventTimer[i] := eventTimer[j];
setlength(eventTimer, j);
end;
end;
function TEventmatic.Serialise(var outbuf : pointer) : dword;
begin
end;
procedure TEventmatic.Deserialise(inbuf : pointer; bufbytes : dword);
begin
end;
......@@ -98,8 +98,8 @@ type TFiberHub = object
procedure RunDebugCommand;
procedure RunFibers;
procedure UpdateScriptIndexes;
procedure Serialise;
procedure Deserialise;
function Serialise(var outbuf : pointer) : dword;
procedure Deserialise(inbuf : pointer; bufbytes : dword);
procedure LogCallstack(const fibernamu : UTF8string);
procedure Destroy;
end;
......
......@@ -1610,10 +1610,14 @@ begin
end;
end;
procedure TFiberHub.Serialise;
function TFiberHub.Serialise(var outbuf : pointer) : dword;
// Saves the current fiberhub state in outbuf^, returns the number of bytes saved. This function reserves memory for outbuf,
// and it is the caller's responsibility to free it.
begin
end;
procedure TFiberHub.Deserialise;
procedure TFiberHub.Deserialise(inbuf : pointer; bufbytes : dword);
// Loads a saved fiberhub state from inbuf^.
begin
end;
......
......@@ -227,18 +227,10 @@ begin
_FiberError('event.create.area bad viewport: ' + strdec(numvalue))
else begin
eport := numvalue;
numvalue := 0;
FetchParam(WOPP_LOCX);
elx := numvalue;
numvalue := 0;
FetchParam(WOPP_LOCY);
ely := numvalue;
numvalue := 32768;
FetchParam(WOPP_SIZEX);
esx := abs(numvalue);
numvalue := 32768;
FetchParam(WOPP_SIZEY);
esy := abs(numvalue);
numvalue := 0; FetchParam(WOPP_LOCX); elx := numvalue;
numvalue := 0; FetchParam(WOPP_LOCY); ely := numvalue;
numvalue := 32768; FetchParam(WOPP_SIZEX); esx := abs(numvalue);
numvalue := 32768; FetchParam(WOPP_SIZEY); esy := abs(numvalue);
elabel := ''; emouseon := ''; emouseoff := '';
if FetchParam(WOPP_LABEL) then elabel := strvalue[0];
......@@ -247,24 +239,7 @@ begin
numvalue := 0;
FetchParam(WOPP_MOUSEONLY);
numvalue2 := length(event.area);
setlength(event.area, length(event.area) + 1);
with event.area[numvalue2] do begin
namu := upcase(enamu);
inViewport := eport;
areaLoc.left := elx;
areaLoc.right := elx + longint(esx);
areaLoc.top := ely;
areaLoc.bottom := ely + longint(esy);
areaLoc.DerivePixelsFrom32k(viewport[eport].viewportSizeP);
centerPoint.x := (areaLoc.leftp + areaLoc.rightp) div 2;
centerPoint.y := (areaLoc.topp + areaLoc.bottomp) div 2;
triggerLabel := elabel;
mouseOnLabel := emouseon;
mouseOffLabel := emouseoff;
state := 0;
mouseOnly := numvalue <> 0;
end;
Eventmatic.AddAreaEvent(enamu, eport, elx, ely, esx, esy, elabel, emouseon, emouseoff, numvalue <> 0);
end;
end;
end;
......@@ -274,7 +249,7 @@ begin
if FetchParam(WOPP_LABEL) then begin
if pos('.', strvalue[0]) = 0 then
strvalue[0] := copy(labelName, 1, pos('.', labelName)) + strvalue[0];
event.escInterrupt.triggerLabel := strvalue[0];
Eventmatic.escInterrupt.triggerLabel := strvalue[0];
end;
end;
......@@ -300,20 +275,8 @@ begin
num := GobHub.GetGob(egob);
if num >= GobHub.numGobs then
_FiberError('event.create.gob with invalid gob')
else begin
numvalue2 := length(event.gob);
setlength(event.gob, length(event.gob) + 1);
with event.gob[numvalue2] do begin
namu := enamu;
gobNum := num;
gobNamu := egob;
triggerLabel := elabel;
mouseOnLabel := emouseon;
mouseOffLabel := emouseoff;
state := 0;
mouseOnly := numvalue <> 0;
end;
end;
else
Eventmatic.AddGobEvent(enamu, egob, num, elabel, emouseon, emouseoff, numvalue <> 0);
end;
end;
end;
......@@ -323,7 +286,7 @@ begin
if FetchParam(WOPP_LABEL) then begin
if pos('.', strvalue[0]) = 0 then
strvalue[0] := copy(labelName, 1, pos('.', labelName)) + strvalue[0];
event.normalInterrupt.triggerLabel := strvalue[0];
Eventmatic.normalInterrupt.triggerLabel := strvalue[0];
end;
end;
......@@ -341,74 +304,27 @@ begin
FetchParam(WOPP_FREQ);
if numvalue < 0 then
_FiberError('event.create timer freq < 0')
else begin
// Save the new timer.
numvalue2 := length(event.timer);
setlength(event.timer, numvalue2 + 1);
with event.timer[numvalue2] do begin
namu := upcase(strvalue2[0]);
triggerfreq := numvalue;
timercounter := 0;
triggerLabel := strvalue[0];
end;
end;
else
Eventmatic.AddTimerEvent(upcase(strvalue2[0]), numvalue, strvalue[0]);
end;
end;
procedure Invoke_EVENT_REMOVE; inline;
var i, j : dword;
begin
if (FetchParam(WOPP_NAME) = FALSE) or (strvalue[0] = '') then begin
// Remove all events.
setlength(event.area, 0);
setlength(event.gob, 0);
setlength(event.timer, 0);
event.normalInterrupt.triggerLabel := '';
event.escInterrupt.triggerLabel := '';
end
else begin
strvalue[0] := upcase(strvalue[0]);
// Remove all area events by this name.
i := length(event.area);
while i <> 0 do begin
dec(i);
if event.area[i].namu = strvalue[0] then begin
j := length(event.area) - 1;
if i < j then event.area[i] := event.area[j];
setlength(event.area, j);
end;
end;
// Remove all gob events by this name.
i := length(event.gob);
while i <> 0 do begin
dec(i);
if event.gob[i].namu = strvalue[0] then begin
j := length(event.gob) - 1;
if i < j then event.gob[i] := event.gob[j];
setlength(event.gob, j);
end;
end;
// Remove all timers by this name.
i := length(event.timer);
while i <> 0 do begin
dec(i);
if event.timer[i].namu = strvalue[0] then begin
j := length(event.timer) - 1;
if i < j then event.timer[i] := event.timer[j];
setlength(event.timer, j);
end;
end;
end;
begin
if (FetchParam(WOPP_NAME) = FALSE) or (strvalue[0] = '') then
Eventmatic.ResetEvents
else
Eventmatic.Remove(upcase(strvalue[0]));
end;
procedure Invoke_EVENT_REMOVE_ESC; inline;
begin
event.escInterrupt.triggerLabel := '';
Eventmatic.escInterrupt.triggerLabel := '';
end;
procedure Invoke_EVENT_REMOVE_INT; inline;
begin
event.normalInterrupt.triggerLabel := '';
Eventmatic.normalInterrupt.triggerLabel := '';
end;
procedure Invoke_EVENT_SETLABEL; inline;
......@@ -429,32 +345,24 @@ begin
hasoff := FetchParam(WOPP_MOUSEOFF);
offlabel := strvalue[0];
i := length(event.gob);
while i <> 0 do begin
dec(i);
if event.gob[i].namu = strvalue2[0] then begin
if hastrig then event.gob[i].triggerLabel := triglabel;
if hason then event.gob[i].mouseOnLabel := onlabel;
if hasoff then event.gob[i].mouseOffLabel := offlabel;
end;
end;
with Eventmatic do begin
if length(eventArea) <> 0 then for i := high(eventArea) downto 0 do
if eventArea[i].eventName = strvalue2[0] then begin
if hastrig then eventArea[i].triggerLabel := triglabel;
if hason then eventArea[i].mouseOnLabel := onlabel;
if hasoff then eventArea[i].mouseOffLabel := offlabel;
end;
i := length(event.area);
while i <> 0 do begin
dec(i);
if event.area[i].namu = strvalue2[0] then begin
if hastrig then event.area[i].triggerLabel := triglabel;
if hason then event.area[i].mouseOnLabel := onlabel;
if hasoff then event.area[i].mouseOffLabel := offlabel;
end;
end;
if length(eventGob) <> 0 then for i := high(eventGob) downto 0 do
if eventGob[i].eventName = strvalue2[0] then begin
if hastrig then eventGob[i].triggerLabel := triglabel;
if hason then eventGob[i].mouseOnLabel := onlabel;
if hasoff then eventGob[i].mouseOffLabel := offlabel;
end;
if hastrig then begin
i := length(event.timer);
while i <> 0 do begin
dec(i);
if event.timer[i].namu = strvalue2[0] then event.timer[i].triggerLabel := triglabel;
end;
if (hastrig) and (length(eventTimer) <> 0) then for i := high(eventTimer) downto 0 do
if eventTimer[i].eventName = strvalue2[0] then
eventTimer[i].triggerLabel := triglabel;
end;
end;
end;
......@@ -1518,7 +1426,7 @@ begin
_FiberError('bad default viewport: ' + strdec(numvalue))
else begin
gamevar.defaultViewport := dword(numvalue);
if numvalue >= length(viewport) then SetNumViewports(numvalue + 1);
if numvalue >= length(viewport) then Viewportmatic.SetNumViewports(numvalue + 1);
end;
end;
......@@ -1538,7 +1446,7 @@ begin
exit;
end;
if viewnum >= length(viewport) then SetNumViewports(viewnum + 1);
if viewnum >= length(viewport) then Viewportmatic.SetNumViewports(viewnum + 1);
if FetchParam(WOPP_PARENT) then begin
if (length(strvalue[0]) > 2) and (strvalue[0][1] = '0') and (byte(strvalue[0][2]) or $20 = byte('x')) then
numvalue := valhex(copy(strvalue[0], 3, length(strvalue[0])))
......
......@@ -86,6 +86,8 @@ type TGobHub = object
procedure InsertGobInList(newgob : TGob; atindex : dword);
procedure DeleteGobFromList(deleteindex : dword);
procedure OverwriteIndex(gobindex : dword; newgob : TGob; importframe : boolean);
function Serialise(var outbuf : pointer) : dword;
procedure Deserialise(inbuf : pointer; bufbytes : dword);
procedure Destroy;
end;
......
......@@ -353,11 +353,13 @@ begin
for i := fxCount - 1 downto 0 do
if (fx[i].fxGob = thisindex) then fx[i].Destroy;
// Kill events.
if length(event.gob) <> 0 then for i := high(event.gob) downto 0 do
if event.gob[i].gobnum = thisindex then begin
if i < dword(high(event.gob)) then event.gob[i] := event.gob[high(event.gob)];
setlength(event.gob, length(event.gob) - 1);
end;
with Eventmatic do if length(eventGob) <> 0 then
for i := high(eventGob) downto 0 do
if eventGob[i].gobnum = thisindex then begin
if i < dword(high(eventGob)) then
eventGob[i] := eventGob[high(eventGob)];
setlength(eventGob, length(eventGob) - 1);
end;
GobHub.DeleteGobFromList(thisindex);
end;
......@@ -391,8 +393,9 @@ begin
for i := fxCount - 1 downto 0 do
if (fx[i].fxGob < numGobs) and (fx[i].fxGob >= atindex) then inc(fx[i].fxGob);
if length(event.gob) <> 0 then for i := high(event.gob) downto 0 do
if (event.gob[i].gobnum < numGobs) and (event.gob[i].gobnum >= atindex) then inc(event.gob[i].gobnum);
with Eventmatic do if length(eventGob) <> 0 then
for i := high(eventGob) downto 0 do
if (eventGob[i].gobnum < numGobs) and (eventGob[i].gobnum >= atindex) then inc(eventGob[i].gobnum);
end;
gob[atindex] := newgob;
......@@ -418,8 +421,9 @@ begin
for i := fxCount - 1 downto 0 do
if (fx[i].fxGob <= numGobs) and (fx[i].fxGob > deleteindex) then dec(fx[i].fxGob);
if length(event.gob) <> 0 then for i := high(event.gob) downto 0 do
if (event.gob[i].gobnum <= numGobs) and (event.gob[i].gobnum > deleteindex) then dec(event.gob[i].gobnum);
with Eventmatic do if length(eventGob) <> 0 then
for i := high(eventGob) downto 0 do
if (eventGob[i].gobnum <= numGobs) and (eventGob[i].gobnum > deleteindex) then dec(eventGob[i].gobnum);
end;
gob[numGobs] := NIL;
......@@ -446,6 +450,14 @@ begin
tempgob.Destroy;
end;
function TGobHub.Serialise(var outbuf : pointer) : dword;
begin
end;
procedure TGobHub.Deserialise(inbuf : pointer; bufbytes : dword);
begin
end;
procedure TGobHub.Destroy;
begin
while numGobs <> 0 do begin dec(numGobs); gob[numGobs].Destroy; end;
......
This diff is collapsed.
......@@ -17,13 +17,82 @@
{ along with SuperSakura. If not, see <https://www.gnu.org/licenses/>. }
{ }
procedure ReadSeenGFX;
// Game state save/load handling.
// Savestates aren't a class because we only ever deal with one at a time.
type TSavematic = object
public
compressedSaveState : pointer;
compressedBytes, uncompressedBytes : dword;
private
chunks : array of record
data : pointer;
bytes : dword;
end;
//variableChunk, thumbnailChunk
public
procedure Destroy;
procedure InitPartialSave;
procedure RestorePartialSave;
procedure FinaliseSaveState;
procedure QuickSave;
procedure LoadState;
procedure ReadSeenGFX;
procedure SaveGlobals;
end;
var Savematic : TSavematic;
// ------------------------------------------------------------------
procedure TSavematic.Destroy;
var i : dword;
begin
if compressedSaveState <> NIL then begin freemem(compressedSaveState); compressedSaveState := NIL; end;
if length(chunks) <> 0 then for i := high(chunks) downto 0 do if chunks[i].data <> NIL then freemem(chunks[i].data);
end;
procedure TSavematic.InitPartialSave;
var i : dword;
begin
if length(chunks) <> 0 then for i := high(chunks) downto 0 do if chunks[i].data <> NIL then freemem(chunks[i].data);
setlength(chunks, 9);
chunks[0].bytes := FiberHub.Serialise(chunks[0].data);
chunks[1].bytes := Viewportmatic.Serialise(chunks[1].data);
chunks[2].bytes := GobHub.Serialise(chunks[2].data);
chunks[3].bytes := Eventmatic.Serialise(chunks[3].data);
chunks[4].bytes := BoxHub.Serialise(chunks[4].data);
chunks[5].bytes := Choicematic.Serialise(chunks[5].data);
chunks[6].bytes := EffectHub.Serialise(chunks[6].data);
end;
procedure TSavematic.RestorePartialSave;
begin
end;
procedure TSavematic.FinaliseSaveState;
// Takes the partial savestate data, adds a variable chunk and a screenshot thumbnail, then compresses it all into one block.
begin
end;
procedure TSavematic.QuickSave;
begin
end;
procedure TSavematic.LoadState;
begin
end;
// ------------------------------------------------------------------
procedure TSavematic.ReadSeenGFX;
// Initialises the seengfx list, opens the .SAV file, reads previously seen graphics into the list.
{$ifdef bonk}
var filu : file;
i, j : dword;
tux : string;
begin
exit;
j := 0; seenGfxItems := 0; seenGfxSize := 4096;
if seenGfxP <> NIL then begin freemem(seenGfxP); seenGfxP := NIL; end;
getmem(seenGfxP, seenGfxSize);
......@@ -58,8 +127,11 @@ begin
while IOresult <> 0 do ;
end;
{$else}
begin end;
{$endif}
procedure SaveGlobals;
procedure TSavematic.SaveGlobals;
// Attempts to write the seen graphics and strings lists into a SAV file.
var filu : file;
i, j : dword;
......
......@@ -42,7 +42,17 @@ type TViewport = class
constructor Create(viewnum : dword);
end;
type TViewportmatic = object
procedure SetNumViewports(newcount : dword);
function Serialise(var outbuf : pointer) : dword;
procedure Deserialise(inbuf : pointer; bufbytes : dword);
procedure Destroy;
end;
var viewport : array of TViewport;
var Viewportmatic : TViewportmatic;
// ------------------------------------------------------------------
function TViewport.GetBackgroundGobIndex : dword;
// Returns the lowest background gob in this viewport, visible or not. If none found, returns maxuint.
......@@ -152,14 +162,14 @@ begin
with BoxHub do for i := high(textbox) downto 0 do with textbox[i] do
if boxInViewport = viewportIndex then parametersNeedUpdate := TRUE;
if length(event.area) <> 0 then for i := high(event.area) downto 0 do
with event.area[i] do
if inViewport = viewportIndex then begin
areaLoc.DerivePixelsFrom32k(viewport[inViewport].viewportSizeP);
inc(areaLoc.leftp, viewport[inViewport].viewportLoc.leftp);
inc(areaLoc.rightp, viewport[inViewport].viewportLoc.leftp);
inc(areaLoc.topp, viewport[inViewport].viewportLoc.topp);
inc(areaLoc.bottomp, viewport[inViewport].viewportLoc.topp);
if length(Eventmatic.eventArea) <> 0 then for i := high(Eventmatic.eventArea) downto 0 do
with Eventmatic.eventArea[i] do
if areaInViewport = viewportIndex then begin
areaLoc.DerivePixelsFrom32k(viewport[areaInViewport].viewportSizeP);
inc(areaLoc.leftp, viewport[areaInViewport].viewportLoc.leftp);
inc(areaLoc.rightp, viewport[areaInViewport].viewportLoc.leftp);
inc(areaLoc.topp, viewport[areaInViewport].viewportLoc.topp);
inc(areaLoc.bottomp, viewport[areaInViewport].viewportLoc.topp);
end;
end;
......@@ -193,7 +203,7 @@ begin
Reset;
end;
procedure SetNumViewports(newcount : dword);
procedure TViewportmatic.SetNumViewports(newcount : dword);
var i : dword;
begin
if newcount = length(viewport) then exit;
......@@ -211,3 +221,16 @@ begin
end;
end;
function TViewportmatic.Serialise(var outbuf : pointer) : dword;
begin
end;
procedure TViewportmatic.Deserialise(inbuf : pointer; bufbytes : dword);
begin
end;
procedure TViewportmatic.Destroy;
begin
SetNumViewports(0);
end;
......@@ -82,6 +82,9 @@ paszlib; // standard compression/decompression unit for savegames etc
// Sakurascript execution, fiber handling system, and helpers.
{$include inc/sakufiber-implementation.pas}
// Mouseoverables, events, script callbacks.
{$include inc/sakueventmatic-implementation.pas}
// User input handling.
{$include inc/sakuinput.pas}
......
......@@ -26,7 +26,7 @@
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<Units Count="62">
<Units Count="63">
<Unit0>
<Filename Value="supersakura.pas"/>
<IsPartOfProject Value="True"/>
......@@ -271,13 +271,17 @@
<IsPartOfProject Value="True"/>
</Unit59>
<Unit60>
<Filename Value="inc/sakuevents.pas"/>
<Filename Value="inc/sakusavematic.pas"/>
<IsPartOfProject Value="True"/>
</Unit60>
<Unit61>
<Filename Value="inc/sakusavematic.pas"/>
<Filename Value="inc/sakueventmatic-header.pas"/>
<IsPartOfProject Value="True"/>
</Unit61>
<Unit62>
<Filename Value="inc/sakueventmatic-implementation.pas"/>
<IsPartOfProject Value="True"/>
</Unit62>
</Units>
</ProjectOptions>
<CompilerOptions>
......
......@@ -89,6 +89,9 @@ paszlib; // standard compression/decompression unit for savegames etc
// Sakurascript execution, fiber handling system, and helpers.
{$include inc/sakufiber-implementation.pas}
// Mouseoverables, events, script callbacks.
{$include inc/sakueventmatic-implementation.pas}
// User input handling.
{$include inc/sakuinput.pas}
......