diff --git a/Makefile b/Makefile index 5e8daf1..22fc356 100644 --- a/Makefile +++ b/Makefile @@ -7,6 +7,7 @@ modules = \ modules/dom/media.scm \ modules/dom/window.scm \ modules/game/actors.scm \ + modules/game/effects.scm \ modules/game/level.scm \ modules/game/tileset.scm \ modules/goblins/abstract-types.scm \ diff --git a/game.js b/game.js index 603753c..356789c 100644 --- a/game.js +++ b/game.js @@ -67,7 +67,8 @@ window.addEventListener("load", async () => { fillRect: (ctx, x, y, w, h) => ctx.fillRect(x, y, w, h), 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), - 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), setImageSmoothingEnabled: (ctx, enabled) => ctx.imageSmoothingEnabled = (enabled == 1) }, diff --git a/game.scm b/game.scm index 7493fab..4bf4af7 100644 --- a/game.scm +++ b/game.scm @@ -27,11 +27,13 @@ (dom window) (game actors) (game audio) + (game effects) (game level) (game levels level-1) (game levels level-2) (game levels level-3) (game levels level-4) + (game scripts) (game tileset) (goblins core) (hoot bytevectors) @@ -172,7 +174,11 @@ (if (< idx (vector-length levels)) (begin (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)))) ;; Auto-save/load to local storage. @@ -232,8 +238,11 @@ (set! *gems* (cons *level-idx* *gems*))) (('emit x y) (play-sound-effect audio:emit)) - ((or ('gate-open x y) ('gate-close x y)) + (('gate-open x y) (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)) (play-sound-effect audio:floor-switch)) (('electric-switch-on x y) @@ -252,13 +261,24 @@ (define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz (define (update) - ;; TODO: what kind of work do we need to do each frame? + (scheduler-tick! (current-scheduler)) (timeout update-callback dt)) (define update-callback (procedure->external update)) ;; 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* - (let ((cache (make-eq-hashtable))) ; assuming fixnums only + (let ((cache (make-eq-hashtable))) ; assuming fixnums only (lambda (x) (or (hashtable-ref cache x) (let ((str (number->string x))) @@ -362,6 +382,9 @@ (set-text-align! context "center") (fill-text context "OUCH... x_x" (/ game-width 2.0) (/ game-height 2.0))))) +(define (draw-interstitial) + (draw-level)) + (define (draw-win) (set-fill-color! context "#000000") (set-text-align! context "left") @@ -370,10 +393,12 @@ (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) - (set-scale! context *canvas-scale* *canvas-scale*) + (scale! context *canvas-scale* *canvas-scale*) + (draw-current-effect 'pre) (match *state* - ('play (draw-level)) + ((or 'play 'interstitial) (draw-level)) ('win (draw-win))) + (draw-current-effect 'post) (request-animation-frame draw-callback)) (define draw-callback (procedure->external draw)) diff --git a/modules/dom/canvas.scm b/modules/dom/canvas.scm index 7bb03fc..1ed2774 100644 --- a/modules/dom/canvas.scm +++ b/modules/dom/canvas.scm @@ -31,7 +31,8 @@ fill-rect fill-text draw-image - set-scale! + scale! + translate! set-transform! set-image-smoothing-enabled!)) @@ -65,8 +66,11 @@ (define-foreign draw-image "canvas" "drawImage" (ref extern) (ref extern) f64 f64 f64 f64 f64 f64 f64 f64 -> none) -(define-foreign set-scale! - "canvas" "setScale" +(define-foreign scale! + "canvas" "scale" + (ref extern) f64 f64 -> none) +(define-foreign translate! + "canvas" "translate" (ref extern) f64 f64 -> none) (define-foreign set-transform! "canvas" "setTransform" diff --git a/modules/game/effects.scm b/modules/game/effects.scm new file mode 100644 index 0000000..29df590 --- /dev/null +++ b/modules/game/effects.scm @@ -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 + (%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 + (($ 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)) diff --git a/modules/game/scripts.scm b/modules/game/scripts.scm new file mode 100644 index 0000000..107c04b --- /dev/null +++ b/modules/game/scripts.scm @@ -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 + (%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 + (($ 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 + (($ 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 + (($ 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