Add animations.

Makefile

@@ -10,6 +10,8 @@ modules = \
   modules/game/effects.scm \
   modules/game/level.scm \
   modules/game/tileset.scm \
+  modules/game/time.scm \
+  modules/game/animation.scm \
   modules/goblins/abstract-types.scm \
   modules/goblins/core.scm \
   modules/goblins/core-types.scm \

game.scm

@@ -26,6 +26,7 @@
              (dom media)
              (dom window)
              (game actors)
+             (game animation)
              (game audio)
              (game effects)
              (game level)
@@ -47,6 +48,7 @@
              (game levels credits)
              (game scripts)
              (game tileset)
+             (game time)
              (goblins core)
              (hoot bytevectors)
              (hoot ffi)
@@ -69,7 +71,7 @@
 ;; Assets
 (define tileset
   (make-tileset (make-image "assets/images/cirkoban.png")
-                320 240
+                320 (* 240 4)
                 (inexact->exact tile-width)
                 (inexact->exact tile-height)))
 (define* (load-sound-effect name #:key (volume 0.25))
@@ -114,8 +116,9 @@
    load-rat-3
    ;; load-level-1
    ;; load-level-2
-   load-level-3
+   ;; load-level-3
-   load-level-4))
+   ;; load-level-4
+   ))
 (define *level-idx* #f)
 (define *gems* #f)
 (define *level* #f)
@@ -334,6 +337,35 @@
     (unless (effect-started? *current-effect*)
       (set! *current-effect* #f))))
 
+(define-syntax-rule (define-animation name (tile duration) ...)
+  (define name
+    (make-animation tileset (vector (make-frame tile duration) ...))))
+(define-animation anim:player
+  (0   2.25)
+  (300 2.25)
+  (600 2.25)
+  (900 0.15))
+(define-animation anim:electron-head
+  (4   .25)
+  (304 .25)
+  (604 .25)
+  (904 .25))
+(define-animation anim:electron-tail
+  (5   .25)
+  (305 .25)
+  (605 .25)
+  (905 .25))
+(define-animation anim:gem
+  (28  .25)
+  (328 .25)
+  (628 .25)
+  (928 .25))
+(define-animation anim:ghost-gem
+  (49  .25)
+  (349 .25)
+  (649 .25)
+  (949 .25))
+
 (define number->string*
   (let ((cache (make-eq-hashtable)))    ; assuming fixnums only
     (lambda (x)
@@ -352,7 +384,9 @@
     (restore! context)))
 
 (define (draw-player pos alive?)
-  (draw-tile context tileset (if alive? 0 20) (vec2-x pos) (vec2-y pos)))
+  (if alive?
+      (draw-animation context anim:player (vec2-x pos) (vec2-y pos))
+      (draw-tile context tileset 20 (vec2-x pos) (vec2-y pos))))
 
 (define (draw-exit pos)
   (draw-tile context tileset 27 (vec2-x pos) (vec2-y pos)))
@@ -362,9 +396,9 @@
         (y (vec2-y pos)))
     (match state
       ('electron-head
-       (draw-tile context tileset 4 x y))
+       (draw-animation context anim:electron-head x y))
       ('electron-tail
-       (draw-tile context tileset 5 x y))
+       (draw-animation context anim:electron-tail x y))
       (_ #f))))
 
 (define (draw-wall pos type)
@@ -400,11 +434,11 @@
   (draw-tile context tileset (+ 51 countdown) (vec2-x pos) (vec2-y pos)))
 
 (define (draw-gem pos)
-  (draw-tile context tileset 28 (vec2-x pos) (vec2-y pos)))
+  (draw-animation context anim:gem (vec2-x pos) (vec2-y pos)))
 
 (define (draw-ghost-gem pos)
   (set-global-alpha! context 0.5)
-  (draw-tile context tileset 49 (vec2-x pos) (vec2-y pos))
+  (draw-animation context anim:ghost-gem (vec2-x pos) (vec2-y pos))
   (set-global-alpha! context 1.0))
 
 (define (draw-gate pos open?)
@@ -529,16 +563,27 @@
           (str (fill-text context str x y)))
         (lp (1+ i) (+ y credits-line-spacing))))))
 
