diff options
Diffstat (limited to 'animation.scm')
| -rw-r--r-- | animation.scm | 182 |
1 files changed, 92 insertions, 90 deletions
diff --git a/animation.scm b/animation.scm index 1005868..ea13125 100644 --- a/animation.scm +++ b/animation.scm @@ -1,92 +1,94 @@ (module (downstroke animation) * - (import scheme - (chicken base) - (only srfi-1 filter) - (downstroke entity) - (downstroke world)) - - ;; Animation definitions are alists (converted from plist form in the user's - ;; prefab data file by load-prefabs). Each animation is an alist with keys - ;; #:name, #:frames, optional #:duration. - - ;; Look up a key in an animation alist. Mirrors entity-ref: - ;; a non-procedure default is returned as-is on miss; a procedure default - ;; is invoked as a thunk. - (define (animation-ref anim key #!optional default) - (cond ((assq key anim) => cdr) - ((procedure? default) (default)) - (else default))) - - (define (animation-frames anim) (animation-ref anim #:frames)) - (define (animation-duration anim) (animation-ref anim #:duration)) - - (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))) - (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? (animation-ref anim #:name) name)) - animations))) - (if (pair? 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 - `((#:anim-tick . 0) - (#:anim-frame . ,new-frame-id) - (#:tile-id . ,(frame->tile-id frames new-frame-id)) - (#:duration . ,(frame->duration frames new-frame-id))))) +(import scheme + (chicken base) + (only srfi-1 filter) + (downstroke entity) + (downstroke world)) + +;; Animation definitions are alists (converted from plist form in the user's +;; prefab data file by load-prefabs). Each animation is an alist with keys +;; #:name, #:frames, optional #:duration. + +;; Look up a key in an animation alist. Mirrors entity-ref: +;; a non-procedure default is returned as-is on miss; a procedure default +;; is invoked as a thunk. +(define (animation-ref anim key #!optional default) + (cond ((assq key anim) => cdr) + ((procedure? default) (default)) + (else default))) + +(define +default-anim-duration+ 10) + +(define (animation-frames anim) (animation-ref anim #:frames 1)) +(define (animation-duration anim) (animation-ref anim #:duration +default-anim-duration+)) + +(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))) + (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? (animation-ref anim #:name) name)) + animations))) + (if (pair? 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 - `((#:anim-tick . ,tick) - (#:tile-id . ,(frame->tile-id frames frame))))))) - - (define (animate-entity entity animations) - (let* ((anim-name (entity-ref entity #:anim-name #f)) - (anim (and anim-name (animation-by-name animations anim-name)))) - (if anim - (advance-animation entity anim) - entity))) - - (define-pipeline (apply-animation animation) (scene entity dt) - guard: (entity-ref entity #:animations #f) - (let ((animations (entity-ref entity #:animations #f))) - (animate-entity entity animations))) - - ) ;; End of animation module + `((#:anim-tick . 0) + (#:anim-frame . ,new-frame-id) + (#:tile-id . ,(frame->tile-id frames new-frame-id)) + (#:duration . ,(frame->duration frames new-frame-id))))) + (entity-set-many entity + `((#:anim-tick . ,tick) + (#:tile-id . ,(frame->tile-id frames frame))))))) + +(define (animate-entity entity animations) + (let* ((anim-name (entity-ref entity #:anim-name #f)) + (anim (and anim-name (animation-by-name animations anim-name)))) + (if anim + (advance-animation entity anim) + entity))) + +(define-pipeline (apply-animation animation) (scene entity dt) + guard: (entity-ref entity #:animations #f) + (let ((animations (entity-ref entity #:animations #f))) + (animate-entity entity animations))) + +) ;; End of animation module |