extra/sokoban/gl/gl.factor

   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
   5 ;
   6
   7 IN: sokoban.gl
   8
   9 ! OpenGL rendering for sokoban ;
  10
  11 : draw-block ( block -- )
  12     { 1 1 } gl-fill-rect ;
  13
  14 : draw-sprite ( block path -- )
  15     load-image swap <texture> { 1 1 } swap draw-scaled-texture ;
  16
  17 :: draw-piece-blocks ( piece -- )
  18     piece piece-blocks [ piece path>> draw-sprite ] each ;
  19
  20 : draw-piece ( piece -- )
  21     dup layout>> color>> gl-color draw-piece-blocks ;
  22
  23 : draw-goal ( block -- )
  24     { 0.38 0.38 } v+ { 0.24 0.24 } gl-fill-rect ;
  25
  26 : draw-goal-blocks ( piece -- )
  27     ! implement goals the same way we do as walls
  28     wall-blocks [ draw-goal ] each ;
  29
  30 : draw-goal-piece ( piece -- )
  31     dup layout>> color>> gl-color draw-goal-blocks ;
  32
  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* ;
  36
  37 : draw-row ( y row -- )
  38     [ length <iota> swap ] keep [ (draw-row) ] 2curry each ;
  39
  40 : draw-board ( board -- )
  41     rows>> [ swap draw-row ] each-index ;
  42
  43 : scale-board ( width height board -- )
  44     [ width>> ] [ height>> ] bi swapd [ / ] dup 2bi* 1 glScalef ;
  45
  46 : set-background-color ( sokoban -- )
  47     dup running?>> [
  48         paused?>> COLOR: light-gray COLOR: white ?
  49     ] [ drop COLOR: black ] if gl-color ;
  50
  51 : draw-background ( board -- )
  52     [ 0 0 ] dip [ width>> ] [ height>> ] bi glRectf ;
  53
  54 : draw-sokoban ( width height sokoban -- )
  55     ! width and height are in pixels
  56     [
  57         {
  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 ]
  65         } cleave
  66     ] do-matrix ;