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
Show stats Download patch file Download diff file Expand all files Collapse all files

113
game.scm
View file

@ -421,31 +421,28 @@
(define* (make-credit #:key (lines 1) (define* (make-credit #:key (lines 1)
(draw (lambda (y) #f)) (draw (lambda (y) #f))
(update (lambda () #f)) (update (lambda (y) #f))
(on-enter (lambda () #f)) (on-enter (lambda () #f))
(on-leave (lambda () #f))) (on-leave (lambda () #f)))
(_make-credit lines draw update on-enter on-leave)) (_make-credit lines draw update on-enter on-leave))
(define* (make-credit-group #:rest credits) (define* (make-credit-group #:rest credits)
(make-credit (let ((accumulate (lambda* (accessor #:key (init 0) preproc)
#:lines (fold (lambda (c lines) (fold (lambda (c sum)
(+ lines (credit-lines c))) (when preproc ((preproc c) sum))
0 credits) (+ sum (accessor c)))
#:draw init credits)))
(lambda (top) (call (lambda (proc)
(fold (lambda (c y) (lambda ()
((credit-draw c) y) (map (lambda (c) ((proc c))) credits)))))
(+ y (* (credit-lines c) (line-height)))) (make-credit
top credits)) #:lines (accumulate credit-lines)
#:update #:draw (lambda (top)
(lambda () (accumulate credit-height #:init top #:preproc credit-draw))
(map (lambda (c) ((credit-update c))) credits)) #:update (lambda (top)
#:on-enter (accumulate credit-height #:init top #:preproc credit-update))
(lambda () #:on-enter (call credit-on-enter)
(map (lambda (c) ((credit-on-enter c))) credits)) #:on-leave (call credit-on-leave))))
#: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
@ -462,27 +459,40 @@
(make-credit-text text) (make-credit-text text)
(make-credit-text (make-string (string-length 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))
(make-credit (let* ((offset 0.0)
#:lines total-lines (center (+ (/ (- game-height (credit-height credit)) 2)
#:draw (* 0.75 tile-height)))
(lambda (y) (beg (+ center (* (line-height) fade)))
(let* ((progress (/ (- credits-start y) (+ game-height (end (- center (* (line-height) (+ padding (* 3 fade))))))
(* (line-height) total-lines)))) (make-credit
(offset (* total-lines (line-height) #:lines (+ padding (* 2 fade) (credit-lines credit))
(/ (1+ (- (cos (* progress 3.14)))) 2)))) #:draw (lambda (y) ((credit-draw credit) (+ y offset)))
((credit-draw credit) (+ y offset)))) #:update
#:update (lambda () ((credit-update credit))) (lambda (y)
#:on-enter (lambda () ((credit-on-enter credit))) (when (<= y beg)
#:on-leave (lambda () ((credit-on-leave credit))))) (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) (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."))
(make-credit-group (make-credit-centering
(make-credit-text "Cirkoban was made by the") (make-credit-group
(make-credit-text "Spritely Institute")) (make-credit-text "Cirkoban was made by the")
(make-credit-text "Spritely Institute")))
(make-credit-text "https://spritely.institute") (make-credit-text "https://spritely.institute")
(make-credit-group (make-credit-group
(make-credit-underline "Game Design") (make-credit-underline "Game Design")
@ -508,7 +518,8 @@
(make-credit-underline "Other") (make-credit-underline "Other")
(make-credit-text "monogram font by datagoblin")) (make-credit-text "monogram font by datagoblin"))
(make-credit-centering (make-credit-centering
10 (make-credit-text "Thank you for playing!")))) (make-credit-text "Thank you for playing!")
#:fade 1)))
(define-record-type <credits> (define-record-type <credits>
(make-credits-state credits top first-visible-index next-visible-index) (make-credits-state credits top first-visible-index next-visible-index)
@ -551,8 +562,7 @@
(update-objects!))) (update-objects!)))
(define (credit-height credit) (define (credit-height credit)
(+ (* (credit-lines credit) (line-height)) (* (credit-lines credit) (line-height)))
credits-margin))
(define (draw-credits) (define (draw-credits)
(draw-level) (draw-level)
@ -560,25 +570,32 @@
(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) credits-margin))))))
(define (update-credits!) (define (update-credits!)
(let ((i (credits-first-visible-index))) (let ((i (credits-first-visible-index)))
(when (< i (vector-length (credits))) (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)) (let* ((c (vector-ref (credits) i))
(bottom (+ (credits-top) (credit-height c)))) (bottom (+ (credits-top) (credit-height c))))
;; Remove credits as they leave the screen and become invisible
(when (< bottom credits-end) (when (< bottom credits-end)
(set-credits-top! bottom) (set-credits-top! (+ bottom credits-margin))
(set-credits-first-visible-index! (1+ i)) (set-credits-first-visible-index! (1+ i))
((credit-on-leave c)))) ((credit-on-leave c))))
;; Update credits
(vector-map (lambda (c) ((credit-update c))) (credits))
;; Advance credits ;; Advance credits
(set-credits-top! (- (credits-top) (/ (line-height) credits-pace)))))) (set-credits-top! (- (credits-top) (/ (line-height) credits-pace))))))