SuperKamiGuru/foss-mmo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Added update, on-enter, and on-leave hooks

Browse source
This commit is contained in:
Amy Grinn 2025-01-15 09:15:57 -05:00
parent 2870a88536
commit 8842e01207
No known key found for this signature in database
GPG key ID: 6B558BED1DCF3192
1 changed files with 69 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

105
game.scm
View file

@ -411,14 +411,20 @@
lh))) lh)))
(define-record-type <credit> (define-record-type <credit>
(_make-credit lines draw) (_make-credit lines draw update on-enter on-leave)
credit? credit?
(lines credit-lines) (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) (define* (make-credit #:key (lines 1)
(draw (lambda (y) #f))) (draw (lambda (y) #f))
(_make-credit lines draw)) (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) (define* (make-credit-group #:rest credits)
(make-credit (make-credit
@ -430,7 +436,16 @@
(fold (lambda (c y) (fold (lambda (c y)
((credit-draw c) y) ((credit-draw c) y)
(+ y (* (credit-lines c) (line-height)))) (+ 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) (define (make-credit-text text)
(make-credit (make-credit
@ -448,6 +463,8 @@
(make-credit-text (make-string (string-length text) #\-)))) (make-credit-text (make-string (string-length text) #\-))))
(define credits (define credits
(define (make-credits)
(vector (make-credit-group (vector (make-credit-group
(make-credit-text "Phew, you made it!") (make-credit-text "Phew, you made it!")
(make-credit-text "Time to relax.")) (make-credit-text "Time to relax."))
@ -481,24 +498,45 @@
(make-credit #:lines 4) (make-credit #:lines 4)
(make-credit-text "Thank you for playing!"))) (make-credit-text "Thank you for playing!")))
(define-record-type <credits-state> (define-record-type <credits>
(make-credits-state top first-visible-index) (make-credits-state credits top first-visible-index next-visible-index)
credits-state? credits-state?
(credits credits-state-credits)
(top credits-state-top set-credits-state-top!) (top credits-state-top set-credits-state-top!)
(first-visible-index (first-visible-index
credits-state-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) (define (credits-top)
(credits-state-top *credits*)) (credits-state-top *credits*))
(define (credits-first-visible-index) (define (credits-first-visible-index)
(credits-state-first-visible-index *credits*)) (credits-state-first-visible-index *credits*))
(define (credits-next-visible-index)
(credits-state-next-visible-index *credits*))
(define (set-credits-top! top) (define (set-credits-top! top)
(set-credits-state-top! *credits* top)) (set-credits-state-top! *credits* top))
(define (set-credits-first-visible-index! index) (define (set-credits-first-visible-index! index)
(set-credits-state-first-visible-index! *credits* 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) (define (credit-height credit)
(+ (* (credit-lines credit) (line-height)) (+ (* (credit-lines credit) (line-height))
@ -508,36 +546,29 @@
(draw-level) (draw-level)
(let lp ((i (credits-first-visible-index)) (let lp ((i (credits-first-visible-index))
(y (credits-top))) (y (credits-top)))
(when (and (< i (vector-length credits)) (when (and (< i (vector-length (credits)))
(<= y credits-start)) (<= 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) ((credit-draw c) y)
(lp (1+ i) (+ y (credit-height c))))))) (lp (1+ i) (+ y (credit-height c)))))))
(define (load-credits!) (define (update-credits!)
(replace-game-state! 'credits) (let ((i (credits-first-visible-index)))
(set! *actormap* (make-whactormap)) (when (< i (vector-length (credits)))
(clear-snapshots!) (let* ((c (vector-ref (credits) i))
(with-goblins (bottom (+ (credits-top) (credit-height c))))
(set! *level* (load-credits #f)) ;; Remove credits as they leave the screen and become invisible
(update-objects!)) (when (< bottom credits-end)
;; Update function (set-credits-top! bottom)
(run-script (set-credits-first-visible-index! (1+ i))
(lambda () ((credit-on-leave c))))
(set-credits-top! credits-start) ;; Update credits
(set-credits-first-visible-index! 0) (vector-map (lambda (c) ((credit-update c))) (credits))
(while (< (credits-first-visible-index) (vector-length credits)) ;; Advance credits
;; Remove credits as they leave the screen and become invisible (set-credits-top! (- (credits-top) (/ (line-height) credits-pace))))))
(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 (reset-game!) (define (reset-game!)
(run-script (run-script
@ -676,7 +707,9 @@
(maybe-poll-gamepad) (maybe-poll-gamepad)
(scheduler-tick! (current-scheduler)) (scheduler-tick! (current-scheduler))
(particle-pool-update! particles) (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)) (define update-callback (procedure->external update))
;; Rendering ;; Rendering