GAME: syntax for defining game entry point with game-loop attributes

basis/ui/ui.factor

@@ -243,9 +243,8 @@ M: object close-window
 
 HOOK: beep ui-backend ( -- )
 
-: parse-main-window ( class -- attributes quot )
-    "{" expect dup all-slots parse-tuple-literal-slots
-    parse-definition ;
+: parse-main-window-attributes ( class -- attributes )
+    "{" expect dup all-slots parse-tuple-literal-slots ;
 
 : define-main-window ( word attributes quot -- )
     [
@@ -253,4 +252,7 @@ HOOK: beep ui-backend ( -- )
     ] [ 2drop current-vocab (>>main) ] 3bi ;
 
 SYNTAX: MAIN-WINDOW:
-    CREATE world-attributes parse-main-window define-main-window ;
+    CREATE
+    world-attributes parse-main-window-attributes
+    parse-definition
+    define-main-window ;

extra/game/worlds/worlds.factor

@@ -1,5 +1,6 @@
-USING: accessors game.input game.loop kernel math ui.gadgets
-ui.gadgets.worlds ui.gestures threads ;
+USING: accessors combinators fry game.input game.loop generic kernel math
+parser sequences ui ui.gadgets ui.gadgets.worlds ui.gestures threads
+words ;
 IN: game.worlds
 
 TUPLE: game-world < world
@@ -24,3 +25,26 @@ M: game-world end-world
 TUPLE: game-attributes < world-attributes
     { tick-interval-micros fixnum read-only } ;
 
+: verify-game-attributes ( attributes -- )
+    world-class>> { f world } member?
+    [ "GAME: must be given a custom world-class" throw ] when ;
+
+: define-game-tick-interval-micros ( attributes -- )
+    [ world-class>> \ tick-interval-micros create-method ]
+    [ tick-interval-micros>> '[ drop _ ] ] bi
+    define ;
+
+: define-game-methods ( attributes -- )
+    {
+        [ verify-game-attributes ]
+        [ define-game-tick-interval-micros ]
+    } cleave ;
+
+: define-game ( word attributes -- )
+    [ [ ] define-main-window ]
+    [ nip define-game-methods ] 2bi ;
+
+SYNTAX: GAME:
+    CREATE
+    game-attributes parse-main-window-attributes
+    define-game ;

extra/gpu/demos/bunny/bunny.factor

@@ -7,7 +7,7 @@ io io.encodings.ascii io.files io.files.temp kernel locals math
 math.matrices math.vectors.simd math.parser math.vectors
 method-chains namespaces sequences splitting threads ui ui.gadgets
 ui.gadgets.worlds ui.pixel-formats specialized-arrays
-specialized-vectors ;
+specialized-vectors literals ;
 FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-VECTOR: uint
@@ -293,15 +293,11 @@ M: bunny-world draw-world*
 AFTER: bunny-world resize-world
     [ sobel>> framebuffer>> ] [ dim>> ] bi resize-framebuffer ;
 
-M: bunny-world pref-dim* drop { 1024 768 } ;
-M: bunny-world tick-interval-micros drop 1000000 60 /i ;
 M: bunny-world wasd-movement-speed drop 1/160. ;
 M: bunny-world wasd-near-plane drop 1/32. ;
 M: bunny-world wasd-far-plane drop 256.0 ;
 
-: bunny-window ( -- )
-    [
-        f T{ world-attributes
+GAME: bunny-game {
         { world-class bunny-world }
         { title "Bunny" }
         { pixel-format-attributes {
@@ -310,7 +306,6 @@ M: bunny-world wasd-far-plane drop 256.0 ;
             T{ depth-bits { value 24 } }
         } }
         { grab-input? t }
-        } open-window
-    ] with-ui ;
-
-MAIN: bunny-window
+        { pref-dim { 1024 768 } }
+        { tick-interval-micros $[ 1,000,000 60 /i ] }
+    }

extra/gpu/demos/raytrace/raytrace.factor

@@ -92,13 +92,9 @@ M: raytrace-world draw-world*
         { "vertex-array"   [ vertex-array>>              ] }
     } <render-set> render ;
 
-M: raytrace-world pref-dim* drop { 1024 768 } ;
-M: raytrace-world tick-interval-micros drop 1000000 60 /i ;
 M: raytrace-world wasd-movement-speed drop 1/4. ;
 
-: raytrace-window ( -- )
-    [
-        f T{ world-attributes
+GAME: raytrace-game {
         { world-class raytrace-world }
         { title "Raytracing" }
         { pixel-format-attributes {
@@ -106,7 +102,6 @@ M: raytrace-world wasd-movement-speed drop 1/4. ;
             double-buffered
         } }
         { grab-input? t }
-        } open-window
-    ] with-ui ;
-
-MAIN: raytrace-window
+        { pref-dim { 1024 768 } }
+        { tick-interval-micros $[ 1,000,000 60 /i ] }
+    }

extra/terrain/terrain.factor

@@ -55,9 +55,6 @@ TUPLE: terrain-world < game-world
         float-4{ 0.0 0.0 0.0 1.0 } >>velocity
         VELOCITY-MODIFIER-NORMAL >>velocity-modifier ;
 
-M: terrain-world tick-interval-micros
-    drop 1000000 60 /i ;
-
 : frustum ( dim -- -x x -y y near far )
     dup first2 min v/n
     NEAR-PLANE FOV / v*n first2 [ [ neg ] keep ] bi@
@@ -290,11 +287,7 @@ M: terrain-world draw-world*
         ] with-gl-program ]
     } cleave gl-error ;
 
-M: terrain-world pref-dim* drop { 1024 768 } ;
-
-: terrain-window ( -- )
-    [
-        f T{ world-attributes
+GAME: terrain-game {
         { world-class terrain-world }
         { title "Terrain" }
         { pixel-format-attributes {
@@ -303,7 +296,6 @@ M: terrain-world pref-dim* drop { 1024 768 } ;
             T{ depth-bits { value 24 } }
         } }
         { grab-input? t }
-        } open-window
-    ] with-ui ;
-
-MAIN: terrain-window
+        { pref-dim { 1024 768 } }
+        { tick-interval-micros $[ 1,000,000 60 /i ] }
+    }