Add animations.

This commit is contained in:
David Thompson 2024-05-25 06:52:59 -04:00
parent 6896b49848
commit faf4fa7124
5 changed files with 128 additions and 21 deletions

View file

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

View file

@ -26,6 +26,7 @@
(dom media) (dom media)
(dom window) (dom window)
(game actors) (game actors)
(game animation)
(game audio) (game audio)
(game effects) (game effects)
(game level) (game level)
@ -47,6 +48,7 @@
(game levels credits) (game levels credits)
(game scripts) (game scripts)
(game tileset) (game tileset)
(game time)
(goblins core) (goblins core)
(hoot bytevectors) (hoot bytevectors)
(hoot ffi) (hoot ffi)
@ -69,7 +71,7 @@
;; Assets ;; Assets
(define tileset (define tileset
(make-tileset (make-image "assets/images/cirkoban.png") (make-tileset (make-image "assets/images/cirkoban.png")
320 240 320 (* 240 4)
(inexact->exact tile-width) (inexact->exact tile-width)
(inexact->exact tile-height))) (inexact->exact tile-height)))
(define* (load-sound-effect name #:key (volume 0.25)) (define* (load-sound-effect name #:key (volume 0.25))
@ -114,8 +116,9 @@
load-rat-3 load-rat-3
;; load-level-1 ;; load-level-1
;; load-level-2 ;; load-level-2
load-level-3 ;; load-level-3
load-level-4)) ;; load-level-4
))
(define *level-idx* #f) (define *level-idx* #f)
(define *gems* #f) (define *gems* #f)
(define *level* #f) (define *level* #f)
@ -334,6 +337,35 @@
(unless (effect-started? *current-effect*) (unless (effect-started? *current-effect*)
(set! *current-effect* #f)))) (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* (define number->string*
(let ((cache (make-eq-hashtable))) ; assuming fixnums only (let ((cache (make-eq-hashtable))) ; assuming fixnums only
(lambda (x) (lambda (x)
@ -352,7 +384,9 @@
(restore! context))) (restore! context)))
(define (draw-player pos alive?) (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) (define (draw-exit pos)
(draw-tile context tileset 27 (vec2-x pos) (vec2-y pos))) (draw-tile context tileset 27 (vec2-x pos) (vec2-y pos)))
@ -362,9 +396,9 @@
(y (vec2-y pos))) (y (vec2-y pos)))
(match state (match state
('electron-head ('electron-head
(draw-tile context tileset 4 x y)) (draw-animation context anim:electron-head x y))
('electron-tail ('electron-tail
(draw-tile context tileset 5 x y)) (draw-animation context anim:electron-tail x y))
(_ #f)))) (_ #f))))
(define (draw-wall pos type) (define (draw-wall pos type)
@ -400,11 +434,11 @@
(draw-tile context tileset (+ 51 countdown) (vec2-x pos) (vec2-y pos))) (draw-tile context tileset (+ 51 countdown) (vec2-x pos) (vec2-y pos)))
(define (draw-gem 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) (define (draw-ghost-gem pos)
(set-global-alpha! context 0.5) (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)) (set-global-alpha! context 1.0))
(define (draw-gate pos open?) (define (draw-gate pos open?)
@ -529,16 +563,27 @@
(str (fill-text context str x y))) (str (fill-text context str x y)))
(lp (1+ i) (+ y credits-line-spacing)))))) (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)) (define draw-callback (procedure->external draw))
;; Input ;; Input

View file

@ -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))))

View file

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

6
modules/game/time.scm Normal file
View file

@ -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)))