minesweeper, random number generator, debugging assembler

asm.jrt

@@ -36,7 +36,7 @@ array oparg2 3 cells allot
 
 : byteop? ( -- f ) 
   oparg-breg? swap-args oparg-breg? or swap-args byteptr? or ;
-: byteval? ( v -- f ) dup 0x7f <= swap -0x80 >= and ;
+: byteval? ( v -- f ) dup 0x7f <= swap 0xff80 >= and ;
 : oparg-bwreg? ( -- f ) byteop? if oparg-breg? else oparg-wreg? then ;
 
 : operror ( err -- ) lastop @ type s"  near " type lastlabel @ type s" : " type type cr ;
@@ -205,7 +205,7 @@ var ignoreimm
 : diffaddr ( opsize -- diff ) oparg-val @ swap target + - ;
 : oparg-nearaddr? ( -- f ) oparg-mem? oparg-base @ -1 = and ;
 : >short-jmp* ( op -- ) oparg-nearaddr? if
-    2 diffaddr dup byteval? oparg-mempatch? or
+    2 diffaddr dup dbg" jumping by" byteval? oparg-mempatch? or
     if swap >t ' patch-r8 patchpoint >t 2ret then drop
   then drop ;
 : >near-reljmp* ( op -- ) oparg-nearaddr? if

debug.jrt

@@ -0,0 +1,3 @@
+{
+
+}

logic.jrt

@@ -39,7 +39,7 @@ dbg" math"
 dbg" comparisons"
 L: TRUE 0xffff w>t
 L: FALSE 0 w>t
-L: RETTRUE
+L: RETTRUE target .hex
   PUSH TRUE
   NEXT
 L: RETFALSE
@@ -49,6 +49,7 @@ L: RETFALSE
 :ASM not
   POP AX
   OR AX AX
+  L@ RETTRUE .hex
   JZ RETTRUE
   JMP RETFALSE
 

mines.jrt

@@ -0,0 +1,103 @@
+import text.jrt
+import random.jrt
+
+30 const maxw 16 const maxh
+array board maxw maxh * allot
+
+10 var, boardw 
+10 var, boardh
+15 var, minecount
+
+: board-lim boardw @ boardh @ * board + ;
+: square-at ( x y -- p ) boardw @ * + board + ;
+: square-pos ( p -- x y ) board - boardw @ /mod swap ;
+
+: valid-pos? ( x y -- f ) 
+  dup 0 >= swap boardh @ < and 
+  swap dup 0 >= swap boardw @ < and and ;
+
+0x80 const FMINE
+0x40 const FREVEALED
+0x20 const FFLAG
+0x0F const NEIGHBOUR-MASK
+
+: place-mine ( x y -- f )
+  square-at dup b@ FMINE & not if FMINE swap b! 0 then not ;
+: rand-mine ( -- )
+  begin rand boardw @ % rand boardh @ % place-mine until ;
+
+: reset-board
+  board begin dup board-lim < while 0 over b! 1+ repeat drop ;
+: populate-board
+  minecount @ begin rand-mine 1- dup not until drop ;
+: mine-at? ( x y -- f ) 
+  square-at b@ FMINE & ;
+
+: do-at ( x y cp -- )
+  >rot 2dup valid-pos? if <rot execute else drop drop drop then ;
+: do-at-neighbours ( x y cp -- )
+  >r over 1- over 1- r@ do-at
+     over 1- over    r@ do-at
+     over 1- over 1+ r@ do-at
+     over    over 1- r@ do-at
+     over    over 1+ r@ do-at
+     over 1+ over 1- r@ do-at
+     over 1+ over    r@ do-at
+     swap 1+ swap 1+ <r do-at ;
+
+0 var, curr-mine-count
+: count-mine-at ( x y -- ) 
+  mine-at? if curr-mine-count @ 1+ curr-mine-count ! then ;
+: analyze-pos ( x y -- n )
+  0 curr-mine-count ! ' count-mine-at do-at-neighbours curr-mine-count @ ;
+: analyze-board
+  board begin dup board-lim < while 
+    dup square-pos analyze-pos over b@ | over b! 1+ repeat drop ;
+
+: init-board ( w h minecount -- )
+  minecount ! boardh ! boardw !
+  reset-board populate-board analyze-board ;
+
+: draw-neighbours ( b -- )
+  NEIGHBOUR-MASK & [ key 0 lit ] + draw-char ;
+: draw-flag ( -- ) [ key ! lit ] draw-char ;
+: draw-mine ( -- ) 0x0f draw-char ;
+: draw-block ( -- ) 0xb1 draw-char ;
+: draw-revealed ( b -- )
+  dup FMINE & if draw-mine drop else draw-neighbours then ;
+: draw-hidden ( b -- )
+  FFLAG & if draw-flag else draw-block then ;
+: draw-square ( p -- )
+  b@ dup FREVEALED & if draw-revealed else draw-hidden then ;
+
+: pos>screen ( x y -- x y )
+  swap pagew boardw @ - 2/ +
+  swap pageh boardh @ - 2/ + ;
+
+: draw-board ( -- )
+  board begin dup board-lim < while 
+    dup square-pos pos>screen textxy!
+    dup draw-square 1+ repeat drop ;
+
+0 var, reveal-state
+: reveal ( p -- ) dup b@ FREVEALED | swap b! ;
+: reveal-square? ( x y -- ) 
+  square-at b@ FREVEALED = if -1 reveal-state ! then ;
+: reveal-pass ( -- f )
+  0 reveal-state !
+  board begin dup board-lim < while
+    dup b@ FREVEALED & not if
+      0 reveal-state b!
+      dup square-pos ' reveal-square? do-at-neighbours 
+      reveal-state b@ if dup reveal then then
+    1+ repeat drop reveal-state @ ;
+
+: reveal-all begin reveal-pass not until ;
+: reveal-at square-at reveal ( reveal-all ) draw-board ;
+
+: start
+  textmode
+  reseed!
+  15 10 15 init-board
+  draw-board ;
+

random.jrt

@@ -0,0 +1,23 @@
+( https://codebase64.org/doku.php?id=base:16bit_xorshift_random_generator )
+1 var, prngstate
+:asm rand
+  MOV AX prngstate @+
+  MOV BX AX
+  RCR BX 1 #
+  XOR AH BL  ( high part of x ^= x << 7 )
+  MOV BH AH
+  RCR BH 1 # ( BH now has x >> 9 and high bit comes from low byte )
+  XOR AL BH ( x ^= x >> 9 and the low part of x ^= x << 7 done )
+  XOR AH AL ( x ^= x << 8 )
+  MOV prngstate @+ AX
+  PUSH AX
+  NEXT
+
+:asm ticks
+  XOR AX AX
+  INT 0x1a #
+  PUSH DX
+  NEXT
+
+: reseed! ticks prngstate ! ;
+