From 80731c6fb16136aca817b388636636635106c928 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@member.fsf.org>
Date: Wed, 4 Sep 2013 23:00:01 -0400
Subject: Update the rest of the examples to use the new declarative game
 stuff.

---
 examples/action.scm    | 75 +++++++++++++++++++++++---------------------------
 examples/animation.scm | 45 +++++++++++-------------------
 examples/coroutine.scm | 69 +++++++++++++++++++++-------------------------
 examples/font.scm      | 52 ++++++++++++----------------------
 examples/particles.scm | 64 +++++++++++++++++++++---------------------
 examples/tilemap.scm   | 30 +++++++-------------
 6 files changed, 141 insertions(+), 194 deletions(-)

diff --git a/examples/action.scm b/examples/action.scm
index dab15c1..c0d96b5 100644
--- a/examples/action.scm
+++ b/examples/action.scm
@@ -1,46 +1,39 @@
-(use-modules (2d sprite)
-             (2d game-loop)
-             (2d window)
-             (2d helpers)
+(use-modules (2d actions)
              (2d agenda)
              (2d coroutine)
-             (2d actions)
+             (2d game)
+             (2d sprite)
              (2d vector2))
 
-(define window-width 800)
-(define window-height 600)
-
-;; Open the window.
-(open-window window-width window-height)
-
-;; Load a sprite and center it on the screen.
-(define sprite
+(define (demo-sprite)
   (load-sprite "images/sprite.png"
-               #:position (vector2 (/ window-width 2)
-                                   (/ window-height 2))))
-
-(define (key-down key mod unicode)
-  (cond ((any-equal? key 'escape 'q)
-         (close-window)
-         (quit))))
-
-;; Draw our sprite
-(define (render)
-  (draw-sprite sprite))
-
-;; Register callbacks.
-(add-hook! on-render-hook (lambda () (render)))
-(add-hook! on-key-down-hook (lambda (key mod unicode) (key-down key mod unicode)))
-
-(schedule-action
- (action-parallel
-  ;; Move horizontally across the screen in 60 frames.
-  (lerp (lambda (x)
-          (set-sprite-position! sprite (vector2 x (/ window-height 2))))
-        0 800 60)
-  ;; Rotate 1080 degrees in 120 frames.
-  (lerp (lambda (angle)
-          (set-sprite-rotation! sprite angle))
-        0 1080 60)))
-
-(run-game-loop)
+               #:position (vector2 320 240)))
+
+(define (start sprite)
+  (let ((size (game-resolution actions)))
+    (schedule-action
+     (action-parallel
+      ;; Move horizontally across the screen in 60 frames.
+      (lerp (lambda (x)
+              (set-sprite-position!
+               sprite
+               (vector2 x (/ (vy size) 2))))
+            0 (vx size) 120)
+      ;; Rotate 1080 degrees in 120 frames.
+      (lerp (lambda (angle)
+              (set-sprite-rotation! sprite angle))
+            0 360 120)))))
+
+(define-scene demo
+  #:title  "Demo"
+  #:draw   (lambda (sprite) (draw-sprite sprite))
+  #:events (append
+            (default-scene-events)
+            `((start . ,(lambda (sprite) (start sprite)))))
+  #:state  (demo-sprite))
+
+(define-game actions
+  #:title       "actions"
+  #:first-scene demo)
+
+(run-game actions)
diff --git a/examples/animation.scm b/examples/animation.scm
index 0e58b8e..c165568 100644
--- a/examples/animation.scm
+++ b/examples/animation.scm
@@ -1,33 +1,13 @@
 (use-modules (2d animation)
-             (2d game-loop)
-             (2d helpers)
+             (2d game)
              (2d sprite)
              (2d tileset)
              (2d vector2)
              (2d window))
 
-(define window-width 800)
-(define window-height 600)
-
-;; Open the window.
-(open-window window-width window-height)
-
-(define (key-down key mod unicode)
-  (cond ((any-equal? key 'escape 'q)
-         (close-window)
-         (quit))))
-
-;; Draw our sprite
-(define (render)
-  (draw-sprite sprite))
-
-;; Register callbacks.
-(add-hook! on-render-hook (lambda () (render)))
-(add-hook! on-key-down-hook (lambda (key mod unicode) (key-down key mod unicode)))
-
-;; Load a texture, split it into 64x64 tiles, and build an animated
-;; sprite out of it.
-(define animation
+(define (demo-animation)
+  "Load a texture, split it into 64x64 tiles, and build an animated
+sprite out of it."
   (let* ((tiles (load-tileset "images/princess.png" 64 64))
          (frames (vector (tileset-ref tiles 19)
                          (tileset-ref tiles 20)
@@ -39,10 +19,17 @@
                          (tileset-ref tiles 26))))
     (make-animation frames 6 #t)))
 
-(define sprite
-  (make-sprite animation
-               #:position (vector2 (/ window-width 2)
-                                   (/ window-height 2))))
+(define (demo-sprite)
+  (make-sprite (demo-animation)
+               #:position (vector2 320 240)))
+
+(define-scene demo
+  #:title  "Demo"
+  #:draw   (lambda (sprite) (draw-sprite sprite))
+  #:state  (demo-sprite))
 
+(define-game animation
+  #:title       "Animation"
+  #:first-scene demo)
 
-(run-game-loop)
+(run-game animation)
diff --git a/examples/coroutine.scm b/examples/coroutine.scm
index 0a4d000..7fc3c2b 100644
--- a/examples/coroutine.scm
+++ b/examples/coroutine.scm
@@ -1,42 +1,35 @@
-(use-modules (2d sprite)
-             (2d game-loop)
-             (2d window)
-             (2d helpers)
-             (2d agenda)
+(use-modules (2d agenda)
              (2d coroutine)
+             (2d game)
+             (2d sprite)
              (2d vector2))
 
-(define window-width 800)
-(define window-height 600)
-
-;; Open the window.
-(open-window window-width window-height)
-
-(define sprite
+(define (demo-sprite)
   (load-sprite "images/sprite.png"
-               #:position (vector2 (/ window-width 2)
-                                   (/ window-height 2))))
-
-(define (key-down key mod unicode)
-  (cond ((any-equal? key 'escape 'q)
-         (close-window)
-         (quit))))
-
-;; Draw our sprite
-(define (render)
-  (draw-sprite sprite))
-
-;; Register callbacks.
-(add-hook! on-render-hook (lambda () (render)))
-(add-hook! on-key-down-hook (lambda (key mod unicode) (key-down key mod unicode)))
-
-;; Simple script that moves the sprite to a random location every
-;; second.
-(agenda-schedule
- (colambda ()
-   (while #t
-     (set-sprite-position! sprite (vector2 (random window-width)
-                                           (random window-height)))
-     (wait 60))))
-
-(run-game-loop)
+               #:position (vector2 320 240)))
+
+(define (start sprite)
+  ;; Simple script that moves the sprite to a random location every
+  ;; second.
+  (agenda-schedule
+   (colambda ()
+     (while #t
+       (set-sprite-position!
+        sprite
+        (vector2 (random (vx (game-resolution coroutines)))
+                 (random (vy (game-resolution coroutines)))))
+       (wait 60)))))
+
+(define-scene demo
+  #:title  "Demo"
+  #:draw   (lambda (sprite) (draw-sprite sprite))
+  #:events (append
+            (default-scene-events)
+            `((start . ,(lambda (sprite) (start sprite)))))
+  #:state  (demo-sprite))
+
+(define-game coroutines
+  #:title       "Coroutines"
+  #:first-scene demo)
+
+(run-game coroutines)
diff --git a/examples/font.scm b/examples/font.scm
index 680d4e6..aed6131 100644
--- a/examples/font.scm
+++ b/examples/font.scm
@@ -1,41 +1,25 @@
-(use-modules (figl gl)
+(use-modules (srfi srfi-9)
+             (figl gl)
              (2d color)
-             (2d game-loop)
-             (2d window)
-             (2d helpers)
              (2d font)
+             (2d game)
              (2d vector2))
 
-(define window-width 800)
-(define window-height 600)
-(define font (load-font "fonts/Boxy-Bold.ttf" 48))
-(define text "The quick brown fox jumped over the lazy dog.")
-(define textbox (make-textbox font text (vector2 320 300) white 'left 200))
+(define (demo-textbox)
+  (make-textbox (load-font "fonts/Boxy-Bold.ttf" 48)
+                "The quick brown fox jumped over the lazy dog."
+                (vector2 240 160)
+                white
+                'left
+                200))
 
-;; Open the window.
-(open-window window-width window-height)
+(define-scene demo
+  #:title  "Demo"
+  #:draw   (lambda (textbox) (draw-textbox textbox))
+  #:state  (demo-textbox))
 
-(define (quit-demo)
-  (close-window)
-  (quit))
+(define-game fonts
+  #:title       "Fonts"
+  #:first-scene demo)
 
-(define (key-down key mod unicode)
-  (cond ((any-equal? key 'escape 'q)
-         (quit-demo))))
-
-;; Draw our sprite
-(define (render)
-  (let ((fps (floor (inexact->exact (current-fps)))))
-    (with-gl-push-matrix
-      (use-color white)
-      (draw-font font (format #f "FPS: ~d" fps))))
-    (draw-textbox textbox))
-
-;; Register callbacks.
-(add-hook! on-quit-hook (lambda () (quit-demo)))
-(add-hook! on-render-hook (lambda () (render)))
-(add-hook! on-key-down-hook (lambda (key mod unicode) (key-down key mod unicode)))
-
-;; Start the game loop.
-;; The render callback will be called through this procedure.
-(run-game-loop)
+(run-game fonts)
diff --git a/examples/particles.scm b/examples/particles.scm
index dfe3322..1c5a3db 100644
--- a/examples/particles.scm
+++ b/examples/particles.scm
@@ -1,12 +1,10 @@
 ;; load the SDL module and some useful srfi's
 (use-modules (srfi srfi-1)
              (srfi srfi-9)
-             (2d game-loop)
-             (2d helpers)
+             (2d game)
              (2d sprite)
              (2d texture)
-             (2d vector2)
-             (2d window))
+             (2d vector2))
 
 (set! *random-state* (random-state-from-platform))
 
@@ -30,24 +28,23 @@
 ;;; Demo
 ;;;
 
-(define window-width 800)
-(define window-height 600)
+(define-record-type <demo-state>
+  (make-demo-state stars particles)
+  demo-state?
+  (stars demo-stars)
+  (particles demo-particles))
 
-(open-window window-width window-height)
+(define (generate-particles n)
+  (let ((particle-image (load-texture "images/bullet.png"))
+        (game-size (game-resolution particles)))
+    (list-tabulate n (lambda (n)
+                       (make-particle (make-sprite particle-image)
+                                      (vector2 (random (vx game-size))
+                                               (random (vy game-size)))
+                                      (vector2 (* (random:normal) 1)
+                                               (* (random:normal) 1)))))))
 
-(define stars (load-sprite "images/stars.png" #:anchor null-vector2))
-(define particle-image (load-texture "images/bullet.png"))
-(define particle-width (texture-width particle-image))
-(define particle-height (texture-height particle-image))
 (define particle-count 500)
-(define particles
-  (list-tabulate particle-count
-                 (lambda (n)
-                   (make-particle (make-sprite particle-image)
-                                  (vector2 (random window-width)
-                                           (random window-height))
-                                  (vector2 (* (random:normal) 1)
-                                           (* (random:normal) 1))))))
 (define batch (make-sprite-batch (* particle-count 4)))
 
 (define (draw-particles particles)
@@ -59,20 +56,23 @@
          (draw-sprite sprite)))
      particles)))
 
-(add-hook! on-render-hook (lambda () (render)))
-(add-hook! on-update-hook (lambda () (update)))
-(add-hook! on-key-down-hook (lambda (key mod unicode) (key-down key mod unicode)))
+(define (draw state)
+  (draw-sprite (demo-stars state))
+  (draw-particles (demo-particles state)))
 
-(define (key-down key mod unicode)
-  (cond ((any-equal? key 'escape 'q)
-         (close-window)
-         (quit))))
+(define (update state)
+  (for-each update-particle! (demo-particles state)))
 
-(define (render)
-  (draw-sprite stars)
-  (draw-particles particles))
+(define-scene demo
+  #:title  "Demo"
+  #:draw   (lambda (state) (draw state))
+  #:update (lambda (state) (update state))
+  #:state  (make-demo-state (load-sprite "images/stars.png"
+                                         #:anchor null-vector2)
+                            (generate-particles particle-count)))
 
-(define (update)
-  (for-each update-particle! particles))
+(define-game particles
+  #:title       "Particles"
+  #:first-scene demo)
 
-(run-game-loop)
+(run-game particles)
diff --git a/examples/tilemap.scm b/examples/tilemap.scm
index b64c04e..a60ee18 100644
--- a/examples/tilemap.scm
+++ b/examples/tilemap.scm
@@ -1,17 +1,11 @@
 (use-modules (srfi srfi-1)
              (srfi srfi-9)
              (srfi srfi-42)
-             (2d game-loop)
-             (2d helpers)
+             (2d game)
              (2d texture)
              (2d tileset)
              (2d sprite)
-             (2d vector2)
-             (2d window))
-
-(define window-width 800)
-(define window-height 600)
-(open-window window-width window-height)
+             (2d vector2))
 
 ;;;
 ;;; Orthogonal tile map example
@@ -87,17 +81,13 @@
                                     tileset
                                     map-tiles))))
 
-(define map (build-map))
-
-(define (key-down key mod unicode)
-  (cond ((any-equal? key 'escape 'q)
-         (close-window)
-         (quit))))
-
-(define (render)
-  (draw-map-layer map))
+(define-scene demo
+  #:title  "Demo"
+  #:draw   (lambda (map) (draw-map-layer map))
+  #:state  (build-map))
 
-(add-hook! on-key-down-hook (lambda (key mod unicode) (key-down key mod unicode)))
-(add-hook! on-render-hook (lambda () (render)))
+(define-game tilemap
+  #:title       "Tilemap"
+  #:first-scene demo)
 
-(run-game-loop)
+(run-game tilemap)
-- 
cgit v1.2.3