From 4b1370fc286db564e32a8e2e890061bc3ed413ac Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Wed, 10 Feb 2016 22:00:02 -0500
Subject: examples: Update everything to use deferred GL resource loading.

---
 examples/animation.scm | 61 +++++++++++++++++++++++++++++++++++---------------
 1 file changed, 43 insertions(+), 18 deletions(-)

(limited to 'examples/animation.scm')

diff --git a/examples/animation.scm b/examples/animation.scm
index 8aaff2e..6afbf34 100644
--- a/examples/animation.scm
+++ b/examples/animation.scm
@@ -15,12 +15,14 @@
 ;;; along with this program.  If not, see
 ;;; <http://www.gnu.org/licenses/>.
 
-(use-modules (sly utils)
+(use-modules (srfi srfi-43)
+             (sly utils)
              (sly game)
              (sly window)
              (sly signal)
              (sly math)
              (sly math rect)
+             ((sly math transform) #:prefix t:)
              (sly math tween)
              (sly math vector)
              (sly render)
@@ -33,31 +35,54 @@
 (define sprite* (memoize make-sprite))
 (define move* (memoize move))
 
-(define walk-cycle
-  (let ((tiles (load-tileset "images/princess.png" 64 64)))
-    (list->vector
-     (map (lambda (id)
-            (sprite* (tileset-ref tiles id)))
-          '(19 20 21 22 23 24 25 26)))))
+(define (make-walk-cycle tiles)
+  (list->vector
+   (map (lambda (id)
+          (sprite* (tileset-ref tiles id)))
+        '(19 20 21 22 23 24 25 26))))
 
 (define position-tween
   (tween vlerp (compose ease-linear ease-loop)
-         (vector2 480 240) (vector2 160 240) 120))
+         (vector2 640 240) (vector2 0 240) 90))
 
-(define frame-tween
-  (let* ((frame-count (vector-length walk-cycle))
-         (frame-rate (/ 60 frame-count)))
-    (tween (compose floor lerp) (compose ease-linear ease-loop)
-           0 frame-count (* frame-count frame-rate))))
+(define (make-frame-tween walk-cycle)
+  (if (vector-empty? walk-cycle)
+      (const 0)
+      (let* ((frame-count (vector-length walk-cycle))
+             (frame-rate (/ 60 frame-count)))
+        (tween (compose floor lerp) (compose ease-linear ease-loop)
+               0 frame-count (* frame-count frame-rate)))))
 
 (define camera (2d-camera #:area (make-rect 0 0 640 480)))
 
+(define (move/interpolate new old renderer)
+  (lambda (gfx)
+    (graphics-model-view-excursion gfx
+      (lambda (gfx)
+        (let ((v (vlerp old new (graphics-alpha gfx))))
+          (graphics-model-view-mul! gfx (t:translate v))
+          (renderer gfx))))))
+
+(define (render time walk-cycle frame-tween)
+  (let* ((frame (vector-ref walk-cycle (frame-tween time))))
+    (with-camera camera
+      (move/interpolate (position-tween time)
+                        (position-tween (1- time))
+                        (render-sprite frame)))))
+
+(define-signal walk-cycle
+  (signal-map-maybe make-walk-cycle
+                    (on-start (load-tileset "images/princess.png" 64 64))))
+
+(define-signal time (signal-timer))
+
+(define-signal frame-tween
+  (signal-map-maybe make-frame-tween walk-cycle))
+
 (define-signal scene
-  (signal-let ((time (signal-timer)))
-    (let* ((frame (vector-ref walk-cycle (frame-tween time))))
-      (with-camera camera
-        (move* (position-tween time)
-               (render-sprite frame))))))
+  (signal-map (lambda (render)
+                (or render render-nothing))
+              (signal-map-maybe render time walk-cycle frame-tween)))
 
 (with-window (make-window #:title "Animation")
   (run-game-loop scene))
-- 
cgit v1.2.3