2008-10-01 21:12:46 -04:00
|
|
|
! Copyright (C) 2006, 2007, 2008 Alex Chapman
|
2007-09-20 18:09:08 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2009-03-07 02:22:21 -05:00
|
|
|
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 ;
|
2007-09-20 18:09:08 -04:00
|
|
|
IN: tetris.gl
|
|
|
|
|
|
|
|
#! OpenGL rendering for tetris
|
|
|
|
|
|
|
|
: draw-block ( block -- )
|
2009-03-27 19:31:25 -04:00
|
|
|
{ 1 1 } gl-fill-rect ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: draw-piece-blocks ( piece -- )
|
|
|
|
piece-blocks [ draw-block ] each ;
|
|
|
|
|
|
|
|
: draw-piece ( piece -- )
|
2008-11-11 04:10:41 -05:00
|
|
|
dup tetromino>> colour>> gl-color draw-piece-blocks ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: draw-next-piece ( piece -- )
|
2008-10-01 21:12:46 -04:00
|
|
|
dup tetromino>> colour>>
|
2009-03-07 02:22:21 -05:00
|
|
|
>rgba-components drop 0.2 <rgba> gl-color draw-piece-blocks ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
! TODO: move implementation specific stuff into tetris-board
|
|
|
|
: (draw-row) ( x y row -- )
|
2008-12-17 23:29:32 -05:00
|
|
|
[ over ] dip nth dup
|
2008-11-11 04:10:41 -05:00
|
|
|
[ gl-color 2array draw-block ] [ 3drop ] if ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: draw-row ( y row -- )
|
2010-01-14 12:15:15 -05:00
|
|
|
[ length iota swap ] keep [ (draw-row) ] 2curry each ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: draw-board ( board -- )
|
2010-01-14 12:15:15 -05:00
|
|
|
rows>> [ length iota ] keep
|
2007-09-20 18:09:08 -04:00
|
|
|
[ dupd nth draw-row ] curry each ;
|
|
|
|
|
2008-10-01 21:12:46 -04:00
|
|
|
: scale-board ( width height board -- )
|
|
|
|
[ width>> ] [ height>> ] bi swapd [ / ] dup 2bi* 1 glScalef ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2009-03-10 17:59:48 -04:00
|
|
|
: draw-tetris ( width height tetris -- )
|
2007-09-20 18:09:08 -04:00
|
|
|
#! width and height are in pixels
|
2009-04-05 18:32:53 -04:00
|
|
|
[
|
2008-10-01 21:12:46 -04:00
|
|
|
{
|
|
|
|
[ board>> scale-board ]
|
|
|
|
[ board>> draw-board ]
|
|
|
|
[ next-piece draw-next-piece ]
|
|
|
|
[ current-piece draw-piece ]
|
|
|
|
} cleave
|
2009-03-10 17:59:48 -04:00
|
|
|
] do-matrix ;
|