factor: trim using lists

[factor.git] / extra / tetris / tetris.factor

diff --git a/extra/tetris/tetris.factor b/extra/tetris/tetris.factor
index bb90f082b7620a69cf54f871cbf27366c5a7ed3c..38376124151a6bc0cbae2a74d1dfd89ce38440c2 100644 (file)
--- a/extra/tetris/tetris.factor
+++ b/extra/tetris/tetris.factor
@@ -1,19 +1,22 @@
 ! Copyright (C) 2006, 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alarms arrays calendar kernel make math math.rectangles math.parser namespaces sequences system tetris.game tetris.gl ui.gadgets ui.gadgets.labels ui.gadgets.worlds ui.gadgets.status-bar ui.gestures ui.render ui ;
+USING: accessors calendar kernel make math.parser sequences
+tetris.game tetris.gl timers ui ui.gadgets ui.gadgets.status-bar
+ui.gadgets.worlds ui.gestures ui.render ;
 IN: tetris
 
-TUPLE: tetris-gadget < gadget { tetris tetris } { alarm } ;
+TUPLE: tetris-gadget < gadget { tetris tetris } { timer } ;
 
 : <tetris-gadget> ( tetris -- gadget )
-    tetris-gadget new-gadget swap >>tetris ;
+    tetris-gadget new swap >>tetris ;
 
 M: tetris-gadget pref-dim* drop { 200 400 } ;
 
 : update-status ( gadget -- )
     dup tetris>> [
-        "Level: " % dup level>> #
-        " Score: " % score>> #
+        [ "Level: " % level # ]
+        [ " Score: " % score>> # ]
+        [ paused?>> [ " (Paused)" % ] when ] tri
     ] "" make swap show-status ;
 
 M: tetris-gadget draw-gadget* ( gadget -- )
@@ -24,17 +27,24 @@ M: tetris-gadget draw-gadget* ( gadget -- )
 : new-tetris ( gadget -- gadget )
     [ <new-tetris> ] change-tetris ;
 
+: unless-paused ( tetris quot -- )
+    over tetris>> paused?>> [
+        2drop
+    ] [
+        call
+    ] if ; inline
+
 tetris-gadget H{
     { T{ button-down f f 1 }     [ request-focus ] }
-    { T{ key-down f f "UP" }     [ tetris>> rotate-right ] }
-    { T{ key-down f f "d" }      [ tetris>> rotate-left ] }
-    { T{ key-down f f "f" }      [ tetris>> rotate-right ] }
-    { T{ key-down f f "e" }      [ tetris>> rotate-left ] } ! dvorak d
-    { T{ key-down f f "u" }      [ tetris>> rotate-right ] } ! dvorak f
-    { T{ key-down f f "LEFT" }   [ tetris>> move-left ] }
-    { T{ key-down f f "RIGHT" }  [ tetris>> move-right ] }
-    { T{ key-down f f "DOWN" }   [ tetris>> move-down ] }
-    { T{ key-down f f " " }      [ tetris>> move-drop ] }
+    { T{ key-down f f "UP" }     [ [ tetris>> rotate-right ] unless-paused ] }
+    { T{ key-down f f "d" }      [ [ tetris>> rotate-left ] unless-paused ] }
+    { T{ key-down f f "f" }      [ [ tetris>> rotate-right ] unless-paused ] }
+    { T{ key-down f f "e" }      [ [ tetris>> rotate-left ] unless-paused ] }
+    { T{ key-down f f "u" }      [ [ tetris>> rotate-right ] unless-paused ] }
+    { T{ key-down f f "LEFT" }   [ [ tetris>> move-left ] unless-paused ] }
+    { T{ key-down f f "RIGHT" }  [ [ tetris>> move-right ] unless-paused ] }
+    { T{ key-down f f "DOWN" }   [ [ tetris>> move-down ] unless-paused ] }
+    { T{ key-down f f " " }      [ [ tetris>> move-drop ] unless-paused ] }
     { T{ key-down f f "p" }      [ tetris>> toggle-pause ] }
     { T{ key-down f f "n" }      [ new-tetris drop ] }
 } set-gestures
@@ -43,12 +53,12 @@ tetris-gadget H{
     [ tetris>> ?update ] [ relayout-1 ] bi ;
 
 M: tetris-gadget graft* ( gadget -- )
-    [ [ tick ] curry 100 milliseconds every ] keep (>>alarm) ;
+    [ [ tick ] curry 100 milliseconds every ] keep timer<< ;
 
 M: tetris-gadget ungraft* ( gadget -- )
-    [ cancel-alarm f ] change-alarm drop ;
+    [ stop-timer f ] change-timer drop ;
 
-: tetris-window ( -- ) 
+: tetris-window ( -- )
     [
         <default-tetris> <tetris-gadget>
         "Tetris" open-status-window