add file i/o to zipoff, implement persistent variables, write swine meeper instructions

common.jrt

@@ -1,9 +1,17 @@
 import text.jrt
 import keys.jrt
 import random.jrt
+import file.jrt
+import timer.jrt
+import beep.jrt
 
 : !+ ( v p -- ) dup @ <rot + swap ! ;
 : b!+ ( v p -- ) dup b@ <rot + swap b! ;
 : b!| ( f p -- ) dup b@ <rot | swap b! ;
 : b!^ ( f p -- ) dup b@ <rot ^ swap b! ;
 : ~ 0xffff ^ ;
+
+: !save ( v p -- ) openself >r dup >rot ! 
+  r@ if dup 0x100 - r@ seekto cell swap r@ fwrite <r close 
+     else rdrop drop then ;
+

file.jrt

@@ -0,0 +1,81 @@
+:ASM overwrite
+  MOV AH 0x3c #
+  XOR CX CX ( non-system, non-hidden )
+  POP DX ( filename ptr )
+  INT 0x21 #
+  PUSH AX
+  NEXT
+
+:ASM open
+  MOV AH 0x3d #
+  MOV AL 2 # ( read/write access, allow child inheritance )
+  POP DX ( filename ptr )
+  INT 0x21 #
+  PUSH AX
+  NEXT
+
+:ASM openself ( -- fp )
+  MOV AX 0x2c @+ ( fetch environment segment )
+  OR AX AX
+  JZ 1 @> ( we're in a target .com and there is no "self" - abort with 0 )
+  MOV ES AX
+  XOR DI DI
+  XOR AX AX
+0 :> ( search for two zeroes in a row )
+  SCASB
+  JNZ 0 <@
+  SCASB
+  JNZ 0 <@
+  SCASW ( consume the 0x0001. DI is now a pointer to the filename )
+  MOV DX DI
+  PUSH DS
+  MOV AX ES
+  MOV DS AX
+  MOV AH 0x3d #
+  MOV AL 2 # ( read/write access, allow child inheritance )
+  INT 0x21 #
+  POP DS
+1 <:
+  PUSH AX
+  NEXT
+
+:ASM close
+  MOV AH 0x3e #
+  POP BX
+  INT 0x21 #
+  NEXT
+
+:ASM seekto ( loc fp -- )
+  XOR AX AX
+  XOR CX CX
+  MOV AH 0x42 #
+  POP BX
+  POP DX
+  INT 0x21 #
+  NEXT
+
+0 VAR, fcount
+:ASM fread
+  MOV AH 0x3f #
+  POP BX ( fp )
+  POP DX ( buffer )
+  POP CX ( length )
+  INT 0x21 #
+  MOV t& fcount @+ AX ( save number of bytes read )
+  NEXT
+
+:ASM fwrite
+  MOV AH 0x40 #
+  POP BX ( fp )
+  POP DX ( buffer )
+  POP CX ( length )
+  INT 0x21 #
+  MOV t& fcount @+ AX ( save number of bytes written )
+  NEXT
+
+-1 CONST EOF
+0 VAR, fbuffer
+:t fgetc ( fp -- c )
+  1 fbuffer <rot fread fbuffer ub@
+  fcount @ not BZ_ [ patchpt ] drop EOF [ patch!t ] ;
+:t fputc ( c fp -- ) swap fbuffer b! 1 fbuffer <rot fwrite ;

swine.jrt

@@ -1,7 +1,7 @@
-import timer.jrt
-import beep.jrt
+dbg" start"
 
 : meep 2000 5 -80 slide ;
+: meeeep 2000 16 -50 slide ;
 : moop 1600 5 80 slide ;
 : boom 40 noise ;
 : click 2000 3 boop 4000 3 boop ;
@@ -20,6 +20,7 @@ IN-PROGRESS bvar, game-state
 : uncancel cancelled? if enter then ;
 
 ( minesweeper board model )
+dbg" minesweeper board model"
 30 const maxw 12 const maxh
 array board maxw maxh * allot
 
@@ -121,6 +122,7 @@ var neighbour-check
   if FFLAG swap dup flag-noise b!^ else drop then ;
 
 ( theming )
+dbg" theming"
 array countcolors white b, lblue b, lgreen b, red b, blue b, 
   brown b, cyan b, black b, gray b,
 
@@ -135,7 +137,7 @@ var theme
 : col-count ( c -- ) 
   countcolors + b@ dup 0 colvar = if drop col-grid else fg! then ;
 
-{ :timm deftheme CREATE >t >t >t >t >t >t DOES} theme ! ;
+{ :timm deftheme CREATE >t >t >t >t >t >t DOES} theme !save ;
 ( cursor   grid   block     mine    flag     bg )
     blue  white   black  magenta     red  lgray deftheme win31
    white yellow   black lmagenta  yellow    red deftheme hotdog
@@ -144,6 +146,7 @@ var theme
 win31
 
 ( minesweeper board drawing )
+dbg" board drawing"
 : draw-neighbour-count ( b -- )
   NEIGHBOUR-MASK & dup col-count 
   dup if [ key 0 lit ] + else drop [ key   lit ] then draw-char ;
@@ -176,7 +179,7 @@ win31
   drop draw-board-bottom ;
 
 ( general-purpose drawing )
-
+dbg" general-purpose drawing"
 : clear [ key   lit ] fill-page ;
 
 : emptych? ( ch -- f ) dup 32 = swap 0 = or ;
@@ -190,6 +193,7 @@ win31
   begin dup b@ dup while draw-char dup spacer 1+ repeat drop drop ;
 
 ( menu subsystem )
+dbg" menu"
 2 cells const menu-optsize
 var current-menu
 : menu-options current-menu @ cell + 1+ ;
@@ -235,6 +239,7 @@ var current-menu
 { :timm defitem ( cp name iopt -- ) menu-option dup >rot !t cell + !t ; }
 
 ( minesweeper game UI )
+dbg" game ui"
 0 bvar, cursx 0 bvar, cursy
 
 : draw-cursor ( -- )
@@ -270,7 +275,8 @@ var current-menu
   5 popupbox ( x ) 10 textxy! draw-spaced-text 
   wait-key drop ;
 
-: fanfare meep moop meep moop meep moop meep ;
+: beat 10 sleep-csec ;
+: fanfare meep beat moop beat meep beat moop beat meep beat meep beat meeeep ;
 : display-result
   game-state b@
   dup WON = if fanfare green bg! lcyan fg! s" YOU WON" 26 result-message then
@@ -280,7 +286,7 @@ var current-menu
 ' leave                      s" Return to game" 0 defitem
 :noname QUIT game-state b! ; s" Quit to title" 1 defitem
 
-: confirm-quit cancelled? if quitmenu then ;
+: confirm-quit cancelled? if quitmenu col-bg clear then ;
 : draw-game draw-board draw-cursor ;
 
 : play enter col-bg clear
@@ -290,6 +296,7 @@ var current-menu
 : start init-board boardw @ 2/ cursx b! boardh @ 2/ cursy b! play ;
 
 ( title menu )
+dbg" title"
 array title-text t", SWINE MEEPER"
 
 5 :noname col-bg clear ; defmenu theme-menu
@@ -301,7 +308,7 @@ array title-text t", SWINE MEEPER"
 
 20 12 30 minecount ! boardh ! boardw !
 : config-game ( boardw boardh minecount -- )
-  minecount ! boardh ! boardw ! leave ;
+  minecount !save boardh !save boardw !save leave ;
 
 3 :noname red bg! clear ; defmenu difficulty-menu
 :noname 10 10 10 config-game ; s" Easy     ( 10x10, 10 swine )" 0 defitem
@@ -323,5 +330,6 @@ array title-text t", SWINE MEEPER"
   textmode uninstall-timer ;
 
 ' title ' main redefine
+dbg" saving"
 
 { s" swine.com" writecom }

swine.txt

@@ -0,0 +1,20 @@
+                  S * W * I * N * E   M * E * E * P * E * R
+
+Waddles, your trusty pig, is ready to go on the hunt for truffles! Leash him
+up and make your way through the grove. But be warned! Digging too close can
+cause damage to the truffles' mycelia, which can take years to recover from!
+
+HOW TO PLAY:
+Select a square with the arrow keys, and press the space bar or enter to dig. 
+Waddles will tell you how many truffles are nearby by marking the square with
+a number. This is the number of neighbouring squares (including diagonals)
+that have truffles.
+
+If you select a square with no truffles nearby, the neighbouring squares will
+automatically be cleared out. If you select a square with a truffle, it's
+game over!
+
+You can use the "F" key to flag and unflag a square as containing a truffle
+without digging there. If you select a square that has already been dug up,
+and the number on the square matches the number of flags next to it, the
+unflagged squares will be dug up automatically.

tinyjort.jrt

@@ -107,53 +107,7 @@ DEFERRED dictionary primary-dict
 : t" begin key dup [ key " lit ] != while >t repeat drop 0 >t ;
 
 dbg" i/o"
