Fix plist handling, add test for timed animation frames

1 files changed, 80 insertions, 0 deletions

diff --git a/demo/animation.scm b/demo/animation.scm
new file mode 100644
index 0000000..64c0d6a
--- /dev/null
+++ b/demo/animation.scm
@@ -0,0 +1,80 @@
+q(import scheme
+        (chicken base)
+	(chicken pretty-print)
+        (only srfi-1 iota)
+        (prefix sdl2 "sdl2:")
+        (prefix sdl2-ttf "ttf:")
+        downstroke-engine
+        downstroke-world
+        downstroke-renderer
+        downstroke-entity
+	downstroke-prefabs
+	downstroke-scene-loader
+	downstroke-tilemap
+	downstroke-animation)
+
+;; ── State ────────────────────────────────────────────────────────────────────
+
+(define *label-font*  #f)
+(define *title-font*  #f)
+
+(define (make-demo-entity x y tw th id)
+  (list #:type 'demo-bot
+        #:x x #:y y #:width tw #:height th
+        #:vx 0 #:vy 0
+        #:gravity? #t #:on-ground? #f
+        #:solid? #t #:immovable? #f
+        #:tile-id 1
+        #:demo-id id #:demo-since-jump 0))
+
+(define (make-demo-tilemap ts tw th gw gh)
+  (let* ((ncols     (inexact->exact (ceiling (/ gw tw))))
+         (nrows     (inexact->exact (ceiling (/ gh th))))
+         (empty-row (map (lambda (_) 0) (iota ncols)))
+         (floor-row (map (lambda (_) 20) (iota ncols)))
+         (map-data  (append (map (lambda (_) empty-row) (iota (- nrows 1)))
+                            (list floor-row))))
+    (make-tilemap
+     width: ncols height: nrows
+     tilewidth: tw tileheight: th
+     tileset-source: "" tileset: ts
+     layers: (list (make-layer name: "ground"
+                               width: ncols height: nrows
+                               map: map-data))
+     objects: '())))
+
+(define (make-demo-scene game)
+  (let* ((prefabs (load-prefabs "demo/assets/animation-prefabs.scm" (engine-mixins) '()))
+         (ts (game-load-tileset! game 'tileset "demo/assets/monochrome_transparent.tsx"))
+         (tw (tileset-tilewidth ts))
+         (th (tileset-tileheight ts))
+         (tex (create-texture-from-tileset (game-renderer game) ts))
+         (tm (make-demo-tilemap ts tw th (game-width game) (game-height game)))
+	 (entities (list (instantiate-prefab prefabs 'std-frames 80 80 tw th)
+			 (instantiate-prefab prefabs 'timed-frames 220 60 tw th))))
+    (pp entities)
+    (make-scene
+     entities: entities 
+     tilemap: tm
+     tileset: #f
+     camera: (make-camera x: 0 y: 0)
+     tileset-texture: tex
+     camera-target: #f
+     background: '(32 34 40))))
+
+(define *game*
+  (make-game
+   title: "Demo: Tweens" width: 640 height: 480
+
+   preload: (lambda (_game)
+	      (set! *title-font* (ttf:open-font "demo/assets/DejaVuSans.ttf" 22))
+	      (set! *label-font* (ttf:open-font "demo/assets/DejaVuSans.ttf" 13)))
+
+   create: (lambda (game)
+	     (game-scene-set! game (make-demo-scene game)))
+
+   update: (lambda (game dt)
+	     (let ((scene (game-scene game)))
+	       (game-scene-set! game (scene-map-entities scene (cut apply-animation <> <> dt)))))))
+
+(game-run! *game*)