diff --git a/assemble.com b/assemble.com index c87cb60..04d17eb 100755 Binary files a/assemble.com and b/assemble.com differ diff --git a/common.jrt b/common.jrt index d10612c..a904804 100755 --- a/common.jrt +++ b/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 @ r dup >rot ! + r@ if dup 0x100 - r@ seekto cell swap r@ fwrite ( 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 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 } diff --git a/swine.txt b/swine.txt new file mode 100755 index 0000000..9a9b58a --- /dev/null +++ b/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. diff --git a/tinyjort.com b/tinyjort.com index 5145478..7afbfb7 100755 Binary files a/tinyjort.com and b/tinyjort.com differ diff --git a/tinyjort.jrt b/tinyjort.jrt index 6177379..2a246ac 100755 --- a/tinyjort.jrt +++ b/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 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 ! diff --git a/zipstub.seg b/zipstub.seg index a997669..192cd70 100755 Binary files a/zipstub.seg and b/zipstub.seg differ