-! 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 arrays math math.vectors namespaces
-opengl opengl.gl ui.render ui.gadgets tetris.game tetris.board
-tetris.piece tetris.tetromino ;
+
+USING: accessors arrays colors combinators kernel math opengl
+opengl.gl sequences tetris.game tetris.piece ;
+
IN: tetris.gl
-#! OpenGL rendering for tetris
+! OpenGL rendering for tetris
: draw-block ( block -- )
- dup { 1 1 } v+ gl-fill-rect ;
+ { 1 1 } gl-fill-rect ;
: draw-piece-blocks ( piece -- )
piece-blocks [ draw-block ] each ;
: draw-piece ( piece -- )
- dup tetromino-colour gl-color draw-piece-blocks ;
+ dup tetromino>> color>> gl-color draw-piece-blocks ;
: draw-next-piece ( piece -- )
- dup tetromino-colour clone 0.2 3 pick set-nth gl-color draw-piece-blocks ;
+ dup tetromino>> color>>
+ >rgba-components drop 0.2 <rgba> gl-color draw-piece-blocks ;
! TODO: move implementation specific stuff into tetris-board
: (draw-row) ( x y row -- )
- >r over r> nth dup
- [ gl-color 2array draw-block ] [ 3drop ] if ;
+ overd nth [ gl-color 2array draw-block ] [ 2drop ] if* ;
: draw-row ( y row -- )
- dup length -rot [ (draw-row) ] 2curry each ;
+ [ length <iota> swap ] keep [ (draw-row) ] 2curry each ;
: draw-board ( board -- )
- board-rows dup length swap
- [ dupd nth draw-row ] curry each ;
-
-: scale-tetris ( width height tetris -- )
- [ board-width swap ] keep board-height / -rot / swap 1 glScalef ;
-
-: (draw-tetris) ( width height tetris -- )
- #! width and height are in pixels
- GL_MODELVIEW [
- [ scale-tetris ] keep
- dup tetris-board draw-board
- dup tetris-next-piece draw-next-piece
- tetris-current-piece draw-piece
- ] do-matrix ;
+ 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 -- )
- origin get [ (draw-tetris) ] with-translation ;
+ ! 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 ]
+ } cleave
+ ] do-matrix ;