extra/gamelib/demos/sokoban/loop/loop.factor

   1
   2 USING: accessors colors fonts game.loop gamelib.board
   3 gamelib.loop gamelib.ui kernel math namespaces opengl
   4 prettyprint sequences gamelib.demos.sokoban.layouts ui ui.gadgets ui.text
   5 combinators ;
   6
   7 IN: gamelib.demos.sokoban.loop
   8
   9 SYMBOL: level
  10
  11 TUPLE: game-state gadget ;
  12
  13 :: check-win ( board -- ? )
  14     board [ crate-cell cell-contains-instance? ] find-all-cells-nopos :> seq
  15     seq length 0 = not seq [ dark-crate make-crate cell-contains? ] all? and ;
  16
  17 :: <game-state> ( gadget -- gadget game-state )
  18     gadget
  19     game-state new
  20     gadget >>gadget ;
  21
  22 : create-loop ( game-state -- )
  23     10000000 swap new-game-loop start-loop ;
  24
  25 : game-over ( gadget -- gadget )
  26     [ { 200 200 } [ monospace-font t >>bold? 50 >>size COLOR: red >>foreground "YOU WIN!" draw-text ] with-translation ] draw-quote ;
  27
  28 :: tick-update ( game-state -- )
  29     game-state gadget>> :> g
  30     g relayout-window
  31     g board>> first check-win
  32     [
  33         {
  34             { [ level get-global 0 = ] [ level [ 1 + ] change-global game-state g { } >>board { } >>draw-quotes board-two >>gadget drop g { 1500 750 } set-dim relayout ] }
  35             { [ level get-global 1 = ] [ level [ 1 + ] change-global game-state g { } >>board { } >>draw-quotes board-three >>gadget drop g { 600 600 } set-dim relayout ] }
  36             { [ level get-global 2 = ] [ g game-over relayout-1 stop-game ] }
  37         } cond
  38     ] when ;
  39
  40 M: game-state tick* tick-update ;
  41
  42 M: game-state draw* drop drop ;