Rework animations and entities - somewhat

1 files changed, 61 insertions, 40 deletions

diff --git a/animation.scm b/animation.scm
index 4caf1fe..468f7f0 100644
--- a/animation.scm
+++ b/animation.scm
@@ -2,54 +2,75 @@
   (import scheme
           (chicken base)
           (chicken keyword)
+	  (only srfi-1 filter)
           downstroke-entity
           downstroke-world)
 
   ;; ---- Animation data accessors ----
 
-  (define (animation-frames anim) (get-keyword #:frames anim))
-  (define (animation-duration anim) (get-keyword #:duration anim))
-
-  ;; ---- frame->tile-id ----
-  ;; Given a frames list and frame index, return the tile ID (1-indexed).
-
-  (define (frame->tile-id frames frame-idx)
-    (+ 1 (list-ref frames (modulo frame-idx (length frames)))))
-
-  ;; ---- set-animation ----
-  ;; Switch to a new animation, resetting frame and tick counters.
-  ;; No-op if the animation is already active (avoids restart mid-loop).
-
-  (define (set-animation entity name)
-    (if (eq? (entity-ref entity #:anim-name #f) name)
-        entity
-        (entity-set (entity-set (entity-set entity #:anim-name name)
-                                #:anim-frame 0)
-                    #:anim-tick 0)))
-
-  ;; ---- animate-entity ----
-  ;; Advance the animation tick/frame counter for one game tick.
-  ;; Pass the animation table for this entity's type.
-  ;; Entities without #:anim-name are returned unchanged.
-
-  (define (advance-animation entity anim)
-    (let* ((tick     (+ 1 (entity-ref entity #:anim-tick 0)))
-           (duration (animation-duration anim))
-           (frames   (animation-frames anim))
-           (frame    (entity-ref entity #:anim-frame 0)))
-      (if (>= tick duration)
-          (let ((new-frame (modulo (+ frame 1) (length frames))))
-            (entity-set (entity-set (entity-set entity
-                                                #:anim-tick 0)
-                                    #:anim-frame new-frame)
-                        #:tile-id (frame->tile-id frames new-frame)))
-          (entity-set (entity-set entity #:anim-tick tick)
-                      #:tile-id (frame->tile-id frames frame)))))
+  (define (animation-frames anim)
+    (get-keyword #:frames anim))
+  (define (animation-duration anim)
+    (get-keyword #:duration anim))
+
+(define (frame-by-idx frames frame-idx)
+  (list-ref frames (modulo frame-idx (length frames))))
+
+;; The tile ID is 1-indexed.
+(define (frame->tile-id frames frame-idx)
+  (let ((frame-def (frame-by-idx frames frame-idx)))
+    (+ 1 (if (list? frame-def)
+	     (car frame-def)
+	     frame-def))))
+
+(define (frame->duration frames frame-idx)
+  (let ((frame-def (frame-by-idx frames frame-idx)))
+    (if (list? frame-def)
+	(cadr frame-def)
+	10)))
+
+;; ---- set-animation ----
+;; Switch to a new animation, resetting frame and tick counters.
+;; No-op if the animation is already active (avoids restart mid-loop).
+
+(define (set-animation entity name)
+  (if (eq? (entity-ref entity #:anim-name #f) name)
+      entity
+      (entity-set (entity-set (entity-set entity #:anim-name name)
+                              #:anim-frame 0)
+                  #:anim-tick 0)))
+
+
+(define (animation-by-name animations name)
+  (let ((matching-anims (filter (lambda (anim) (eq? (get-keyword #:name anim) 'walk)) animations)))
+    (if matching-anims
+	(car matching-anims)
+	#f)))
+
+;; ---- animate-entity ----
+;; Advance the animation tick/frame counter for one game tick.
+;; Pass the animation table for this entity's type.
+;; Entities without #:anim-name are returned unchanged.
+
+(define (advance-animation entity anim)
+  (let* ((tick     (+ 1 (entity-ref entity #:anim-tick 0)))
+         (duration (animation-duration anim))
+         (frames   (animation-frames anim))
+         (frame    (entity-ref entity #:anim-frame 0)))
+    (if (>= tick duration)
+        (let ((new-frame-id (modulo (+ frame 1) (length frames))))
+          (entity-set-many entity
+			   (list (cons #:anim-tick 0)
+				 (cons #:anim-frame new-frame-id)
+				 (cons #:tile-id (frame->tile-id frames new-frame-id))
+				 (cons #:duration (frame->duration frames new-frame-id)))))
+        (entity-set-many entity
+			 (list (cons #:anim-tick tick)
+			       (cons #:tile-id (frame->tile-id frames frame)))))))
 
   (define (animate-entity entity animations)
     (let* ((anim-name (entity-ref entity #:anim-name #f))
-           (entry     (and anim-name (assq anim-name animations)))
-           (anim      (and entry (cdr entry))))
+           (anim      (and anim-name (animation-by-name animations anim-name))))
       (if anim
           (advance-animation entity anim)
           entity)))