SpindleyQ/dialer
1
1
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

better board drawing, more minesweeper

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

BIN
mines.com Executable file
View file

Binary file not shown.

49
mines.jrt
View file

@ -58,26 +58,39 @@ array board maxw maxh * allot
minecount ! boardh ! boardw !
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 -- )
NEIGHBOUR-MASK & [ key 0 lit ] + draw-char ;
: draw-flag ( -- ) [ key ! lit ] draw-char ;
: draw-mine ( -- ) 0x0f draw-char ;
: draw-block ( -- ) 0xb1 draw-char ;
NEIGHBOUR-MASK & dup countcolors + b@ fg!
dup if [ key 0 lit ] + else drop [ key lit ] then draw-char ;
: draw-flag ( -- ) red fg! 0xb2 draw-char ;
: draw-mine ( -- ) black fg! 0x0f draw-char ;
: draw-block ( -- ) black fg! 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 ;
b@ dup FREVEALED & if draw-revealed else draw-hidden then white fg! ;
: pos>screen ( x y -- x y )
swap pagew boardw @ - 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 ( -- )
board begin dup board-lim < while
dup square-pos pos>screen textxy!
dup draw-square 1+ repeat drop ;
white fg! lgray bg! boardx! boardy! draw-board-top
board begin draw-row dup square-pos valid-pos? while draw-rowborder repeat
drop draw-board-bottom ;
0 var, reveal-state
: reveal ( p -- ) dup b@ FREVEALED | swap b! ;
@ -92,8 +105,21 @@ array board maxw maxh * allot
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 ;
0 const IN-PROGRESS
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
textmode
@ -101,3 +127,6 @@ array board maxw maxh * allot
15 10 15 init-board
draw-board ;
' start ' main redefine
{ s" mines.com" writecom }

7
text.jrt
View file

@ -137,12 +137,19 @@ var boxstyle
: vchar vstyle if 0xba else 0xb3 then ;
: hline ( count -- ) hchar draw-hrepeat ;
: vline ( count -- ) vchar draw-vrepeat ;
: .- hchar draw-char ;
: .| vchar draw-char ;
{ : :corner CREATE >t >t >t >t DOES} boxstyle @ 0x03 & + b@ draw-char ;
0xc9 0xd6 0xd5 0xda :corner tl
0xbb 0xb7 0xb8 0xbf :corner tr
0xc8 0xd3 0xd4 0xc0 :corner bl
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! ;
: boxbottom ( w -- ) bl 2 - hline br ;