factor: trim using lists

[factor.git] / extra / game / worlds / worlds.factor

diff --git a/extra/game/worlds/worlds.factor b/extra/game/worlds/worlds.factor
index 1fd7f53905306282d9ee125afe5dd616bd04ae86..5fdc110783be0342519daf92ea36a0b6b497220a 100644 (file)
--- a/extra/game/worlds/worlds.factor
+++ b/extra/game/worlds/worlds.factor
@@ -1,64 +1,89 @@
-! (c)2009 Joe Groff bsd license
-USING: accessors combinators fry game.input game.loop generic kernel math
-parser sequences ui ui.gadgets ui.gadgets.worlds ui.gestures threads
-words ;
+! Copyright (C) 2009 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors audio.engine combinators concurrency.promises
+destructors game.input game.loop kernel math parser sequences
+threads ui ui.gadgets ui.gadgets.worlds vocabs.parser
+words.constant ;
 IN: game.worlds
 
 TUPLE: game-world < world
     game-loop
+    audio-engine
+    { tick-interval-nanos integer }
+    { use-game-input? boolean }
+    { use-audio-engine? boolean }
+    { audio-engine-device initial: f }
+    { audio-engine-voice-count initial: 16 }
     { tick-slice float initial: 0.0 } ;
 
-GENERIC: tick-interval-micros ( world -- micros )
+GENERIC: begin-game-world ( world -- )
+M: object begin-game-world drop ;
+
+GENERIC: end-game-world ( world -- )
+M: object end-game-world drop ;
+
+GENERIC: tick-game-world ( world -- )
+M: object tick-game-world drop ;
+
+M: game-world tick*
+    [ tick-game-world ]
+    [ audio-engine>> [ update-audio ] when* ] bi ;
 
 M: game-world draw*
     swap >>tick-slice relayout-1 yield ;
 
+<PRIVATE
+
+: open-game-audio-engine ( game-world -- audio-engine )
+    {
+        [ audio-engine-device>> ]
+        [ audio-engine-voice-count>> ]
+    } cleave <audio-engine>
+    [ start-audio* ] keep ; inline
+
+PRIVATE>
+
 M: game-world begin-world
-    open-game-input 
-    dup [ tick-interval-micros ] [ ] bi <game-loop> [ >>game-loop ] keep start-loop
-    drop ;
+    dup use-game-input?>> [ open-game-input ] when
+    dup use-audio-engine?>> [ dup open-game-audio-engine >>audio-engine ] when
+    dup [ tick-interval-nanos>> ] [ ] bi <game-loop>
+    [ >>game-loop begin-game-world ] keep start-loop ;
 
 M: game-world end-world
-    [ [ stop-loop ] when* f ] change-game-loop
-    close-game-input
-    drop ;
+    dup game-loop>> [ stop-loop ] when*
+    [ end-game-world ]
+    [ audio-engine>> [ dispose ] when* ]
+    [ use-game-input?>> [ close-game-input ] when ] tri ;
 
 TUPLE: game-attributes < world-attributes
-    { tick-interval-micros fixnum read-only } ;
-
-<PRIVATE
+    { tick-interval-nanos integer }
+    { use-game-input? boolean initial: f }
+    { use-audio-engine? boolean initial: f }
+    { audio-engine-device initial: f }
+    { audio-engine-voice-count initial: 16 } ;
 
-: verify-game-attributes ( attributes -- )
+M: game-world apply-world-attributes
     {
-        [
-            world-class>> { f world } member?
-            [ "GAME: must be given a custom world-class" throw ] when
-        ]
-        [
-            tick-interval-micros>> 0 <=
-            [ "GAME: must be given a nonzero tick-interval-micros" throw ] when
-        ]
+        [ tick-interval-nanos>> >>tick-interval-nanos ]
+        [ use-game-input?>> >>use-game-input? ]
+        [ use-audio-engine?>> >>use-audio-engine? ]
+        [ audio-engine-device>> >>audio-engine-device ]
+        [ audio-engine-voice-count>> >>audio-engine-voice-count ]
+        [ call-next-method ]
     } cleave ;
 
-: define-game-tick-interval-micros ( attributes -- )
-    [ world-class>> \ tick-interval-micros create-method ]
-    [ tick-interval-micros>> '[ drop _ ] ] bi
-    define ;
+: start-game ( attributes -- game-world )
+    f swap open-window* ;
 
-: define-game-methods ( attributes -- )
-    {
-        [ verify-game-attributes ]
-        [ define-game-tick-interval-micros ]
-    } cleave ;
-
-: define-game ( word attributes quot -- )
-    [ define-main-window ]
-    [ drop nip define-game-methods ] 3bi ;
+: wait-game ( attributes -- game-world )
+    f swap open-window* dup promise>> ?promise drop ;
 
-PRIVATE>
+: define-attributes-word ( word tuple -- )
+    [ name>> "-attributes" append create-word-in ] dip define-constant ;
 
 SYNTAX: GAME:
-    CREATE
-    game-attributes parse-main-window-attributes
+    scan-new-word
+    game-attributes parse-window-attributes
+    2dup define-attributes-word
     parse-definition
-    define-game ;
+    [ define-window ] [ 2drop current-vocab main<< ] 3bi ;