diff --git a/extra/tetris/board/board.factor b/extra/tetris/board/board.factor index e41dc1f725..2340e2091c 100644 --- 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 ) - [ drop f ] with map ; + swap '[ _ f ] replicate ; : ( 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>> 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 ae7db29539..b2d3cc8833 100644 --- 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 swap tetris new swap >>pieces swap >>board ; -: ( -- tetris ) default-width default-height ; +: ( -- tetris ) + default-width default-height ; : ( old -- new ) board>> [ width>> ] [ height>> ] bi ; @@ -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 4d99f0bd41..561af386f4 100644 --- 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 swap ] keep [ (draw-row) ] 2curry each ; : draw-board ( board -- ) - rows>> [ length ] 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 44edafaa6e..5dcafb255a 100644 --- 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 : ( board-width -- llist ) [ [ ] curry ] keep [ ] 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 6509988891..255144d4ec 100644 --- 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 ;