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 words.constant ;
8 TUPLE: game-world < world
11 { tick-interval-nanos integer }
12 { use-game-input? boolean }
13 { use-audio-engine? boolean }
14 { audio-engine-device initial: f }
15 { audio-engine-voice-count initial: 16 }
16 { tick-slice float initial: 0.0 } ;
18 GENERIC: begin-game-world ( world -- )
19 M: object begin-game-world drop ;
21 GENERIC: end-game-world ( world -- )
22 M: object end-game-world drop ;
24 GENERIC: tick-game-world ( world -- )
25 M: object tick-game-world drop ;
29 [ audio-engine>> [ update-audio ] when* ] bi ;
32 swap >>tick-slice relayout-1 yield ;
36 : open-game-audio-engine ( game-world -- audio-engine )
38 [ audio-engine-device>> ]
39 [ audio-engine-voice-count>> ]
40 } cleave <audio-engine>
41 [ start-audio* ] keep ; inline
45 M: game-world begin-world
46 dup use-game-input?>> [ open-game-input ] when
47 dup use-audio-engine?>> [ dup open-game-audio-engine >>audio-engine ] when
48 dup [ tick-interval-nanos>> ] [ ] bi <game-loop>
49 [ >>game-loop begin-game-world ] keep start-loop ;
51 M: game-world end-world
52 dup game-loop>> [ stop-loop ] when*
54 [ audio-engine>> [ dispose ] when* ]
55 [ use-game-input?>> [ close-game-input ] when ] tri ;
57 TUPLE: game-attributes < world-attributes
58 { tick-interval-nanos integer }
59 { use-game-input? boolean initial: f }
60 { use-audio-engine? boolean initial: f }
61 { audio-engine-device initial: f }
62 { audio-engine-voice-count initial: 16 } ;
64 M: game-world apply-world-attributes
66 [ tick-interval-nanos>> >>tick-interval-nanos ]
67 [ use-game-input?>> >>use-game-input? ]
68 [ use-audio-engine?>> >>use-audio-engine? ]
69 [ audio-engine-device>> >>audio-engine-device ]
70 [ audio-engine-voice-count>> >>audio-engine-voice-count ]
74 : start-game ( attributes -- game-world )
77 : wait-game ( attributes -- game-world )
78 f swap open-window* dup promise>> ?promise drop ;
80 : define-attributes-word ( word tuple -- )
81 [ name>> "-attributes" append create-word-in ] dip define-constant ;
85 game-attributes parse-window-attributes
86 2dup define-attributes-word
88 [ define-window ] [ 2drop current-vocab main<< ] 3bi ;