]> gitweb.factorcode.org Git - factor.git/commitdiff
minesweeper: reduce duplicated code for click/mark/open cells.
authorJohn Benediktsson <mrjbq7@gmail.com>
Tue, 6 Mar 2018 23:50:47 +0000 (15:50 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Tue, 6 Mar 2018 23:50:47 +0000 (15:50 -0800)
extra/minesweeper/minesweeper.factor

index bae4f2b4cebd5fa681b99b83de7202ed5c479add..1a9c7062e2e218c7e326f255635ad616bb9c9db9 100644 (file)
@@ -253,50 +253,32 @@ M: grid-gadget draw-gadget*
         [ 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 drop
-        ] 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
-            ] when
-        ] unless
-    ] if gadget relayout-1 ;
-
-:: on-mark ( gadget -- )
+:: on-grid ( gadget quot: ( cells row col -- ? ) -- )
     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 [
+            cells row col quot call [
                 gadget start>> [ now gadget start<< ] unless
                 cells game-over? [ now gadget end<< ] when
             ] when
         ] unless
-    ] when gadget relayout-1 ;
+    ] when gadget relayout-1 ; inline
 
-:: on-open ( gadget -- )
+:: on-click ( 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 open-cell-at [
-                gadget start>> [ now gadget start<< ] unless
-                cells game-over? [ now gadget end<< ] when
-            ] when
-        ] unless
-    ] when gadget relayout-1 ;
+    h 58 < [
+        h 3 55 between?
+        gadget pref-dim first 2/ w - abs 26 < and [
+            gadget [ reset-cells ] change-cells
+            f >>start f >>end drop
+        ] when
+    ] when gadget [ click-cell-at ] on-grid ;
+
+: on-mark ( gadget -- ) [ mark-cell-at ] on-grid ;
+
+: on-open ( gadget -- ) [ open-cell-at ] on-grid ;
 
 : new-game ( gadget rows cols mines -- )
     [ make-cells ] dip place-mines update-counts >>cells