1 ! Copyright (C) 2006, 2007, 2008 Alex Chapman
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays colors combinators math.vectors
4 kernel math opengl opengl.gl opengl.textures sequences sokoban.game sokoban.piece images.loader
9 ! OpenGL rendering for sokoban ;
11 : draw-block ( block -- )
12 { 1 1 } gl-fill-rect ;
14 : draw-sprite ( block path -- )
15 load-image swap <texture> { 1 1 } swap draw-scaled-texture ;
17 :: draw-piece-blocks ( piece -- )
18 piece piece-blocks [ piece path>> draw-sprite ] each ;
20 : draw-piece ( piece -- )
21 dup layout>> color>> gl-color draw-piece-blocks ;
23 : draw-goal ( block -- )
24 { 0.38 0.38 } v+ { 0.24 0.24 } gl-fill-rect ;
26 : draw-goal-blocks ( piece -- )
27 ! implement goals the same way we do as walls
28 wall-blocks [ draw-goal ] each ;
30 : draw-goal-piece ( piece -- )
31 dup layout>> color>> gl-color draw-goal-blocks ;
33 ! TODO: move implementation specific stuff into sokoban-board
34 : (draw-row) ( x y row -- )
35 overd nth [ gl-color 2array draw-block ] [ 2drop ] if* ;
37 : draw-row ( y row -- )
38 [ length <iota> swap ] keep [ (draw-row) ] 2curry each ;
40 : draw-board ( board -- )
41 rows>> [ swap draw-row ] each-index ;
43 : scale-board ( width height board -- )
44 [ width>> ] [ height>> ] bi swapd [ / ] dup 2bi* 1 glScalef ;
46 : set-background-color ( sokoban -- )
48 paused?>> COLOR: light-gray COLOR: white ?
49 ] [ drop COLOR: black ] if gl-color ;
51 : draw-background ( board -- )
52 [ 0 0 ] dip [ width>> ] [ height>> ] bi glRectf ;
54 : draw-sokoban ( width height sokoban -- )
55 ! width and height are in pixels
58 [ board>> scale-board ]
59 [ set-background-color ]
60 [ board>> draw-background ]
61 [ board>> draw-board ]
62 [ player>> draw-piece ]
63 [ goals>> draw-goal-piece ]
64 [ boxes>> [ draw-piece ] each ]