From eeb95785c7ba49ca16abc39437dc6b66f0fc478f Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 26 May 2024 12:35:46 -0400 Subject: [PATCH] Fix desync between fade out/in and level loading when game is lagging. --- Makefile | 1 + game.scm | 15 +++++++++------ modules/game/effects.scm | 15 +++++++++++++-- modules/game/scripts.scm | 20 ++++++++++---------- 4 files changed, 33 insertions(+), 18 deletions(-) diff --git a/Makefile b/Makefile index 9d5e55d..91b4ce3 100644 --- a/Makefile +++ b/Makefile @@ -9,6 +9,7 @@ modules = \ modules/game/actors.scm \ modules/game/effects.scm \ modules/game/level.scm \ + modules/game/scripts.scm \ modules/game/tileset.scm \ modules/game/time.scm \ modules/game/animation.scm \ diff --git a/game.scm b/game.scm index be7ce71..af880de 100644 --- a/game.scm +++ b/game.scm @@ -231,8 +231,9 @@ (run-script (lambda () (set! *state* 'interstitial) - (show-effect! (make-fade-out+in-effect 1.0)) - (wait 30) ; ~half the effect time + (yield + (lambda (k) + (show-effect! (make-fade-out+in-effect 1.0 k)))) (load-level! idx)))) (begin (run-script @@ -240,8 +241,9 @@ (set! *level-idx* 0) (save-game!) (set! *state* 'interstitial) - (show-effect! (make-fade-out+in-effect 2.0)) - (wait 60) + (yield + (lambda (k) + (show-effect! (make-fade-out+in-effect 2.0 k)))) (load-credits!))))))) ;; Auto-save/load to local storage. @@ -270,8 +272,9 @@ (set! *level-idx* 0) (save-game!) (set! *state* 'interstitial) - (show-effect! (make-fade-out+in-effect 2.0)) - (wait 60) + (yield + (lambda (k) + (show-effect! (make-fade-out+in-effect 2.0 k)))) (load-level! 0)))) ;; Update loop diff --git a/modules/game/effects.scm b/modules/game/effects.scm index bf93c4e..79aafe9 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 scripts) #:use-module (game time) #:use-module (ice-9 match) #:use-module (math) @@ -57,11 +58,21 @@ (define game-width 320.0) (define game-height 240.0) -(define (make-fade-out+in-effect duration) +;; on-transition is a last-minute hack to make it possible to sync the +;; loading of the next level with the moment when the screen is +;; completely black. +(define (make-fade-out+in-effect duration on-transition) + (define transitioned? #f) + (define (maybe-transition) + (unless transitioned? + (set! transitioned? #t) + (on-transition))) (define (draw context t) (if (< t 0.5) (set-global-alpha! context (* t 2.0)) - (set-global-alpha! context (- 1.0 (* (- t 0.5) 2.0)))) + (begin + (maybe-transition) + (set-global-alpha! context (- 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)) diff --git a/modules/game/scripts.scm b/modules/game/scripts.scm index 107c04b..1ad646e 100644 --- a/modules/game/scripts.scm +++ b/modules/game/scripts.scm @@ -7,6 +7,7 @@ script? run-script script-cancel! + yield wait forever tween) @@ -102,9 +103,8 @@ (current-scheduler scheduler)) (thunk))) handler))) - (define (handler k delay) - (when delay - (scheduler-add! scheduler (lambda () (run k)) delay))) + (define (handler k proc) + (proc (lambda () (run k)))) (when (script-pending? script) (let ((parent (current-script))) (when parent @@ -112,20 +112,20 @@ (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))))) + ((script-cont script)))))) (define (run-script thunk) (let ((script (make-script thunk))) (script-run! script) script)) +(define (yield proc) + (abort-to-prompt %script-tag proc)) + (define (wait delay) - (abort-to-prompt %script-tag delay)) + (yield + (lambda (thunk) + (scheduler-add! (current-scheduler) thunk delay)))) (define-syntax-rule (forever body ...) (let loop ()