]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/tetris/board/board.factor
factor: trim using lists
[factor.git] / extra / tetris / board / board.factor
index 00ddda002150c00c85915cd2bd96697ad22281a1..9acb53d8b36b143165f4fe14cf276bce99986aa8 100644 (file)
@@ -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 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 ;
@@ -24,11 +29,11 @@ TUPLE: board { width integer } { height integer } rows ;
 : block-free? ( board block -- ? ) block not ;
 
 : block-in-bounds? ( board block -- ? )
-    [ first swap width>> iota bounds-check? ]
-    [ second swap height>> iota bounds-check? ] 2bi and ;
+    [ first swap width>> <iota> bounds-check? ]
+    [ 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 ;