implement save/load

defs.jor

@@ -71,17 +71,13 @@
 : max ( x y -- x|y ) 2dup < if swap then drop ;
 
 : +!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 -- )
   create here 4 cells + , latest , tasks , ,
   does> dup @ here!

footer.jor

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

game.jor

@@ -233,9 +233,20 @@ defer reset-level userword
     ticks!
   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
   player-tick
   boss-tick
+  quit-tick
 
   ticking-objects @ if
     ticking-objects @ links
@@ -248,8 +259,12 @@ defer reset-level userword
   q-level @ dup if
     0 q-level !
     reset-level
+    dup LEV_QUIT = if
+      drop title
+    else
       loadlevel
       party each follow more
+    then
   else drop then ;
 
 : mode-wait tick-debounce boss-tick ;

level.jor

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

title.jor

@@ -19,37 +19,46 @@
 : optionbg ( c -- ) dup 10 textx ! titlec 27 textx ! titlec ;
 : option ( s -- ) dup strlen 1 >> 19 swap - textx ! titles ;
 
+intern save.sav
+
+var savedlevel
+
 : startgame ( n -- ) s" title" loadscr s" start.jor" loadjor ;
 : menu-opts
   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
   done ;
 var menu-selected
 : menu-y ( i -- y ) 12 * 90 + ;
 : 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-selected @ = if LGREEN else WHITE then text-color ! option
+    option
     dup menu-selected @ = if 15 else sp then optionbg
     1 +
   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
-    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 ;
 
 : menu-count 0 menu-opts each drop drop 1 + more ;
 : menu-select ( di -- ) menu-selected menu-count +!cycle draw-menu ;
 
 :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
      ^UP    key-pressed if -1 menu-select then
      ^DOWN  key-pressed if  1 menu-select then
      ^ESC   key-pressed if quit then
-  |; ' tick redefine ; checkpoint title
+  |; ' tick redefine
+  ' noop ' draw redefine ; checkpoint title