snake-game: some more cleanup.

diff --git a/extra/snake-game/snake-game.factor b/extra/snake-game/snake-game.factor
index 17b469e9af6c4daf08edb55dc7fc8801ea9a68ee..8d4331575a94dd5a98efbc269bab0968c7d71531 100644 (file)
--- a/extra/snake-game/snake-game.factor
+++ b/extra/snake-game/snake-game.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2015 Sankaranarayanan Viswanathan
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors sets snake-game.ui ui ui.gadgets.status-bar ui.gadgets.worlds ;
+USING: accessors sets snake-game.ui ui ui.gadgets.status-bar
+ui.gadgets.worlds ;
 IN: snake-game
 
 : <snake-world-attributes> ( -- world-attributes )
@@ -10,6 +11,10 @@ IN: snake-game
     ] change-window-controls ;
 
 : play-snake-game ( -- )
-    [ <snake-gadget> <snake-world-attributes> open-status-window ] with-ui ;
+    [
+        <snake-gadget>
+        <snake-world-attributes>
+        open-status-window
+    ] with-ui ;
 
 MAIN: play-snake-game

diff --git a/extra/snake-game/sprites/sprites.factor b/extra/snake-game/sprites/sprites.factor
index 26ff8438bd0e9c7d08175344747ff6c7d12e4c5c..c4945752443e36898bd9991ca27250d66cc7cdbb 100644 (file)
--- a/extra/snake-game/sprites/sprites.factor
+++ b/extra/snake-game/sprites/sprites.factor
@@ -62,3 +62,12 @@ IN: snake-game.sprites
 
 : background-texture ( -- assoc )
     "background" "background.png" load-snake-texture 2array 1array ;
+
+: snake-textures ( -- assoc )
+    [
+        snake-head-textures %%
+        snake-body-textures %%
+        snake-tail-textures %%
+        food-texture %%
+        background-texture %%
+    ] H{ } make ;

diff --git a/extra/snake-game/ui/ui.factor b/extra/snake-game/ui/ui.factor
index ec35c8bce18510f821c953b217f5c60847636eb7..e610370c11791a7ac0a2b88571522349095bc472 100644 (file)
--- a/extra/snake-game/ui/ui.factor
+++ b/extra/snake-game/ui/ui.factor
@@ -1,10 +1,10 @@
 ! Copyright (C) 2015 Sankaranarayanan Viswanathan.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs calendar combinators destructors
-formatting kernel make math math.vectors namespaces opengl
-opengl.textures sequences sets snake-game.game
-snake-game.sprites timers ui ui.gadgets ui.gadgets.worlds
-ui.gestures ui.render ;
+USING: accessors assocs calendar combinators
+combinators.short-circuit destructors formatting fry kernel math
+math.vectors namespaces opengl opengl.textures sequences sets
+snake-game.game snake-game.sprites timers ui ui.gadgets
+ui.gadgets.worlds ui.gestures ui.render ;
 
 IN: snake-game.ui
 
