]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/tetris/gl/gl.factor
Harmonize spelling
[factor.git] / extra / tetris / gl / gl.factor
index e425c4766fad303eec084ccc70874eba04879664..e0565c8aa01702d79d58da4dc31b8d49c5bd941e 100644 (file)
@@ -1,47 +1,56 @@
-! 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 ;