-:ASM overwrite
-  MOV AH 0x3c #
-  XOR CX CX ( non-system, non-hidden )
-  POP DX ( filename ptr )
-  INT 0x21 #
-  PUSH AX
-  NEXT
-
-:ASM open
-  MOV AH 0x3d #
-  MOV AL 2 # ( read/write access, allow child inheritance )
-  POP DX ( filename ptr )
-  INT 0x21 #
-  PUSH AX
-  NEXT
-
-:ASM close
-  MOV AH 0x3e #
-  POP BX
-  INT 0x21 #
-  NEXT
-
-0 VAR, fcount
-:ASM fread
-  MOV AH 0x3f #
-  POP BX ( fp )
-  POP DX ( buffer )
-  POP CX ( length )
-  INT 0x21 #
-  MOV t& fcount @+ AX ( save number of bytes read )
-  NEXT
-
-:ASM fwrite
-  MOV AH 0x40 #
-  POP BX ( fp )
-  POP DX ( buffer )
-  POP CX ( length )
-  INT 0x21 #
-  MOV t& fcount @+ AX ( save number of bytes written )
-  NEXT
-
--1 CONST EOF
-0 VAR, fbuffer
-:t fgetc ( fp -- c )
-  1 fbuffer <rot fread fbuffer ub@
-  fcount @ not BZ_ [ patchpt ] drop EOF [ patch!t ] ;
-:t fputc ( c fp -- ) swap fbuffer b! 1 fbuffer <rot fwrite ;
+s" file.jrt" loadfile
 
 :ASM console-emit
   MOV AH 2 #

zipoff.jrt

@@ -139,7 +139,8 @@ var comfilename
 : readcom ( filename ) open 0x100 target! 
   begin dup fgetc dup EOF != while >t repeat drop close ;
 
-:init comfilename @ readcom } ;
+( we write a fake all-null PSP so openself can fail gracefully )
+:init 0 target! 0xff ALLOT comfilename @ readcom } ;
 
 : writeenv ( comfile wrapper -- ) 
   swap comfilename !