implement save/load

This commit is contained in:
Jeremy Penner 2020-04-10 11:27:25 -04:00
parent cdf99a01ce
commit a66acdb7ea
22 changed files with 44 additions and 21 deletions

BIN
debug.jim

Binary file not shown.

BIN
defs.jim

Binary file not shown.

View file

@ -71,17 +71,13 @@
: max ( x y -- x|y ) 2dup < if swap then drop ; : max ( x y -- x|y ) 2dup < if swap then drop ;
: +!pos ( n var -- ) dup @ <rot + 0 max swap ! ; : +!pos ( n var -- ) dup @ <rot + 0 max swap ! ;
: cycle! ( lim var -- ) : cycle! ( var lim -- )
>r dup r@ @ <= if over @ dup 0 < if drop 1 - swap !
drop 0 r@ ! else <= if 0 swap !
else r@ @ 0 < if else drop then then ;
1 - r@ !
else drop then then rdrop ;
: +!cycle ( n var lim -- ) : +!cycle ( n var lim -- ) >r >r r@ +! <r <r cycle! ;
>r >r r@ +! <r <r swap cycle! ;
over > if drop 0 else dup 0 <
: checkpoint ( cp -- ) : checkpoint ( cp -- )
create here 4 cells + , latest , tasks , , create here 4 cells + , latest , tasks , ,
does> dup @ here! does> dup @ here!

Binary file not shown.

Binary file not shown.

View file

@ -118,6 +118,7 @@ var cchoose
6 LMAGENTA character pady userword 6 LMAGENTA character pady userword
4 LGREEN character term userword 4 LGREEN character term userword
8 RED character libb userword 8 RED character libb userword
9 BLUE character disk userword
: noone WHITE text-color ! s" " dup dup dup : noone WHITE text-color ! s" " dup dup dup
8 portraity 16 portraity 24 portraity 32 portraity ; userword 8 portraity 16 portraity 24 portraity 32 portraity ; userword

BIN
game.jim

Binary file not shown.

View file

@ -233,9 +233,20 @@ defer reset-level userword
ticks! ticks!
then ; then ;
: quit-game hide-footer LEV_QUIT queue-level ;
: quit-tick
^ESC key-pressed if :|
disk :|
s" Resume play" ' noop yield
s" Save and quit to title" :| savegame quit-game |; yield
s" Don't save and quit to title" ' quit-game yield
done |; choose
|; sched then ;
: mode-move : mode-move
player-tick player-tick
boss-tick boss-tick
quit-tick
ticking-objects @ if ticking-objects @ if
ticking-objects @ links ticking-objects @ links
@ -248,8 +259,12 @@ defer reset-level userword
q-level @ dup if q-level @ dup if
0 q-level ! 0 q-level !
reset-level reset-level
loadlevel dup LEV_QUIT = if
party each follow more drop title
else
loadlevel
party each follow more
then
else drop then ; else drop then ;
: mode-wait tick-debounce boss-tick ; : mode-wait tick-debounce boss-tick ;

BIN
input.jim

Binary file not shown.

BIN
jiles.jim

Binary file not shown.

BIN
job.jim

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

BIN
level.jim

Binary file not shown.

View file

@ -27,6 +27,7 @@ var ilevelfile
intern end.jor intern end.jor
-1 const LEV_END -1 const LEV_END
-2 const LEV_QUIT
var current-level var current-level
: load-new-level ( n -- ) : load-new-level ( n -- )
@ -38,3 +39,4 @@ var current-level
then loadfile ; then loadfile ;
: save-level ( -- ) current-level @ levelmap save-map ; : save-level ( -- ) current-level @ levelmap save-map ;
: savegame save.sav overwrite current-level @ fput close ;

BIN
map.jim

Binary file not shown.

Binary file not shown.

BIN
state.jim

Binary file not shown.

BIN
timer.jim

Binary file not shown.

BIN
title.jim

Binary file not shown.

View file

@ -19,37 +19,46 @@
: optionbg ( c -- ) dup 10 textx ! titlec 27 textx ! titlec ; : optionbg ( c -- ) dup 10 textx ! titlec 27 textx ! titlec ;
: option ( s -- ) dup strlen 1 >> 19 swap - textx ! titles ; : option ( s -- ) dup strlen 1 >> 19 swap - textx ! titles ;
intern save.sav
var savedlevel
: startgame ( n -- ) s" title" loadscr s" start.jor" loadjor ; : startgame ( n -- ) s" title" loadscr s" start.jor" loadjor ;
: menu-opts : menu-opts
s" New Game" :| 1 startgame |; yield s" New Game" :| 1 startgame |; yield
s" Continue" ' noop yield s" Continue" savedlevel @ if :| savedlevel @ startgame |; else 0 then yield
s" Help" ' noop yield s" Help" 0 yield
s" Register" ' noop yield s" Register" 0 yield
s" Quit" ' quit yield s" Quit" ' quit yield
done ; done ;
var menu-selected var menu-selected
: menu-y ( i -- y ) 12 * 90 + ; : menu-y ( i -- y ) 12 * 90 + ;
: draw-menu : draw-menu
0 menu-opts each drop 0 menu-opts each
if over menu-selected @ = if LGREEN else WHITE then else RED then
text-color !
over menu-y texty ! over menu-y texty !
over menu-selected @ = if LGREEN else WHITE then text-color ! option option
dup menu-selected @ = if 15 else sp then optionbg dup menu-selected @ = if 15 else sp then optionbg
1 + 1 +
more drop ; more drop ;
: redraw-menu 21 11 8 72 box draw-menu ; : redraw-menu WHITE text-color ! 21 11 8 72 box draw-menu ;
: exec-selected 0 menu-opts each swap drop : exec-selected 0 menu-opts each swap drop
over menu-selected @ = if execute break else drop then over menu-selected @ = if
1 + dup if execute else drop then break else drop
then 1 +
more drop ; more drop ;
: menu-count 0 menu-opts each drop drop 1 + more ; : menu-count 0 menu-opts each drop drop 1 + more ;
: menu-select ( di -- ) menu-selected menu-count +!cycle draw-menu ; : menu-select ( di -- ) menu-selected menu-count +!cycle draw-menu ;
:noname :noname
fuck s" title" loadscr redraw-menu save.sav open fget close savedlevel !
fuck 0 split-screen s" title" loadscr redraw-menu
:| ^ENTER key-pressed if exec-selected then :| ^ENTER key-pressed if exec-selected then
^UP key-pressed if -1 menu-select then ^UP key-pressed if -1 menu-select then
^DOWN key-pressed if 1 menu-select then ^DOWN key-pressed if 1 menu-select then
^ESC key-pressed if quit then ^ESC key-pressed if quit then
|; ' tick redefine ; checkpoint title |; ' tick redefine
' noop ' draw redefine ; checkpoint title