@@ -41,8 +41,7 @@ CONSTANT: snake-game-cell-size 20
 
 : draw-snake-head ( loc facing-dir -- )
     dup name>> rest "head-" prepend [
-        [ game-loc>screen-loc ] dip
-        {
+        [ game-loc>screen-loc ] dip {
             { :right [ { -20 -10 } ] }
             { :down  [ { -10 -20 } ] }
             { :up    [ { -10  0  } ] }
@@ -74,7 +73,7 @@ CONSTANT: snake-game-cell-size 20
     ! make sure to draw the head again
     first draw-snake-part ;
 
-: generate-status-message ( snake-game -- str )
+: game-status ( snake-game -- str )
     [ score>> ]
     [
         {
@@ -85,7 +84,7 @@ CONSTANT: snake-game-cell-size 20
     ] bi "Score: %d -- %s" sprintf ;
 
 : update-status ( gadget -- )
-    [ snake-game>> generate-status-message ] keep show-status ;
+    [ snake-game>> game-status ] keep show-status ;
 
 : do-updates ( gadget -- )
     [ snake-game>> do-game-step ]
@@ -96,55 +95,11 @@ CONSTANT: snake-game-cell-size 20
 : toggle-game-pause ( snake-gadget -- )
     snake-game>> [ not ] change-paused? drop ;
 
-: key-action ( key -- action )
-    H{
-        { "RIGHT"  :right }
-        { "LEFT"   :left }
-        { "UP"     :up }
-        { "DOWN"   :down }
-    } at ;
-
-: quit-key? ( key -- ? )
-    HS{ "ESC" "q" "Q" } in? ;
-
-: pause-key? ( key -- ? )
-    HS{ " " "SPACE" "p" "P" } in? ;
-
-: new-game-key? ( key -- ? )
-    HS{ "ENTER" "RET" "n" "N" } in? ;
-
-: ?handle-movement-key ( snake-game key -- )
-    key-action
-    [
-        2dup [ snake-dir>> opposite-dir ] dip =
-        [ 2drop ] [ >>next-turn-dir drop ] if
-    ] [ drop ] if* ;
-
-: handle-key ( snake-gadget key -- )
-    {
-        { [ dup quit-key? ] [ drop close-window ] }
-        { [ dup pause-key? ] [ drop toggle-game-pause ] }
-        { [ dup new-game-key? ] [ drop start-new-game ] }
-        [
-            [ snake-game>> ] dip over
-            game-in-progress? [ ?handle-movement-key ] [ 2drop ] if
-        ]
-    } cond ;
-
 : load-game-textures ( snake-gadget -- textures )
-    dup textures>> [ ] [
-        [
-            snake-head-textures %%
-            snake-body-textures %%
-            snake-tail-textures %%
-            food-texture %%
-            background-texture %%
-        ] H{ } make >>textures
-        textures>>
-    ] ?if ;
+    dup textures>> [ ] [ snake-textures >>textures textures>> ] ?if ;
 
 M: snake-gadget graft*
-    [ [ do-updates ] curry 200 milliseconds every ] keep timer<< ;
+    [ '[ _ do-updates ] 200 milliseconds every ] keep timer<< ;
 
 M: snake-gadget ungraft*
     [ stop-timer f ] change-timer
@@ -155,10 +110,10 @@ M: snake-gadget pref-dim*
     drop snake-game-dim [ snake-game-cell-size * 20 + ] map ;
 
 M: snake-gadget draw-gadget*
-    [ load-game-textures game-textures ] keep [
+    [ load-game-textures game-textures ] keep '[
         draw-background
         { 10 10 } [
-            snake-game>>
+            _ snake-game>>
             [ food-loc>> [ draw-food ] when* ]
             [
                 [ snake-loc>> ]
@@ -167,8 +122,38 @@ M: snake-gadget draw-gadget*
                 tri draw-snake
             ] bi
         ] with-translation
-    ] curry with-variable ;
+    ] with-variable ;
+
+: key-dir ( key -- dir )
+    H{
+        { "RIGHT"  :right }
+        { "LEFT"   :left }
+        { "UP"     :up }
+        { "DOWN"   :down }
+    } at ;
+
+: quit-key? ( key -- ? )
+    HS{ "ESC" "q" "Q" } in? ;
+
+: pause-key? ( key -- ? )
+    HS{ " " "SPACE" "p" "P" } in? ;
+
+: new-game-key? ( key -- ? )
+    HS{ "ENTER" "RET" "n" "N" } in? ;
 
 M: snake-gadget handle-gesture
-    swap dup key-down?
-    [ sym>> handle-key ] [ 2drop ] if f ;
+    swap dup key-down? [
+        sym>> {
+            { [ dup quit-key? ] [ drop close-window ] }
+            { [ dup pause-key? ] [ drop toggle-game-pause ] }
+            { [ dup new-game-key? ] [ drop start-new-game ] }
+            [
+                key-dir [
+                    swap snake-game>> dup {
+                        [ game-in-progress? ]
+                        [ snake-dir>> opposite-dir pick = not ]
+                    } 1&& [ next-turn-dir<< ] [ 2drop ] if
+                ] [ drop ] if*
+            ]
+        } cond
+    ] [ 2drop ] if f ;