diff --git a/Makefile b/Makefile
index 7b97626..f31dbf1 100644
--- a/Makefile
+++ b/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 \
diff --git a/game.scm b/game.scm
index 5587819..eb5f005 100644
--- a/game.scm
+++ b/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-4))
+ ;; load-level-3
+ ;; 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)
- (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 *frame-time* (current-time*))
+(define (draw time)
+ (unless (and (real? time) (inexact? time))
+ (error "expected flonum" time))
+ (let* ((time (/ time 1000.0))
+ (dt (- time *frame-time*)))
+ (set! *frame-time* time)
+ (update-animation anim:player dt)
+ (update-animation anim:electron-head dt)
+ (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
diff --git a/modules/game/animation.scm b/modules/game/animation.scm
new file mode 100644
index 0000000..72cedb9
--- /dev/null
+++ b/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
+ (make-frame tile duration)
+ frame?
+ (tile frame-tile)
+ (duration frame-duration))
+
+(define-record-type
+ (%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
+ (($ tileset frames (? flonum? time) idx)
+ (let ((time* (+ time dt)))
+ (match (vector-ref frames idx)
+ (($ 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
+ (($ tileset frames time idx)
+ (draw-tile context tileset (frame-tile (vector-ref frames idx)) x y))))
diff --git a/modules/game/effects.scm b/modules/game/effects.scm
index 62dca43..bf93c4e 100644
--- a/modules/game/effects.scm
+++ b/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
(%make-effect type draw ease duration start)
effect?
diff --git a/modules/game/time.scm b/modules/game/time.scm
new file mode 100644
index 0000000..7e27add
--- /dev/null
+++ b/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)))