blob: 2466cc80bc55267c24ed3cb145de04773cf5cbf9 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
(module (downstroke animation) *
(import scheme
(chicken base)
(chicken pretty-print)
(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+ 100) ; 100ms
(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 animation frame-idx)
(let ((frame-def (frame-by-idx (animation-frames animation) frame-idx)))
(if (list? frame-def)
(cadr frame-def)
(animation-ref animation #:duration +default-anim-duration+))))
;; ---- 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 dt)
(let ((tick (+ dt (entity-ref entity #:anim-tick 0)))
(duration (entity-ref entity #:duration +default-anim-duration+))
(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 anim new-frame-id)))))
(entity-set-many entity
`((#:anim-tick . ,tick)
(#:tile-id . ,(frame->tile-id frames frame)))))))
(define (animate-entity entity animations dt)
(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 dt)
entity)))
(define-pipeline (apply-animation animation) (scene entity dt)
guard: (entity-ref entity #:animations #f)
(let* ((animations (entity-ref entity #:animations #f))
(updated-entity (animate-entity entity animations dt)))
(when (eq? (entity-ref entity #:type) 'timed-frames)
(pp (list (entity-ref updated-entity #:tile-id) (entity-ref updated-entity #:duration) (entity-ref entity #:anim-tick))))
updated-entity))
) ;; End of animation module
|