-(define (draw prev-time)
+(define *frame-time* (current-time*))
-  (clear-rect context 0.0 0.0 *canvas-width* *canvas-height*)
+(define (draw time)
-  (set-transform! context 1.0 0.0 0.0 1.0 0.0 0.0)
+  (unless (and (real? time) (inexact? time))
-  (scale! context *canvas-scale* *canvas-scale*)
+    (error "expected flonum" time))
-  (draw-current-effect 'pre)
+  (let* ((time (/ time 1000.0))
-  (match *state*
+         (dt (- time *frame-time*)))
-    ((or 'play 'interstitial) (draw-level))
+    (set! *frame-time* time)
-    ('win (draw-win)))
+    (update-animation anim:player dt)
-  (draw-current-effect 'post)
+    (update-animation anim:electron-head dt)
-  (request-animation-frame draw-callback))
+    (update-animation anim:electron-tail dt)
+    (update-animation anim:gem dt)
+    (update-animation anim:ghost-gem dt)
+    (clear-rect context 0.0 0.0 *canvas-width* *canvas-height*)
+    (set-transform! context 1.0 0.0 0.0 1.0 0.0 0.0)
+    (scale! context *canvas-scale* *canvas-scale*)
+    (draw-current-effect 'pre)
+    (match *state*
+      ((or 'play 'interstitial) (draw-level))
+      ('win (draw-win)))
+    (draw-current-effect 'post)
+    (request-animation-frame draw-callback)))
 (define draw-callback (procedure->external draw))
 
 ;; Input

modules/game/animation.scm

@@ -0,0 +1,56 @@
+(define-module (game animation)
+  #:use-module (game tileset)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:export (make-frame
+            frame?
+            frame-tile
+            frame-duration
+
+            make-animation
+            animation?
+            animation-tileset
+            animation-time
+            animation-frames
+            update-animation
+            draw-animation))
+
+(define-record-type <frame>
+  (make-frame tile duration)
+  frame?
+  (tile frame-tile)
+  (duration frame-duration))
+
+(define-record-type <animation>
+  (%make-animation tileset frames time frame-idx)
+  animation?
+  (tileset animation-tileset)
+  (frames animation-frames)
+  (time animation-time set-animation-time!)
+  (frame-idx animation-frame-idx set-animation-frame-idx!))
+
+(define (make-animation tileset frames)
+  (%make-animation tileset frames 0.0 0))
+
+(define (flonum? x)
+  (and (real? x) (inexact? x)))
+
+(define (update-animation anim dt)
+  (unless (flonum? dt)
+    (error "not a flonum" dt))
+  (match anim
+    (($ <animation> tileset frames (? flonum? time) idx)
+     (let ((time* (+ time dt)))
+       (match (vector-ref frames idx)
+         (($ <frame> tile duration)
+          (cond
+           ((>= time* duration)
+            (set-animation-frame-idx! anim (modulo (1+ idx) (vector-length frames)))
+            (set-animation-time! anim (- time* duration)))
+           (else
+            (set-animation-time! anim time*)))))))))
+
+(define (draw-animation context anim x y)
+  (match anim
+    (($ <animation> tileset frames time idx)
+     (draw-tile context tileset (frame-tile (vector-ref frames idx)) x y))))

modules/game/effects.scm

@@ -1,5 +1,6 @@
 (define-module (game effects)
   #:use-module (dom canvas)
+  #:use-module (game time)
   #:use-module (ice-9 match)
   #:use-module (math)
   #:use-module (srfi srfi-9)
@@ -24,9 +25,6 @@
 
 (define (ease:linear t) t)
 
-(define (current-time*)
-  (/ (exact->inexact (current-jiffy)) (jiffies-per-second)))
-
 (define-record-type <effect>
   (%make-effect type draw ease duration start)
   effect?

modules/game/time.scm

@@ -0,0 +1,6 @@
+(define-module (game time)
+  #:use-module (scheme time)
+  #:export (current-time*))
+
+(define (current-time*)
+  (/ (exact->inexact (current-jiffy)) (jiffies-per-second)))