tetris: some cleanup, simplify.

diff --git a/extra/tetris/board/board.factor b/extra/tetris/board/board.factor
index e41dc1f7259e17b8242e02e7b7dd13c3f8ace69d..2340e2091c1bac0c8fe14656a916f1331fd3a7b9 100644 (file)
--- a/extra/tetris/board/board.factor
+++ b/extra/tetris/board/board.factor
@@ -1,18 +1,23 @@
 ! Copyright (C) 2006, 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel math sequences tetris.piece ;
+USING: accessors arrays combinators.short-circuit fry kernel
+math sequences tetris.piece ;
 IN: tetris.board
 
-TUPLE: board { width integer } { height integer } rows ;
+TUPLE: board
+    { width integer }
+    { height integer }
+    { rows array } ;
 
 : make-rows ( width height -- rows )
-    <iota> [ drop f <array> ] with map ;
+    swap '[ _ f <array> ] replicate ;
 
 : <board> ( width height -- board )
     2dup make-rows board boa ;
 
-! A block is simply an array of form { x y } where { 0 0 } is the top-left of
-! the tetris board, and { 9 19 } is the bottom right on a 10x20 board.
+! A block is simply an array of form { x y } where { 0 0 } is
+! the top-left of the tetris board, and { 9 19 } is the bottom
+! right on a 10x20 board.
 
 : board@block ( board block -- n row )
     [ second swap rows>> nth ] keep first swap ;
@@ -28,7 +33,7 @@ TUPLE: board { width integer } { height integer } rows ;
     [ second swap height>> <iota> bounds-check? ] 2bi and ;
 
 : location-valid? ( board block -- ? )
-    2dup block-in-bounds? [ block-free? ] [ 2drop f ] if ;
+    { [ block-in-bounds? ] [ block-free? ] } 2&& ;
 
 : piece-valid? ( board piece -- ? )
     piece-blocks [ location-valid? ] with all? ;
@@ -49,6 +54,6 @@ TUPLE: board { width integer } { height integer } rows ;
     [ [ row-not-full? ] filter ] change-rows ;
 
 : check-rows ( board -- n )
-    ! remove full rows, then add blank ones at the top, returning the number
-    ! of rows removed (and added)
+    ! remove full rows, then add blank ones at the top,
+    ! returning the number of rows removed (and added)
     remove-full-rows dup height>> over rows>> length - swap top-up-rows ;

diff --git a/extra/tetris/game/game.factor b/extra/tetris/game/game.factor
index ae7db29539afda9fd593c5dd6b217a72c336ebb9..b2d3cc8833f456d662487d5c471a41c29c884dd6 100644 (file)
--- a/extra/tetris/game/game.factor
+++ b/extra/tetris/game/game.factor
@@ -1,6 +1,9 @@
 ! Copyright (C) 2006, 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators kernel lists math math.functions sequences system tetris.board tetris.piece tetris.tetromino ;
+
+USING: accessors combinators kernel lists math math.functions
+sequences system tetris.board tetris.piece tetris.tetromino ;
+
 IN: tetris.game
 
 TUPLE: tetris
@@ -19,7 +22,8 @@ CONSTANT: default-height 20
     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>> ] [ height>> ] bi <tetris> ;
@@ -31,11 +35,11 @@ CONSTANT: default-height 20
 : toggle-pause ( tetris -- )
     [ not ] change-paused? drop ;
 
-: level>> ( tetris -- level )
+: level ( tetris -- level )
     rows>> 1 + 10 / ceiling ;
 
 : update-interval ( tetris -- interval )
-    level>> 1 - 60 * 1,000,000,000 swap - ;
+    level 1 - 60 * 1,000,000,000 swap - ;
 
 : add-block ( tetris block -- )
     over [ board>> ] 2dip current-piece tetromino>> colour>> set-block ;
@@ -60,7 +64,7 @@ CONSTANT: default-height 20
     } case swap 1 + * ;
 
 : add-score ( tetris n-rows -- tetris )
-    over level>> swap rows-score swap [ + ] change-score ;
+    over level swap rows-score swap [ + ] change-score ;
 
 : add-rows ( tetris rows -- tetris )
     swap [ + ] change-rows ;
@@ -69,8 +73,8 @@ CONSTANT: default-height 20
     [ add-score ] keep add-rows drop ;
 
 : lock-piece ( tetris -- )
-    [ dup current-piece piece-blocks [ add-block ] with each ] keep
-    new-current-piece dup board>> 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 -- ? )
     [ board>> ] [ current-piece clone 1 rotate-piece ] bi piece-valid? ;

