extra/game/worlds/worlds.factor

   1 ! Copyright (C) 2009 Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors audio.engine combinators concurrency.promises
   4 destructors game.input game.loop kernel math parser sequences
   5 threads ui ui.gadgets ui.gadgets.worlds vocabs.parser
   6 words.constant ;
   7 IN: game.worlds
   8
   9 TUPLE: game-world < world
  10     game-loop
  11     audio-engine
  12     { tick-interval-nanos integer }
  13     { use-game-input? boolean }
  14     { use-audio-engine? boolean }
  15     { audio-engine-device initial: f }
  16     { audio-engine-voice-count initial: 16 }
  17     { tick-slice float initial: 0.0 } ;
  18
  19 GENERIC: begin-game-world ( world -- )
  20 M: object begin-game-world drop ;
  21
  22 GENERIC: end-game-world ( world -- )
  23 M: object end-game-world drop ;
  24
  25 GENERIC: tick-game-world ( world -- )
  26 M: object tick-game-world drop ;
  27
  28 M: game-world tick*
  29     [ tick-game-world ]
  30     [ audio-engine>> [ update-audio ] when* ] bi ;
  31
  32 M: game-world draw*
  33     swap >>tick-slice relayout-1 yield ;
  34
  35 <PRIVATE
  36
  37 : open-game-audio-engine ( game-world -- audio-engine )
  38     {
  39         [ audio-engine-device>> ]
  40         [ audio-engine-voice-count>> ]
  41     } cleave <audio-engine>
  42     [ start-audio* ] keep ; inline
  43
  44 PRIVATE>
  45
  46 M: game-world begin-world
  47     dup use-game-input?>> [ open-game-input ] when
  48     dup use-audio-engine?>> [ dup open-game-audio-engine >>audio-engine ] when
  49     dup [ tick-interval-nanos>> ] [ ] bi <game-loop>
  50     [ >>game-loop begin-game-world ] keep start-loop ;
  51
  52 M: game-world end-world
  53     dup game-loop>> [ stop-loop ] when*
  54     [ end-game-world ]
  55     [ audio-engine>> [ dispose ] when* ]
  56     [ use-game-input?>> [ close-game-input ] when ] tri ;
  57
  58 TUPLE: game-attributes < world-attributes
  59     { tick-interval-nanos integer }
  60     { use-game-input? boolean initial: f }
  61     { use-audio-engine? boolean initial: f }
  62     { audio-engine-device initial: f }
  63     { audio-engine-voice-count initial: 16 } ;
  64
  65 M: game-world apply-world-attributes
  66     {
  67         [ tick-interval-nanos>> >>tick-interval-nanos ]
  68         [ use-game-input?>> >>use-game-input? ]
  69         [ use-audio-engine?>> >>use-audio-engine? ]
  70         [ audio-engine-device>> >>audio-engine-device ]
  71         [ audio-engine-voice-count>> >>audio-engine-voice-count ]
  72         [ call-next-method ]
  73     } cleave ;
  74
  75 : start-game ( attributes -- game-world )
  76     f swap open-window* ;
  77
  78 : wait-game ( attributes -- game-world )
  79     f swap open-window* dup promise>> ?promise drop ;
  80
  81 : define-attributes-word ( word tuple -- )
  82     [ name>> "-attributes" append create-word-in ] dip define-constant ;
  83
  84 SYNTAX: GAME:
  85     scan-new-word
  86     game-attributes parse-window-attributes
  87     2dup define-attributes-word
  88     parse-definition
  89     [ define-window ] [ 2drop current-vocab main<< ] 3bi ;