Add script scheduler and pre/post visual effects system.
This commit is contained in:
parent
67c25d93cb
commit
98ae464ab9
6 changed files with 260 additions and 10 deletions
1
Makefile
1
Makefile
|
@ -7,6 +7,7 @@ modules = \
|
||||||
modules/dom/media.scm \
|
modules/dom/media.scm \
|
||||||
modules/dom/window.scm \
|
modules/dom/window.scm \
|
||||||
modules/game/actors.scm \
|
modules/game/actors.scm \
|
||||||
|
modules/game/effects.scm \
|
||||||
modules/game/level.scm \
|
modules/game/level.scm \
|
||||||
modules/game/tileset.scm \
|
modules/game/tileset.scm \
|
||||||
modules/goblins/abstract-types.scm \
|
modules/goblins/abstract-types.scm \
|
||||||
|
|
3
game.js
3
game.js
|
@ -67,7 +67,8 @@ window.addEventListener("load", async () => {
|
||||||
fillRect: (ctx, x, y, w, h) => ctx.fillRect(x, y, w, h),
|
fillRect: (ctx, x, y, w, h) => ctx.fillRect(x, y, w, h),
|
||||||
fillText: (ctx, text, x, y) => ctx.fillText(text, x, y),
|
fillText: (ctx, text, x, y) => ctx.fillText(text, x, y),
|
||||||
drawImage: (ctx, image, sx, sy, sw, sh, dx, dy, dw, dh) => ctx.drawImage(image, sx, sy, sw, sh, dx, dy, dw, dh),
|
drawImage: (ctx, image, sx, sy, sw, sh, dx, dy, dw, dh) => ctx.drawImage(image, sx, sy, sw, sh, dx, dy, dw, dh),
|
||||||
setScale: (ctx, sx, sy) => ctx.scale(sx, sy),
|
scale: (ctx, sx, sy) => ctx.scale(sx, sy),
|
||||||
|
translate: (ctx, x, y) => ctx.translate(x, y),
|
||||||
setTransform: (ctx, a, b, c, d, e, f) => ctx.setTransform(a, b, c, d, e, f),
|
setTransform: (ctx, a, b, c, d, e, f) => ctx.setTransform(a, b, c, d, e, f),
|
||||||
setImageSmoothingEnabled: (ctx, enabled) => ctx.imageSmoothingEnabled = (enabled == 1)
|
setImageSmoothingEnabled: (ctx, enabled) => ctx.imageSmoothingEnabled = (enabled == 1)
|
||||||
},
|
},
|
||||||
|
|
35
game.scm
35
game.scm
|
@ -27,11 +27,13 @@
|
||||||
(dom window)
|
(dom window)
|
||||||
(game actors)
|
(game actors)
|
||||||
(game audio)
|
(game audio)
|
||||||
|
(game effects)
|
||||||
(game level)
|
(game level)
|
||||||
(game levels level-1)
|
(game levels level-1)
|
||||||
(game levels level-2)
|
(game levels level-2)
|
||||||
(game levels level-3)
|
(game levels level-3)
|
||||||
(game levels level-4)
|
(game levels level-4)
|
||||||
|
(game scripts)
|
||||||
(game tileset)
|
(game tileset)
|
||||||
(goblins core)
|
(goblins core)
|
||||||
(hoot bytevectors)
|
(hoot bytevectors)
|
||||||
|
@ -172,7 +174,11 @@
|
||||||
(if (< idx (vector-length levels))
|
(if (< idx (vector-length levels))
|
||||||
(begin
|
(begin
|
||||||
(save-game!)
|
(save-game!)
|
||||||
(load-level! idx))
|
(run-script
|
||||||
|
(lambda ()
|
||||||
|
(show-effect! (make-fade-out+in-effect 1.0))
|
||||||
|
(wait 30) ; ~half the effect time
|
||||||
|
(load-level! idx))))
|
||||||
(set! *state* 'win))))
|
(set! *state* 'win))))
|
||||||
|
|
||||||
;; Auto-save/load to local storage.
|
;; Auto-save/load to local storage.
|
||||||
|
@ -232,8 +238,11 @@
|
||||||
(set! *gems* (cons *level-idx* *gems*)))
|
(set! *gems* (cons *level-idx* *gems*)))
|
||||||
(('emit x y)
|
(('emit x y)
|
||||||
(play-sound-effect audio:emit))
|
(play-sound-effect audio:emit))
|
||||||
((or ('gate-open x y) ('gate-close x y))
|
(('gate-open x y)
|
||||||
(play-sound-effect audio:gate))
|
(play-sound-effect audio:gate))
|
||||||
|
(('gate-close x y)
|
||||||
|
(play-sound-effect audio:gate)
|
||||||
|
(show-effect! (make-screen-shake-effect 0.05)))
|
||||||
((or ('floor-switch-on x y) ('floor-switch-off x y))
|
((or ('floor-switch-on x y) ('floor-switch-off x y))
|
||||||
(play-sound-effect audio:floor-switch))
|
(play-sound-effect audio:floor-switch))
|
||||||
(('electric-switch-on x y)
|
(('electric-switch-on x y)
|
||||||
|
@ -252,11 +261,22 @@
|
||||||
|
|
||||||
(define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz
|
(define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz
|
||||||
(define (update)
|
(define (update)
|
||||||
;; TODO: what kind of work do we need to do each frame?
|
(scheduler-tick! (current-scheduler))
|
||||||
(timeout update-callback dt))
|
(timeout update-callback dt))
|
||||||
(define update-callback (procedure->external update))
|
(define update-callback (procedure->external update))
|
||||||
|
|
||||||
;; Render loop
|
;; Render loop
|
||||||
|
(define *current-effect* #f)
|
||||||
|
(define (show-effect! effect)
|
||||||
|
(set! *current-effect* effect)
|
||||||
|
(effect-start! effect))
|
||||||
|
(define (draw-current-effect type)
|
||||||
|
(when (and *current-effect*
|
||||||
|
(eq? type (effect-type *current-effect*)))
|
||||||
|
(draw-effect context *current-effect*)
|
||||||
|
(unless (effect-started? *current-effect*)
|
||||||
|
(set! *current-effect* #f))))
|
||||||
|
|
||||||
(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)
|
||||||
|
@ -362,6 +382,9 @@
|
||||||
(set-text-align! context "center")
|
(set-text-align! context "center")
|
||||||
(fill-text context "OUCH... x_x" (/ game-width 2.0) (/ game-height 2.0)))))
|
(fill-text context "OUCH... x_x" (/ game-width 2.0) (/ game-height 2.0)))))
|
||||||
|
|
||||||
|
(define (draw-interstitial)
|
||||||
|
(draw-level))
|
||||||
|
|
||||||
(define (draw-win)
|
(define (draw-win)
|
||||||
(set-fill-color! context "#000000")
|
(set-fill-color! context "#000000")
|
||||||
(set-text-align! context "left")
|
(set-text-align! context "left")
|
||||||
|
@ -370,10 +393,12 @@
|
||||||
(define (draw prev-time)
|
(define (draw prev-time)
|
||||||
(clear-rect context 0.0 0.0 *canvas-width* *canvas-height*)
|
(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)
|
(set-transform! context 1.0 0.0 0.0 1.0 0.0 0.0)
|
||||||
(set-scale! context *canvas-scale* *canvas-scale*)
|
(scale! context *canvas-scale* *canvas-scale*)
|
||||||
|
(draw-current-effect 'pre)
|
||||||
(match *state*
|
(match *state*
|
||||||
('play (draw-level))
|
((or 'play 'interstitial) (draw-level))
|
||||||
('win (draw-win)))
|
('win (draw-win)))
|
||||||
|
(draw-current-effect 'post)
|
||||||
(request-animation-frame draw-callback))
|
(request-animation-frame draw-callback))
|
||||||
(define draw-callback (procedure->external draw))
|
(define draw-callback (procedure->external draw))
|
||||||
|
|
||||||
|
|
|
@ -31,7 +31,8 @@
|
||||||
fill-rect
|
fill-rect
|
||||||
fill-text
|
fill-text
|
||||||
draw-image
|
draw-image
|
||||||
set-scale!
|
scale!
|
||||||
|
translate!
|
||||||
set-transform!
|
set-transform!
|
||||||
set-image-smoothing-enabled!))
|
set-image-smoothing-enabled!))
|
||||||
|
|
||||||
|
@ -65,8 +66,11 @@
|
||||||
(define-foreign draw-image
|
(define-foreign draw-image
|
||||||
"canvas" "drawImage"
|
"canvas" "drawImage"
|
||||||
(ref extern) (ref extern) f64 f64 f64 f64 f64 f64 f64 f64 -> none)
|
(ref extern) (ref extern) f64 f64 f64 f64 f64 f64 f64 f64 -> none)
|
||||||
(define-foreign set-scale!
|
(define-foreign scale!
|
||||||
"canvas" "setScale"
|
"canvas" "scale"
|
||||||
|
(ref extern) f64 f64 -> none)
|
||||||
|
(define-foreign translate!
|
||||||
|
"canvas" "translate"
|
||||||
(ref extern) f64 f64 -> none)
|
(ref extern) f64 f64 -> none)
|
||||||
(define-foreign set-transform!
|
(define-foreign set-transform!
|
||||||
"canvas" "setTransform"
|
"canvas" "setTransform"
|
||||||
|
|
76
modules/game/effects.scm
Normal file
76
modules/game/effects.scm
Normal file
|
@ -0,0 +1,76 @@
|
||||||
|
(define-module (game effects)
|
||||||
|
#:use-module (dom canvas)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (math)
|
||||||
|
#:use-module (srfi srfi-9)
|
||||||
|
#:use-module (scheme time)
|
||||||
|
#:export (ease:smoothstep
|
||||||
|
ease:linear
|
||||||
|
|
||||||
|
make-effect
|
||||||
|
effect?
|
||||||
|
effect-started?
|
||||||
|
effect-type
|
||||||
|
effect-duration
|
||||||
|
effect-start!
|
||||||
|
draw-effect
|
||||||
|
|
||||||
|
make-fade-out+in-effect
|
||||||
|
make-screen-shake-effect))
|
||||||
|
|
||||||
|
(define (ease:smoothstep t)
|
||||||
|
(* t t (- 3 (* 2 t))))
|
||||||
|
|
||||||
|
(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?
|
||||||
|
(type effect-type)
|
||||||
|
(draw effect-draw)
|
||||||
|
(ease effect-ease)
|
||||||
|
(duration effect-duration)
|
||||||
|
(start effect-start set-effect-start!))
|
||||||
|
|
||||||
|
(define* (make-effect type duration draw #:optional (ease ease:smoothstep))
|
||||||
|
(%make-effect type draw ease duration #f))
|
||||||
|
|
||||||
|
(define (effect-started? effect)
|
||||||
|
(number? (effect-start effect)))
|
||||||
|
|
||||||
|
(define (effect-start! effect)
|
||||||
|
(set-effect-start! effect (current-time*)))
|
||||||
|
|
||||||
|
(define (draw-effect context effect)
|
||||||
|
(match effect
|
||||||
|
(($ <effect> type draw ease duration start)
|
||||||
|
(when (number? start)
|
||||||
|
(let ((dt (- (current-time*) start)))
|
||||||
|
(if (>= dt duration)
|
||||||
|
(set-effect-start! effect #f)
|
||||||
|
(let ((t (ease (/ dt duration))))
|
||||||
|
(draw context t))))))))
|
||||||
|
|
||||||
|
;; Duplicated from game.scm but gotta go fast!!
|
||||||
|
(define game-width 320.0)
|
||||||
|
(define game-height 240.0)
|
||||||
|
|
||||||
|
(define (make-fade-out+in-effect duration)
|
||||||
|
(define (draw context t)
|
||||||
|
(if (< t 0.5)
|
||||||
|
(set-global-alpha! context (pk 'alpha-out (* t 2.0)))
|
||||||
|
(set-global-alpha! context (pk 'alpha-in (- 1.0 (* (- t 0.5) 2.0)))))
|
||||||
|
(set-fill-color! context "#000000")
|
||||||
|
(fill-rect context 0.0 0.0 game-width game-height)
|
||||||
|
(set-global-alpha! context 1.0))
|
||||||
|
(make-effect 'post duration draw))
|
||||||
|
|
||||||
|
(define (make-screen-shake-effect duration)
|
||||||
|
(define (draw context t)
|
||||||
|
(let ((x (round (random)))
|
||||||
|
(y (round (random))))
|
||||||
|
(translate! context x y)))
|
||||||
|
(make-effect 'pre duration draw))
|
143
modules/game/scripts.scm
Normal file
143
modules/game/scripts.scm
Normal file
|
@ -0,0 +1,143 @@
|
||||||
|
(define-module (game scripts)
|
||||||
|
#:export (make-scheduler
|
||||||
|
current-scheduler
|
||||||
|
scheduler-tick!
|
||||||
|
scheduler-reset!
|
||||||
|
|
||||||
|
script?
|
||||||
|
run-script
|
||||||
|
script-cancel!
|
||||||
|
wait
|
||||||
|
forever
|
||||||
|
tween)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (srfi srfi-9))
|
||||||
|
|
||||||
|
(define-record-type <scheduler>
|
||||||
|
(%make-scheduler ticks num-tasks max-tasks tasks)
|
||||||
|
scheduler?
|
||||||
|
(ticks scheduler-ticks set-scheduler-ticks!)
|
||||||
|
(num-tasks scheduler-num-tasks set-scheduler-num-tasks!)
|
||||||
|
(max-tasks scheduler-max-tasks)
|
||||||
|
(tasks scheduler-tasks))
|
||||||
|
|
||||||
|
(define (make-scheduler max-tasks)
|
||||||
|
(%make-scheduler 0 0 max-tasks (make-vector max-tasks)))
|
||||||
|
|
||||||
|
(define (scheduler-add! scheduler thunk delay)
|
||||||
|
(match scheduler
|
||||||
|
(($ <scheduler> ticks num-tasks max-tasks tasks)
|
||||||
|
(unless (= num-tasks max-tasks)
|
||||||
|
(vector-set! tasks num-tasks (cons (+ ticks delay) thunk))
|
||||||
|
(set-scheduler-num-tasks! scheduler (+ num-tasks 1))))))
|
||||||
|
|
||||||
|
(define (scheduler-tick! scheduler)
|
||||||
|
(define (run-thunks thunks)
|
||||||
|
(for-each (lambda (thunk) (thunk)) thunks))
|
||||||
|
(run-thunks
|
||||||
|
(match scheduler
|
||||||
|
(($ <scheduler> ticks num-tasks max-tasks tasks)
|
||||||
|
(let ((t (+ ticks 1)))
|
||||||
|
(let loop ((i 0) (k num-tasks) (to-run '()))
|
||||||
|
(if (< i k)
|
||||||
|
(match (vector-ref tasks i)
|
||||||
|
((t* . thunk)
|
||||||
|
(if (<= t* t)
|
||||||
|
(let ((k* (- k 1)))
|
||||||
|
(vector-set! tasks i (vector-ref tasks k*))
|
||||||
|
(vector-set! tasks k* #f)
|
||||||
|
(loop i k* (cons thunk to-run)))
|
||||||
|
(loop (+ i 1) k to-run))))
|
||||||
|
(begin
|
||||||
|
(set-scheduler-ticks! scheduler t)
|
||||||
|
(set-scheduler-num-tasks! scheduler k)
|
||||||
|
to-run))))))))
|
||||||
|
|
||||||
|
(define (scheduler-reset! scheduler)
|
||||||
|
(match scheduler
|
||||||
|
(($ <scheduler> ticks num-tasks max-tasks tasks)
|
||||||
|
(set-scheduler-ticks! scheduler 0)
|
||||||
|
(set-scheduler-num-tasks! scheduler 0)
|
||||||
|
(do ((i 0 (+ i 1)))
|
||||||
|
((= i num-tasks))
|
||||||
|
(vector-set! tasks i #f)))))
|
||||||
|
|
||||||
|
(define *scheduler* (make-scheduler 100))
|
||||||
|
(define current-scheduler (make-parameter *scheduler*))
|
||||||
|
(define current-script (make-parameter #f))
|
||||||
|
|
||||||
|
(define %script-tag (make-prompt-tag "script"))
|
||||||
|
|
||||||
|
(define-record-type <script>
|
||||||
|
(%make-script scheduler state cont children)
|
||||||
|
script?
|
||||||
|
(scheduler script-scheduler set-script-scheduler!)
|
||||||
|
(state script-state set-script-state!)
|
||||||
|
(cont script-cont set-script-cont!)
|
||||||
|
(children script-children set-script-children!))
|
||||||
|
|
||||||
|
(define (make-script thunk)
|
||||||
|
(%make-script (current-scheduler) 'pending thunk '()))
|
||||||
|
|
||||||
|
(define (script-pending? script)
|
||||||
|
(eq? (script-state script) 'pending))
|
||||||
|
|
||||||
|
(define (script-running? script)
|
||||||
|
(eq? (script-state script) 'running))
|
||||||
|
|
||||||
|
(define (script-cancelled? script)
|
||||||
|
(eq? (script-state script) 'cancelled))
|
||||||
|
|
||||||
|
(define (script-cancel! script)
|
||||||
|
(set-script-state! script 'cancelled)
|
||||||
|
(for-each script-cancel! (script-children script)))
|
||||||
|
|
||||||
|
(define (script-run! script)
|
||||||
|
(define scheduler (script-scheduler script))
|
||||||
|
(define (run thunk)
|
||||||
|
(unless (script-cancelled? script)
|
||||||
|
(call-with-prompt %script-tag
|
||||||
|
(lambda ()
|
||||||
|
(parameterize ((current-script script)
|
||||||
|
(current-scheduler scheduler))
|
||||||
|
(thunk)))
|
||||||
|
handler)))
|
||||||
|
(define (handler k delay)
|
||||||
|
(when delay
|
||||||
|
(scheduler-add! scheduler (lambda () (run k)) delay)))
|
||||||
|
(when (script-pending? script)
|
||||||
|
(let ((parent (current-script)))
|
||||||
|
(when parent
|
||||||
|
(set-script-children! parent (cons script (script-children parent)))))
|
||||||
|
(run
|
||||||
|
(lambda ()
|
||||||
|
(set-script-state! script 'running)
|
||||||
|
((script-cont script))
|
||||||
|
;; Nasty hack: For some reason, falling through the prompt
|
||||||
|
;; thunk messes up the Scheme stack, resulting in an invalid
|
||||||
|
;; ref.cast somewhere. So, we *never* fall through. Instead,
|
||||||
|
;; we create a continuation that gets thrown away.
|
||||||
|
(abort-to-prompt %script-tag #f)))))
|
||||||
|
|
||||||
|
(define (run-script thunk)
|
||||||
|
(let ((script (make-script thunk)))
|
||||||
|
(script-run! script)
|
||||||
|
script))
|
||||||
|
|
||||||
|
(define (wait delay)
|
||||||
|
(abort-to-prompt %script-tag delay))
|
||||||
|
|
||||||
|
(define-syntax-rule (forever body ...)
|
||||||
|
(let loop ()
|
||||||
|
body ...
|
||||||
|
(loop)))
|
||||||
|
|
||||||
|
(define* (tween proc duration start end ease interpolate)
|
||||||
|
(let ((d (exact->inexact duration)))
|
||||||
|
(let loop ((t 0))
|
||||||
|
(if (= t duration)
|
||||||
|
(proc end)
|
||||||
|
(let ((alpha (ease (/ t d))))
|
||||||
|
(proc (interpolate start end alpha))
|
||||||
|
(wait 1)
|
||||||
|
(loop (+ t 1)))))))
|
Loading…
Add table
Reference in a new issue