diff --git a/extra/tetris/gl/gl.factor b/extra/tetris/gl/gl.factor
index 4d99f0bd41e14b2362a29b9272e717cc0c274ac1..561af386f491016604c5fbe7f6393d37941623d2 100644 (file)
--- a/extra/tetris/gl/gl.factor
+++ b/extra/tetris/gl/gl.factor
@@ -1,8 +1,9 @@
 ! Copyright (C) 2006, 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators kernel math math.vectors
-namespaces opengl opengl.gl sequences tetris.board tetris.game
-tetris.piece ui.render tetris.tetromino ui.gadgets colors ;
+USING: accessors arrays colors colors.constants combinators
+kernel math opengl opengl.gl sequences tetris.game tetris.piece
+;
+
 IN: tetris.gl
 
 ! OpenGL rendering for tetris
@@ -22,24 +23,32 @@ IN: tetris.gl
 
 ! TODO: move implementation specific stuff into tetris-board
 : (draw-row) ( x y row -- )
-    overd nth dup
-    [ gl-color 2array draw-block ] [ 3drop ] if ;
+    overd nth [ gl-color 2array draw-block ] [ 2drop ] if* ;
 
 : draw-row ( y row -- )
     [ length <iota> swap ] keep [ (draw-row) ] 2curry each ;
 
 : draw-board ( board -- )
-    rows>> [ length <iota> ] keep
-    [ dupd nth draw-row ] curry each ;
+    rows>> [ swap draw-row ] each-index ;
 
 : scale-board ( width height board -- )
     [ width>> ] [ height>> ] bi swapd [ / ] dup 2bi* 1 glScalef ;
 
+: set-background-color ( tetris -- )
+    dup running?>> [
+        paused?>> COLOR: light-gray COLOR: white ?
+    ] [ drop COLOR: black ] if gl-color ;
+
+: draw-background ( board -- )
+    [ 0 0 ] dip [ width>> ] [ height>> ] bi glRectf ;
+
 : draw-tetris ( width height tetris -- )
     ! width and height are in pixels
     [
         {
             [ board>> scale-board ]
+            [ set-background-color ]
+            [ board>> draw-background ]
             [ board>> draw-board ]
             [ next-piece draw-next-piece ]
             [ current-piece draw-piece ]

diff --git a/extra/tetris/piece/piece.factor b/extra/tetris/piece/piece.factor
index 44edafaa6e07901dbcab0dadc664bd1c94767114..5dcafb255a5de2c6a5059341c5ee5b7f7c263fb4 100644 (file)
--- a/extra/tetris/piece/piece.factor
+++ b/extra/tetris/piece/piece.factor
@@ -1,11 +1,13 @@
 ! Copyright (C) 2006, 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel math math.vectors sequences tetris.tetromino lists.lazy ;
+USING: accessors arrays kernel math math.vectors sequences
+tetris.tetromino lists.lazy ;
 IN: tetris.piece
 
-! The rotation is an index into the tetromino's states array, and the
-! position is added to the tetromino's blocks to give them their location on the
-! tetris board. If the location is f then the piece is not yet on the board.
+! The rotation is an index into the tetromino's states array,
+! and the position is added to the tetromino's blocks to give
+! them their location on the tetris board. If the location is f
+! then the piece is not yet on the board.
 
 TUPLE: piece
     { tetromino tetromino }
@@ -35,12 +37,8 @@ TUPLE: piece
 : <piece-llist> ( board-width -- llist )
     [ [ <random-piece> ] curry ] keep [ <piece-llist> ] curry lazy-cons ;
 
-: modulo ( n m -- n )
-  ! -2 7 mod => -2, -2 7 modulo =>  5
-  [ mod ] [ + ] [ mod ] tri ;
-
 : (rotate-piece) ( rotation inc n-states -- rotation' )
-    [ + ] dip modulo ;
+    [ + ] dip rem ;
 
 : rotate-piece ( piece inc -- piece )
     over tetromino>> states>> length

diff --git a/extra/tetris/tetris.factor b/extra/tetris/tetris.factor
index 65099888911c864bf14af37c177a7c3ab2903380..255144d4ec7db1377433079e591fabeb92d8a467 100644 (file)
--- a/extra/tetris/tetris.factor
+++ b/extra/tetris/tetris.factor
@@ -4,7 +4,6 @@ USING: accessors timers 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 ;
-FROM: tetris.game => level>> ;
 IN: tetris
 
 TUPLE: tetris-gadget < gadget { tetris tetris } { timer } ;
@@ -16,7 +15,7 @@ M: tetris-gadget pref-dim* drop { 200 400 } ;
 
 : update-status ( gadget -- )
     dup tetris>> [
-        [ "Level: " % level>> # ]
+        [ "Level: " % level # ]
         [ " Score: " % score>> # ]
         [ paused?>> [ " (Paused)" % ] when ] tri
     ] "" make swap show-status ;