From 8842e0120769ba589bcc405e19567572e6b01095 Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Wed, 15 Jan 2025 09:15:57 -0500 Subject: [PATCH] Added update, on-enter, and on-leave hooks --- game.scm | 105 ++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 69 insertions(+), 36 deletions(-) diff --git a/game.scm b/game.scm index e57b27d..df2ef91 100644 --- a/game.scm +++ b/game.scm @@ -411,14 +411,20 @@ lh))) (define-record-type - (_make-credit lines draw) + (_make-credit lines draw update on-enter on-leave) credit? (lines credit-lines) - (draw credit-draw)) + (draw credit-draw) + (update credit-update) + (on-enter credit-on-enter) + (on-leave credit-on-leave)) (define* (make-credit #:key (lines 1) - (draw (lambda (y) #f))) - (_make-credit lines draw)) + (draw (lambda (y) #f)) + (update (lambda () #f)) + (on-enter (lambda () #f)) + (on-leave (lambda () #f))) + (_make-credit lines draw update on-enter on-leave)) (define* (make-credit-group #:rest credits) (make-credit @@ -430,7 +436,16 @@ (fold (lambda (c y) ((credit-draw c) y) (+ y (* (credit-lines c) (line-height)))) - top credits)))) + top credits)) + #:update + (lambda () + (map (lambda (c) ((credit-update c))) credits)) + #:on-enter + (lambda () + (map (lambda (c) ((credit-on-enter c))) credits)) + #:on-leave + (lambda () + (map (lambda (c) ((credit-on-leave c))) credits)))) (define (make-credit-text text) (make-credit @@ -448,6 +463,8 @@ (make-credit-text (make-string (string-length text) #\-)))) (define credits + +(define (make-credits) (vector (make-credit-group (make-credit-text "Phew, you made it!") (make-credit-text "Time to relax.")) @@ -481,24 +498,45 @@ (make-credit #:lines 4) (make-credit-text "Thank you for playing!"))) -(define-record-type - (make-credits-state top first-visible-index) +(define-record-type + (make-credits-state credits top first-visible-index next-visible-index) credits-state? + (credits credits-state-credits) (top credits-state-top set-credits-state-top!) (first-visible-index credits-state-first-visible-index - set-credits-state-first-visible-index!)) + set-credits-state-first-visible-index!) + (next-visible-index + credits-state-next-visible-index + set-credits-state-next-visible-index!)) -(define *credits* (make-credits-state credits-start 0)) +(define *credits* #f) +(define (credits) + (credits-state-credits *credits*)) (define (credits-top) (credits-state-top *credits*)) (define (credits-first-visible-index) (credits-state-first-visible-index *credits*)) +(define (credits-next-visible-index) + (credits-state-next-visible-index *credits*)) (define (set-credits-top! top) (set-credits-state-top! *credits* top)) (define (set-credits-first-visible-index! index) (set-credits-state-first-visible-index! *credits* index)) +(define (set-credits-next-visible-index! index) + (set-credits-state-next-visible-index! *credits* index)) +(define (credits-reset!) + (set! *credits* (make-credits-state (make-credits) credits-start 0 -1))) + +(define (load-credits!) + (credits-reset!) + (replace-game-state! 'credits) + (set! *actormap* (make-whactormap)) + (clear-snapshots!) + (with-goblins + (set! *level* (load-credits #f)) + (update-objects!))) (define (credit-height credit) (+ (* (credit-lines credit) (line-height)) @@ -508,36 +546,29 @@ (draw-level) (let lp ((i (credits-first-visible-index)) (y (credits-top))) - (when (and (< i (vector-length credits)) + (when (and (< i (vector-length (credits))) (<= y credits-start)) - (let* ((c (vector-ref credits i))) + (let* ((c (vector-ref (credits) i))) + (when (> i (credits-next-visible-index)) + ((credit-on-enter c)) + (set-credits-next-visible-index! i)) ((credit-draw c) y) (lp (1+ i) (+ y (credit-height c))))))) -(define (load-credits!) - (replace-game-state! 'credits) - (set! *actormap* (make-whactormap)) - (clear-snapshots!) - (with-goblins - (set! *level* (load-credits #f)) - (update-objects!)) - ;; Update function - (run-script - (lambda () - (set-credits-top! credits-start) - (set-credits-first-visible-index! 0) - (while (< (credits-first-visible-index) (vector-length credits)) - ;; Remove credits as they leave the screen and become invisible - (let ((bottom (+ (credits-top) - (credit-height (vector-ref - credits - (credits-first-visible-index)))))) - (when (< bottom credits-end) - (set-credits-top! bottom) - (set-credits-first-visible-index! (1+ (credits-first-visible-index))))) - ;; Advance credits - (set-credits-top! (- (credits-top) (/ (line-height) credits-pace))) - (wait 1))))) +(define (update-credits!) + (let ((i (credits-first-visible-index))) + (when (< i (vector-length (credits))) + (let* ((c (vector-ref (credits) i)) + (bottom (+ (credits-top) (credit-height c)))) + ;; Remove credits as they leave the screen and become invisible + (when (< bottom credits-end) + (set-credits-top! bottom) + (set-credits-first-visible-index! (1+ i)) + ((credit-on-leave c)))) + ;; Update credits + (vector-map (lambda (c) ((credit-update c))) (credits)) + ;; Advance credits + (set-credits-top! (- (credits-top) (/ (line-height) credits-pace)))))) (define (reset-game!) (run-script @@ -676,7 +707,9 @@ (maybe-poll-gamepad) (scheduler-tick! (current-scheduler)) (particle-pool-update! particles) - (timeout update-callback dt)) + (timeout update-callback dt) + (when (equal? (current-game-state) 'credits) + (update-credits!))) (define update-callback (procedure->external update)) ;; Rendering