aboutsummaryrefslogtreecommitdiff
path: root/animation.scm
blob: 100586863aa128660172cad01315bc7973d9e71f (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
(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)))))
          (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