From 8842e0120769ba589bcc405e19567572e6b01095 Mon Sep 17 00:00:00 2001
From: Amy Grinn <grinn.amy@gmail.com>
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 <credit>
- (_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 <credits-state>
- (make-credits-state top first-visible-index)
+(define-record-type <credits>
+ (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