extra/game/worlds/worlds.factor

   1 USING: accessors combinators fry game.input game.loop generic kernel math
   2 parser sequences ui ui.gadgets ui.gadgets.worlds ui.gestures threads
   3 words ;
   4 IN: game.worlds
   5
   6 TUPLE: game-world < world
   7     game-loop
   8     { tick-slice float initial: 0.0 } ;
   9
  10 GENERIC: tick-interval-micros ( world -- micros )
  11
  12 M: game-world draw*
  13     swap >>tick-slice relayout-1 yield ;
  14
  15 M: game-world begin-world
  16     open-game-input
  17     dup [ tick-interval-micros ] [ ] bi <game-loop> [ >>game-loop ] keep start-loop
  18     drop ;
  19
  20 M: game-world end-world
  21     [ [ stop-loop ] when* f ] change-game-loop
  22     close-game-input
  23     drop ;
  24
  25 TUPLE: game-attributes < world-attributes
  26     { tick-interval-micros fixnum read-only } ;
  27
  28 : verify-game-attributes ( attributes -- )
  29     world-class>> { f world } member?
  30     [ "GAME: must be given a custom world-class" throw ] when ;
  31
  32 : define-game-tick-interval-micros ( attributes -- )
  33     [ world-class>> \ tick-interval-micros create-method ]
  34     [ tick-interval-micros>> '[ drop _ ] ] bi
  35     define ;
  36
  37 : define-game-methods ( attributes -- )
  38     {
  39         [ verify-game-attributes ]
  40         [ define-game-tick-interval-micros ]
  41     } cleave ;
  42
  43 : define-game ( word attributes -- )
  44     [ [ ] define-main-window ]
  45     [ nip define-game-methods ] 2bi ;
  46
  47 SYNTAX: GAME:
  48     CREATE
  49     game-attributes parse-main-window-attributes
  50     define-game ;