Harmonize spelling

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

diff --git a/extra/tetris/game/game.factor b/extra/tetris/game/game.factor
index 869a7c49c20aa115b683f6dd804f18e9fd9c6bba..ac5dbc2579ea3f31944b460ada4e38aae2d21d7c 100644 (file)
--- a/extra/tetris/game/game.factor
+++ b/extra/tetris/game/game.factor
@@ -1,54 +1,57 @@
-! Copyright (C) 2006, 2007 Alex Chapman
+! Copyright (C) 2006, 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences math tetris.board tetris.piece
-tetris.tetromino lazy-lists combinators system ;
+
+USING: accessors combinators kernel lists math math.functions
+sequences system tetris.board tetris.piece ;
+
 IN: tetris.game
 
-TUPLE: tetris pieces last-update update-interval rows score game-state paused? running? ;
+TUPLE: tetris
+    { board board }
+    { pieces }
+    { last-update integer initial: 0 }
+    { rows integer initial: 0 }
+    { score integer initial: 0 }
+    { paused? initial: f }
+    { running? initial: t } ;
 
-: default-width 10 ; inline
-: default-height 20 ; inline
+CONSTANT: default-width 10
+CONSTANT: default-height 20
 
 : <tetris> ( width height -- tetris )
-    <board> tetris construct-delegate
-    dup board-width <piece-llist> over set-tetris-pieces
-    0 over set-tetris-last-update
-    0 over set-tetris-rows
-    0 over set-tetris-score
-    f over set-tetris-paused?
-    t over set-tetris-running? ;
+    dupd <board> swap <piece-llist>
+    tetris new swap >>pieces swap >>board ;
 
-: <default-tetris> ( -- tetris ) default-width default-height <tetris> ;
+: <default-tetris> ( -- tetris )
+    default-width default-height <tetris> ;
 
 : <new-tetris> ( old -- new )
-    [ board-width ] keep board-height <tetris> ;
+    board>> [ width>> ] [ height>> ] bi <tetris> ;
 
-: tetris-board ( tetris -- board ) delegate ;
+: current-piece ( tetris -- piece ) pieces>> car ;
 
-: tetris-current-piece ( tetris -- piece ) tetris-pieces car ;
-
-: tetris-next-piece ( tetris -- piece ) tetris-pieces cdr car ;
+: next-piece ( tetris -- piece ) pieces>> cdr car ;
 
 : toggle-pause ( tetris -- )
-    dup tetris-paused? not swap set-tetris-paused? ;
+    [ not ] change-paused? drop ;
 
-: tetris-level ( tetris -- level )
-    tetris-rows 1+ 10 / ceiling ;
+: level ( tetris -- level )
+    rows>> 1 + 10 / ceiling ;
 
-: tetris-update-interval ( tetris -- interval )
-    tetris-level 1- 60 * 1000 swap - ;
+: update-interval ( tetris -- interval )
+    level 1 - 60 * 1,000,000,000 swap - ;
 
 : add-block ( tetris block -- )
-    over tetris-current-piece tetromino-colour board-set-block ;
+    over [ board>> ] 2dip current-piece tetromino>> color>> set-block ;
 
 : game-over? ( tetris -- ? )
-    dup tetris-next-piece piece-valid? not ;
+    [ board>> ] [ next-piece ] bi piece-valid? not ;
 
-: new-current-piece ( tetris -- )
+: new-current-piece ( tetris -- tetris )
     dup game-over? [
-        f swap set-tetris-running?
+        f >>running?
     ] [
-        dup tetris-pieces cdr swap set-tetris-pieces
+        [ cdr ] change-pieces
     ] if ;
 
 : rows-score ( level n -- score )
@@ -58,36 +61,38 @@ TUPLE: tetris pieces last-update update-interval rows score game-state paused? r
         { 2 [ 100 ] }
         { 3 [ 300 ] }
         { 4 [ 1200 ] }
-    } case swap 1+ * ;
+    } case swap 1 + * ;
+
+: add-score ( tetris n-rows -- tetris )
+    over level swap rows-score swap [ + ] change-score ;
 
-: add-score ( tetris score -- )
-    over tetris-score + swap set-tetris-score ;
+: add-rows ( tetris rows -- tetris )
+    swap [ + ] change-rows ;
 
 : score-rows ( tetris n -- )
-    2dup >r dup tetris-level r> rows-score add-score
-    over tetris-rows + swap set-tetris-rows ;
+    [ add-score ] keep add-rows drop ;
 
 : lock-piece ( tetris -- )
-    [ dup tetris-current-piece piece-blocks [ add-block ] curry* each ] keep
-    dup new-current-piece dup check-rows score-rows ;
+    [ dup current-piece piece-blocks [ add-block ] with each ]
+    [ new-current-piece dup board>> check-rows score-rows ] bi ;
 
 : can-rotate? ( tetris -- ? )
-    dup tetris-current-piece clone dup 1 rotate-piece piece-valid? ;
+    [ board>> ] [ current-piece clone 1 rotate-piece ] bi piece-valid? ;
 
 : (rotate) ( inc tetris -- )
-    dup can-rotate? [ tetris-current-piece swap rotate-piece ] [ 2drop ] if ;
+    dup can-rotate? [ current-piece swap rotate-piece drop ] [ 2drop ] if ;
 
 : rotate-left ( tetris -- ) -1 swap (rotate) ;
 
 : rotate-right ( tetris -- ) 1 swap (rotate) ;
 
 : can-move? ( tetris move -- ? )
-    >r dup tetris-current-piece clone dup r> move-piece piece-valid? ;
+    [ drop board>> ] [ [ current-piece clone ] dip move-piece ] 2bi piece-valid? ;
 
 : tetris-move ( tetris move -- ? )
-    #! moves the piece if possible, returns whether the piece was moved
+    ! moves the piece if possible, returns whether the piece was moved
     2dup can-move? [
-        >r tetris-current-piece r> move-piece t
+        [ current-piece ] dip move-piece drop t
     ] [
         2drop f
     ] if ;
@@ -103,11 +108,11 @@ TUPLE: tetris pieces last-update update-interval rows score game-state paused? r
     dup { 0 1 } tetris-move [ move-drop ] [ lock-piece ] if ;
 
 : update ( tetris -- )
-    millis over tetris-last-update -
-    over tetris-update-interval > [
+    nano-count over last-update>> -
+    over update-interval > [
         dup move-down
-        millis swap set-tetris-last-update
-    ] [ drop ] if ;
+        nano-count >>last-update
+    ] when drop ;
 
-: maybe-update ( tetris -- )
-    dup tetris-paused? over tetris-running? not or [ drop ] [ update ] if ;
+: ?update ( tetris -- )
+    dup [ paused?>> ] [ running?>> not ] bi or [ drop ] [ update ] if ;