better board drawing, more minesweeper

This commit is contained in:
Jeremy Penner 2023-09-23 11:51:42 -04:00
parent 8eadd6171a
commit 133c2e370a
3 changed files with 46 additions and 10 deletions

BIN
mines.com Executable file

Binary file not shown.

View file

@ -58,26 +58,39 @@ array board maxw maxh * allot
minecount ! boardh ! boardw ! minecount ! boardh ! boardw !
reset-board populate-board analyze-board ; reset-board populate-board analyze-board ;
array countcolors white b, lblue b, lgreen b, red b, blue b,
brown b, cyan b, black b, gray b,
: draw-neighbours ( b -- ) : draw-neighbours ( b -- )
NEIGHBOUR-MASK & [ key 0 lit ] + draw-char ; NEIGHBOUR-MASK & dup countcolors + b@ fg!
: draw-flag ( -- ) [ key ! lit ] draw-char ; dup if [ key 0 lit ] + else drop [ key lit ] then draw-char ;
: draw-mine ( -- ) 0x0f draw-char ; : draw-flag ( -- ) red fg! 0xb2 draw-char ;
: draw-block ( -- ) 0xb1 draw-char ; : draw-mine ( -- ) black fg! 0x0f draw-char ;
: draw-block ( -- ) black fg! 0xb1 draw-char ;
: draw-revealed ( b -- ) : draw-revealed ( b -- )
dup FMINE & if draw-mine drop else draw-neighbours then ; dup FMINE & if draw-mine drop else draw-neighbours then ;
: draw-hidden ( b -- ) : draw-hidden ( b -- )
FFLAG & if draw-flag else draw-block then ; FFLAG & if draw-flag else draw-block then ;
: draw-square ( p -- ) : draw-square ( p -- )
b@ dup FREVEALED & if draw-revealed else draw-hidden then ; b@ dup FREVEALED & if draw-revealed else draw-hidden then white fg! ;
: pos>screen ( x y -- x y ) : pos>screen ( x y -- x y )
swap pagew boardw @ - 2/ + swap pagew boardw @ - 2/ +
swap pageh boardh @ - 2/ + ; swap pageh boardh @ - 2/ + ;
: boardx! ( -- ) pagew boardw @ 2* 1+ - 2/ textx! ;
: boardy! ( -- ) pageh boardh @ 2* 1+ - 2/ texty! ;
: next-row ( -- ) nextline boardx! ;
: draw-board-top tl boardw @ begin .- 1- dup while dT repeat tr drop next-row ;
: draw-board-bottom bl boardw @ begin .- 1- dup while uT repeat br drop next-row ;
: draw-rowborder rT boardw @ begin .- 1- dup while .+ repeat lT drop next-row ;
: draw-row ( p -- p )
.| begin dup draw-square .| 1+ dup square-pos drop not until next-row ;
: draw-board ( -- ) : draw-board ( -- )
board begin dup board-lim < while white fg! lgray bg! boardx! boardy! draw-board-top
dup square-pos pos>screen textxy! board begin draw-row dup square-pos valid-pos? while draw-rowborder repeat
dup draw-square 1+ repeat drop ; drop draw-board-bottom ;
0 var, reveal-state 0 var, reveal-state
: reveal ( p -- ) dup b@ FREVEALED | swap b! ; : reveal ( p -- ) dup b@ FREVEALED | swap b! ;
@ -92,8 +105,21 @@ array board maxw maxh * allot
reveal-state b@ if dup reveal then then reveal-state b@ if dup reveal then then
1+ repeat drop reveal-state @ ; 1+ repeat drop reveal-state @ ;
: reveal-all begin reveal-pass not until ; 0 const IN-PROGRESS
: reveal-at square-at reveal ( reveal-all ) draw-board ; 1 const WON
2 const LOST
IN-PROGRESS var, game-state
: check-win ( -- )
0 board begin dup board-lim < while
dup b@ dup FMINE & swap FREVEALED & or not if swap 1+ swap then
1+ repeat drop not if WON game-state ! then ;
: on-reveal ( p -- )
b@ FMINE & if LOST game-state ! else check-win then ;
: autoreveal begin reveal-pass not until ;
: reveal-at square-at dup reveal autoreveal on-reveal draw-board ;
: flag-at square-at dup b@ FFLAG | swap b! draw-board ;
: start : start
textmode textmode
@ -101,3 +127,6 @@ array board maxw maxh * allot
15 10 15 init-board 15 10 15 init-board
draw-board ; draw-board ;
' start ' main redefine
{ s" mines.com" writecom }

View file

@ -137,12 +137,19 @@ var boxstyle
: vchar vstyle if 0xba else 0xb3 then ; : vchar vstyle if 0xba else 0xb3 then ;
: hline ( count -- ) hchar draw-hrepeat ; : hline ( count -- ) hchar draw-hrepeat ;
: vline ( count -- ) vchar draw-vrepeat ; : vline ( count -- ) vchar draw-vrepeat ;
: .- hchar draw-char ;
: .| vchar draw-char ;
{ : :corner CREATE >t >t >t >t DOES} boxstyle @ 0x03 & + b@ draw-char ; { : :corner CREATE >t >t >t >t DOES} boxstyle @ 0x03 & + b@ draw-char ;
0xc9 0xd6 0xd5 0xda :corner tl 0xc9 0xd6 0xd5 0xda :corner tl
0xbb 0xb7 0xb8 0xbf :corner tr 0xbb 0xb7 0xb8 0xbf :corner tr
0xc8 0xd3 0xd4 0xc0 :corner bl 0xc8 0xd3 0xd4 0xc0 :corner bl
0xbc 0xbd 0xbe 0xd9 :corner br 0xbc 0xbd 0xbe 0xd9 :corner br
0xb9 0xb6 0xb5 0xb4 :corner lT
0xcc 0xc7 0xc6 0xc3 :corner rT
0xca 0xd0 0xcf 0xc1 :corner uT
0xcb 0xd2 0xd1 0xc2 :corner dT
0xce 0xd7 0xd8 0xc5 :corner .+
: boxtop ( w -- ) textx swap tl 2 - hline tr nextline textx! ; : boxtop ( w -- ) textx swap tl 2 - hline tr nextline textx! ;
: boxbottom ( w -- ) bl 2 - hline br ; : boxbottom ( w -- ) bl 2 - hline br ;