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

Centering credit

Browse source
This commit is contained in:
Amy Grinn 2025-01-16 16:31:36 -05:00
parent 4f5676d3a5
commit f67eb80910
No known key found for this signature in database
GPG key ID: 6B558BED1DCF3192
1 changed files with 65 additions and 48 deletions

103
game.scm
View file

@ -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)
(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 (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))))
#: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)
(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 total-lines
#:draw
#:lines (+ padding (* 2 fade) (credit-lines credit))
#:draw (lambda (y) ((credit-draw credit) (+ y offset)))
#:update
(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)))))
(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-centering
(make-credit-group
(make-credit-text "Cirkoban was made by the")
(make-credit-text "Spritely Institute"))
(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 <credits>
(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))))))