diff --git a/mines.com b/mines.com new file mode 100755 index 0000000..59d1e21 Binary files /dev/null and b/mines.com differ diff --git a/mines.jrt b/mines.jrt index bf3f822..4e5ab58 100755 --- a/mines.jrt +++ b/mines.jrt @@ -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 } diff --git a/text.jrt b/text.jrt index 0a79f19..e286e38 100755 --- a/text.jrt +++ b/text.jrt @@ -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 ;