From f67eb809109ddefcdac054b499a2a14c1e7def65 Mon Sep 17 00:00:00 2001 From: Amy Grinn Date: Thu, 16 Jan 2025 16:31:36 -0500 Subject: [PATCH] Centering credit --- game.scm | 113 ++++++++++++++++++++++++++++++++----------------------- 1 file changed, 65 insertions(+), 48 deletions(-) diff --git a/game.scm b/game.scm index 6e0cc23..c156c25 100644 --- a/game.scm +++ b/game.scm @@ -421,31 +421,28 @@ (define* (make-credit #:key (lines 1) (draw (lambda (y) #f)) - (update (lambda () #f)) + (update (lambda (y) #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 - #:lines (fold (lambda (c lines) - (+ lines (credit-lines c))) - 0 credits) - #:draw - (lambda (top) - (fold (lambda (c y) - ((credit-draw c) y) - (+ y (* (credit-lines c) (line-height)))) - 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)))) + (let ((accumulate (lambda* (accessor #:key (init 0) preproc) + (fold (lambda (c sum) + (when preproc ((preproc c) sum)) + (+ sum (accessor c))) + init credits))) + (call (lambda (proc) + (lambda () + (map (lambda (c) ((proc c))) credits))))) + (make-credit + #:lines (accumulate credit-lines) + #:draw (lambda (top) + (accumulate credit-height #:init top #:preproc credit-draw)) + #:update (lambda (top) + (accumulate credit-height #:init top #:preproc credit-update)) + #:on-enter (call credit-on-enter) + #:on-leave (call credit-on-leave)))) (define (make-credit-text text) (make-credit @@ -462,27 +459,40 @@ (make-credit-text text) (make-credit-text (make-string (string-length text) #\-)))) -(define (make-credit-centering total-lines credit) - (make-credit - #:lines total-lines - #:draw - (lambda (y) - (let* ((progress (/ (- credits-start y) (+ game-height - (* (line-height) total-lines)))) - (offset (* total-lines (line-height) - (/ (1+ (- (cos (* progress 3.14)))) 2)))) - ((credit-draw credit) (+ y offset)))) - #:update (lambda () ((credit-update credit))) - #:on-enter (lambda () ((credit-on-enter credit))) - #:on-leave (lambda () ((credit-on-leave credit))))) +(define* (make-credit-centering credit #:key (padding 6.0) (fade 1.0)) + (let* ((offset 0.0) + (center (+ (/ (- game-height (credit-height credit)) 2) + (* 0.75 tile-height))) + (beg (+ center (* (line-height) fade))) + (end (- center (* (line-height) (+ padding (* 3 fade)))))) + (make-credit + #:lines (+ padding (* 2 fade) (credit-lines credit)) + #:draw (lambda (y) ((credit-draw credit) (+ y offset))) + #:update + (lambda (y) + (when (<= y beg) + (cond + ((> y (- center (* (line-height) fade))) + ;; Accelerate + (set! offset (+ offset (/ (- beg y) 2 fade credits-pace)))) + ((> y (- center (* (line-height) (+ fade padding)))) + ;; Match speed + (set! offset (+ offset (/ (line-height) credits-pace)))) + ((> y end) + ;; Decelarate + (set! offset (+ offset (/ (- y end) 2 fade credits-pace)))))) + ((credit-update credit) (+ y offset))) + #:on-enter (credit-on-enter credit) + #:on-leave (credit-on-leave credit)))) (define (make-credits) (vector (make-credit-group (make-credit-text "Phew, you made it!") (make-credit-text "Time to relax.")) - (make-credit-group - (make-credit-text "Cirkoban was made by the") - (make-credit-text "Spritely Institute")) + (make-credit-centering + (make-credit-group + (make-credit-text "Cirkoban was made by the") + (make-credit-text "Spritely Institute"))) (make-credit-text "https://spritely.institute") (make-credit-group (make-credit-underline "Game Design") @@ -508,7 +518,8 @@ (make-credit-underline "Other") (make-credit-text "monogram font by datagoblin")) (make-credit-centering - 10 (make-credit-text "Thank you for playing!")))) + (make-credit-text "Thank you for playing!") + #:fade 1))) (define-record-type (make-credits-state credits top first-visible-index next-visible-index) @@ -551,8 +562,7 @@ (update-objects!))) (define (credit-height credit) - (+ (* (credit-lines credit) (line-height)) - credits-margin)) + (* (credit-lines credit) (line-height))) (define (draw-credits) (draw-level) @@ -560,25 +570,32 @@ (y (credits-top))) (when (and (< i (vector-length (credits))) (<= y credits-start)) - (let* ((c (vector-ref (credits) i))) - (when (> i (credits-next-visible-index)) - ((credit-on-enter c)) - (set-credits-next-visible-index! i)) + (let ((c (vector-ref (credits) i))) ((credit-draw c) y) - (lp (1+ i) (+ y (credit-height c))))))) + (lp (1+ i) (+ y (credit-height c) credits-margin)))))) (define (update-credits!) (let ((i (credits-first-visible-index))) (when (< i (vector-length (credits))) + ;; Update credits + (let lp ((i i) + (y (credits-top))) + (when (and (< i (vector-length (credits))) + (<= y credits-start)) + (let ((c (vector-ref (credits) i))) + ;; Call on-enter as credits enter the screen + (when (> i (credits-next-visible-index)) + ((credit-on-enter c)) + (set-credits-next-visible-index! i)) + ((credit-update c) y) + (lp (1+ i) (+ y (credit-height c) credits-margin))))) + ;; Remove credits as they leave the screen (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-top! (+ bottom credits-margin)) (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))))))