minesweeper: adding a fun minesweeper game.
After Width: | Height: | Size: 3.4 KiB |
After Width: | Height: | Size: 3.5 KiB |
After Width: | Height: | Size: 3.6 KiB |
After Width: | Height: | Size: 3.6 KiB |
After Width: | Height: | Size: 3.6 KiB |
After Width: | Height: | Size: 3.6 KiB |
After Width: | Height: | Size: 3.6 KiB |
After Width: | Height: | Size: 3.6 KiB |
After Width: | Height: | Size: 3.5 KiB |
After Width: | Height: | Size: 3.6 KiB |
After Width: | Height: | Size: 3.5 KiB |
After Width: | Height: | Size: 3.5 KiB |
After Width: | Height: | Size: 3.5 KiB |
After Width: | Height: | Size: 3.5 KiB |
After Width: | Height: | Size: 3.5 KiB |
After Width: | Height: | Size: 3.6 KiB |
After Width: | Height: | Size: 3.3 KiB |
After Width: | Height: | Size: 3.4 KiB |
After Width: | Height: | Size: 3.4 KiB |
After Width: | Height: | Size: 3.4 KiB |
After Width: | Height: | Size: 3.4 KiB |
After Width: | Height: | Size: 3.4 KiB |
After Width: | Height: | Size: 3.4 KiB |
After Width: | Height: | Size: 3.4 KiB |
After Width: | Height: | Size: 3.4 KiB |
After Width: | Height: | Size: 3.5 KiB |
After Width: | Height: | Size: 3.9 KiB |
After Width: | Height: | Size: 4.0 KiB |
After Width: | Height: | Size: 4.1 KiB |
After Width: | Height: | Size: 4.0 KiB |
|
@ -0,0 +1 @@
|
||||||
|
John Benediktsson
|
|
@ -0,0 +1,299 @@
|
||||||
|
! Copyright (C) 2017 John Benediktsson
|
||||||
|
! See http://factorcode.org/license.txt for BSD license
|
||||||
|
|
||||||
|
USING: accessors arrays assocs calendar colors.constants
|
||||||
|
combinators combinators.short-circuit destructors formatting fry
|
||||||
|
images.loader kernel locals math math.order math.parser
|
||||||
|
namespaces opengl opengl.textures random sequences timers ui
|
||||||
|
ui.commands ui.gadgets ui.gadgets.toolbar ui.gadgets.tracks
|
||||||
|
ui.gadgets.worlds ui.gestures ui.pens.solid ui.render words ;
|
||||||
|
|
||||||
|
IN: minesweeper
|
||||||
|
|
||||||
|
CONSTANT: neighbors {
|
||||||
|
{ -1 -1 } { -1 0 } { -1 1 }
|
||||||
|
{ 0 -1 } { 0 1 }
|
||||||
|
{ 1 -1 } { 1 0 } { 1 1 }
|
||||||
|
}
|
||||||
|
|
||||||
|
SYMBOLS: +flagged+ +question+ +clicked+ ;
|
||||||
|
|
||||||
|
TUPLE: cell #adjacent mined? state ;
|
||||||
|
|
||||||
|
: make-cells ( rows cols -- cells )
|
||||||
|
'[ _ [ cell new ] replicate ] replicate ;
|
||||||
|
|
||||||
|
:: cell-at ( cells row col -- cell/f )
|
||||||
|
row cells ?nth [ col swap ?nth ] [ f ] if* ;
|
||||||
|
|
||||||
|
: cells-dim ( cells -- rows cols )
|
||||||
|
[ length ] [ first length ] bi ;
|
||||||
|
|
||||||
|
: unmined-cell ( cells -- cell )
|
||||||
|
f [ dup mined?>> ] [ drop dup random random ] do while nip ;
|
||||||
|
|
||||||
|
: #mines ( cells -- n )
|
||||||
|
[ [ mined?>> ] count ] map-sum ;
|
||||||
|
|
||||||
|
: #flagged ( cells -- n )
|
||||||
|
[ [ state>> +flagged+ = ] count ] map-sum ;
|
||||||
|
|
||||||
|
: #mines-remaining ( cells -- n )
|
||||||
|
[ #mines ] [ #flagged ] bi - ;
|
||||||
|
|
||||||
|
: place-mines ( cells n -- cells )
|
||||||
|
[ dup unmined-cell t >>mined? drop ] times ;
|
||||||
|
|
||||||
|
: adjacent-mines ( cells row col -- #mines )
|
||||||
|
neighbors [
|
||||||
|
first2 [ + ] bi-curry@ bi* cell-at
|
||||||
|
[ mined?>> ] [ f ] if*
|
||||||
|
] with with with count ;
|
||||||
|
|
||||||
|
:: each-cell ( ... cells quot: ( ... row col cell -- ... ) -- ... )
|
||||||
|
cells [| row |
|
||||||
|
[| cell col | row col cell quot call ] each-index
|
||||||
|
] each-index ; inline
|
||||||
|
|
||||||
|
:: update-counts ( cells -- cells )
|
||||||
|
cells [| row col cell |
|
||||||
|
cells row col adjacent-mines cell #adjacent<<
|
||||||
|
] each-cell cells ;
|
||||||
|
|
||||||
|
: reset-cells ( cells -- cells )
|
||||||
|
[ cells-dim make-cells ] [ #mines place-mines ] bi update-counts ;
|
||||||
|
|
||||||
|
: won? ( cells -- ? )
|
||||||
|
[ [ { [ state>> +clicked+ = ] [ mined?>> ] } 1|| ] all? ] all? ;
|
||||||
|
|
||||||
|
: lost? ( cells -- ? )
|
||||||
|
[ [ { [ state>> +clicked+ = ] [ mined?>> ] } 1&& ] any? ] any? ;
|
||||||
|
|
||||||
|
: game-over? ( cells -- ? )
|
||||||
|
{ [ lost? ] [ won? ] } 1|| ;
|
||||||
|
|
||||||
|
: new-game? ( cells -- ? )
|
||||||
|
[ [ state>> +clicked+ = ] any? ] any? not ;
|
||||||
|
|
||||||
|
DEFER: click-cell-at
|
||||||
|
|
||||||
|
:: click-cells-around ( cells row col -- )
|
||||||
|
neighbors [
|
||||||
|
first2 [ row + ] [ col + ] bi* :> ( row' col' )
|
||||||
|
cells row' col' cell-at [
|
||||||
|
{ [ mined?>> ] [ state>> +question+ = ] } 1|| [
|
||||||
|
cells row' col' click-cell-at drop
|
||||||
|
] unless
|
||||||
|
] when*
|
||||||
|
] each ;
|
||||||
|
|
||||||
|
:: click-cell-at ( cells row col -- ? )
|
||||||
|
cells row col cell-at [
|
||||||
|
cells new-game? [
|
||||||
|
! first click shouldn't be a mine
|
||||||
|
dup mined?>> [
|
||||||
|
cells unmined-cell t >>mined? drop f >>mined?
|
||||||
|
cells update-counts drop
|
||||||
|
] when
|
||||||
|
] when
|
||||||
|
dup state>> { +clicked+ +flagged+ } member? [ drop f ] [
|
||||||
|
+clicked+ >>state
|
||||||
|
{ [ mined?>> not ] [ #adjacent>> 0 = ] } 1&& [
|
||||||
|
cells row col click-cells-around
|
||||||
|
] when t
|
||||||
|
] if
|
||||||
|
] [ f ] if* ;
|
||||||
|
|
||||||
|
:: mark-cell-at ( cells row col -- ? )
|
||||||
|
cells row col cell-at [
|
||||||
|
dup state>> {
|
||||||
|
{ +clicked+ [ +clicked+ ] }
|
||||||
|
{ +flagged+ [ +question+ ] }
|
||||||
|
{ +question+ [ f ] }
|
||||||
|
{ f [ +flagged+ ] }
|
||||||
|
} case >>state drop t
|
||||||
|
] [ f ] if* ;
|
||||||
|
|
||||||
|
TUPLE: grid-gadget < gadget cells timer textures start end ;
|
||||||
|
|
||||||
|
:: <grid-gadget> ( rows cols mines -- gadget )
|
||||||
|
grid-gadget new
|
||||||
|
rows cols make-cells
|
||||||
|
mines place-mines update-counts >>cells
|
||||||
|
H{ } clone >>textures
|
||||||
|
dup '[ _ relayout-1 ] f 1 seconds <timer> >>timer
|
||||||
|
COLOR: gray <solid> >>interior ;
|
||||||
|
|
||||||
|
M: grid-gadget graft*
|
||||||
|
[ timer>> start-timer ] [ call-next-method ] bi ;
|
||||||
|
|
||||||
|
M: grid-gadget ungraft*
|
||||||
|
[
|
||||||
|
dup find-gl-context
|
||||||
|
[ values dispose-each H{ } clone ] change-textures
|
||||||
|
timer>> stop-timer
|
||||||
|
] [ call-next-method ] bi ;
|
||||||
|
|
||||||
|
M: grid-gadget pref-dim*
|
||||||
|
cells>> cells-dim [ 32 * ] bi@ swap 58 + 2array ;
|
||||||
|
|
||||||
|
:: cell-image-path ( cell game-over? -- image-path )
|
||||||
|
game-over? cell mined?>> and [
|
||||||
|
cell state>> +clicked+ = "mineclicked.gif" "mine.gif" ?
|
||||||
|
] [
|
||||||
|
cell state>>
|
||||||
|
{
|
||||||
|
{ +question+ [ "question.gif" ] }
|
||||||
|
{ +flagged+ [ game-over? "misflagged.gif" "flagged.gif" ? ] }
|
||||||
|
{ +clicked+ [
|
||||||
|
cell mined?>> [
|
||||||
|
"mine.gif"
|
||||||
|
] [
|
||||||
|
cell #adjacent>> 0 or number>string
|
||||||
|
"open" ".gif" surround
|
||||||
|
] if ] }
|
||||||
|
{ f [ "blank.gif" ] }
|
||||||
|
} case
|
||||||
|
] if "vocab:minesweeper/_resources/" prepend ;
|
||||||
|
|
||||||
|
: digit-image-path ( ch -- image-path )
|
||||||
|
"vocab:minesweeper/_resources/digit%c.gif" sprintf ;
|
||||||
|
|
||||||
|
:: smiley-image-path ( won? lost? clicking? -- image-path )
|
||||||
|
{
|
||||||
|
{ [ lost? ] [ "vocab:minesweeper/_resources/smileylost.gif" ] }
|
||||||
|
{ [ won? ] [ "vocab:minesweeper/_resources/smileywon.gif" ] }
|
||||||
|
{ [ clicking? ] [ "vocab:minesweeper/_resources/smileyuhoh.gif" ] }
|
||||||
|
[ "vocab:minesweeper/_resources/smiley.gif" ]
|
||||||
|
} cond ;
|
||||||
|
|
||||||
|
: cached-texture ( path gadget -- texture )
|
||||||
|
textures>> [ load-image { 0 0 } <texture> ] cache ;
|
||||||
|
|
||||||
|
:: draw-mines ( n gadget -- )
|
||||||
|
n "%03d" sprintf [
|
||||||
|
26 * 3 + 6 2array [
|
||||||
|
digit-image-path gadget cached-texture
|
||||||
|
{ 26 46 } swap draw-scaled-texture
|
||||||
|
] with-translation
|
||||||
|
] each-index ;
|
||||||
|
|
||||||
|
:: draw-smiley ( gadget -- )
|
||||||
|
gadget pref-dim first :> width
|
||||||
|
width 2/ 26 - 3 2array [
|
||||||
|
gadget cells>> won?
|
||||||
|
gadget cells>> lost?
|
||||||
|
hand-buttons get-global empty? not
|
||||||
|
gadget hand-click-rel second 58 >= and
|
||||||
|
smiley-image-path
|
||||||
|
gadget cached-texture { 52 52 } swap draw-scaled-texture
|
||||||
|
] with-translation ;
|
||||||
|
|
||||||
|
:: draw-timer ( n gadget -- )
|
||||||
|
gadget pref-dim first :> width
|
||||||
|
n "%03d" sprintf [
|
||||||
|
3 swap - 26 * width swap - 3 - 6 2array [
|
||||||
|
digit-image-path gadget cached-texture
|
||||||
|
{ 26 46 } swap draw-scaled-texture
|
||||||
|
] with-translation
|
||||||
|
] each-index ;
|
||||||
|
|
||||||
|
:: draw-cells ( gadget -- )
|
||||||
|
gadget cells>> game-over? :> game-over?
|
||||||
|
gadget cells>> [| row col cell |
|
||||||
|
col row [ 32 * ] bi@ 58 + 2array [
|
||||||
|
cell game-over? cell-image-path
|
||||||
|
gadget cached-texture
|
||||||
|
{ 32 32 } swap draw-scaled-texture
|
||||||
|
] with-translation
|
||||||
|
] each-cell ;
|
||||||
|
|
||||||
|
:: elapsed-time ( gadget -- n )
|
||||||
|
gadget start>> [
|
||||||
|
gadget end>> now or swap time- duration>seconds
|
||||||
|
] [ 0 ] if* ;
|
||||||
|
|
||||||
|
M: grid-gadget draw-gadget*
|
||||||
|
{
|
||||||
|
[ cells>> #mines-remaining ]
|
||||||
|
[ draw-mines ]
|
||||||
|
[ draw-smiley ]
|
||||||
|
[ elapsed-time ]
|
||||||
|
[ draw-timer ]
|
||||||
|
[ draw-cells ]
|
||||||
|
} cleave ;
|
||||||
|
|
||||||
|
:: on-click ( gadget -- )
|
||||||
|
gadget hand-rel first2 :> ( w h )
|
||||||
|
h 58 < [
|
||||||
|
h 3 55 between?
|
||||||
|
gadget pref-dim first 2/ w - abs 26 < and [
|
||||||
|
gadget [ reset-cells ] change-cells
|
||||||
|
f >>start f >>end relayout-1
|
||||||
|
] when
|
||||||
|
] [
|
||||||
|
h 58 - w [ 32 /i ] bi@ :> ( row col )
|
||||||
|
gadget cells>> :> cells
|
||||||
|
cells game-over? [
|
||||||
|
cells row col click-cell-at [
|
||||||
|
gadget start>> [ now gadget start<< ] unless
|
||||||
|
cells game-over? [ now gadget end<< ] when
|
||||||
|
gadget relayout-1
|
||||||
|
] when
|
||||||
|
] unless
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
:: on-mark ( gadget -- )
|
||||||
|
gadget hand-rel first2 :> ( w h )
|
||||||
|
h 58 >= [
|
||||||
|
h 58 - w [ 32 /i ] bi@ :> ( row col )
|
||||||
|
gadget cells>> :> cells
|
||||||
|
cells game-over? [
|
||||||
|
cells row col mark-cell-at [
|
||||||
|
gadget start>> [ now gadget start<< ] unless
|
||||||
|
cells game-over? [ now gadget end<< ] when
|
||||||
|
gadget relayout-1
|
||||||
|
] when
|
||||||
|
] unless
|
||||||
|
] when ;
|
||||||
|
|
||||||
|
: new-game ( gadget rows cols mines -- )
|
||||||
|
[ make-cells ] dip place-mines update-counts >>cells
|
||||||
|
f >>start f >>end relayout-window ;
|
||||||
|
|
||||||
|
: com-easy ( gadget -- ) 7 7 10 new-game ;
|
||||||
|
|
||||||
|
: com-medium ( gadget -- ) 15 15 40 new-game ;
|
||||||
|
|
||||||
|
: com-hard ( gadget -- ) 15 30 99 new-game ;
|
||||||
|
|
||||||
|
grid-gadget "toolbar" f {
|
||||||
|
{ T{ key-down { sym "1" } } com-easy }
|
||||||
|
{ T{ key-down { sym "2" } } com-medium }
|
||||||
|
{ T{ key-down { sym "3" } } com-hard }
|
||||||
|
} define-command-map
|
||||||
|
|
||||||
|
grid-gadget "gestures" [
|
||||||
|
{
|
||||||
|
{ T{ button-down { # 1 } } [ relayout-1 ] }
|
||||||
|
{ T{ button-up { # 1 } } [ on-click ] }
|
||||||
|
{ T{ button-up { # 3 } } [ on-mark ] }
|
||||||
|
{ T{ key-down { sym " " } } [ on-mark ] }
|
||||||
|
} assoc-union
|
||||||
|
] change-word-prop
|
||||||
|
|
||||||
|
TUPLE: minesweeper-gadget < track ;
|
||||||
|
|
||||||
|
: <minesweeper-gadget> ( -- gadget )
|
||||||
|
vertical minesweeper-gadget new-track
|
||||||
|
7 7 10 <grid-gadget>
|
||||||
|
[ <toolbar> format-toolbar f track-add ]
|
||||||
|
[ 1 track-add ] bi ;
|
||||||
|
|
||||||
|
M: minesweeper-gadget focusable-child* children>> second ;
|
||||||
|
|
||||||
|
MAIN-WINDOW: run-minesweeper {
|
||||||
|
{ title "Minesweeper" }
|
||||||
|
{ window-controls
|
||||||
|
{ normal-title-bar close-button minimize-button } }
|
||||||
|
} <minesweeper-gadget> >>gadgets ;
|
|
@ -0,0 +1 @@
|
||||||
|
_resources
|
|
@ -0,0 +1 @@
|
||||||
|
Minesweeper game
|
|
@ -0,0 +1 @@
|
||||||
|
demos
|