Centering credit
This commit is contained in:
parent
4f5676d3a5
commit
f67eb80910
1 changed files with 65 additions and 48 deletions
103
game.scm
103
game.scm
|
@ -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)
|
||||||
|
(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
|
(make-credit
|
||||||
#:lines (fold (lambda (c lines)
|
#:lines (accumulate credit-lines)
|
||||||
(+ lines (credit-lines c)))
|
#:draw (lambda (top)
|
||||||
0 credits)
|
(accumulate credit-height #:init top #:preproc credit-draw))
|
||||||
#:draw
|
#:update (lambda (top)
|
||||||
(lambda (top)
|
(accumulate credit-height #:init top #:preproc credit-update))
|
||||||
(fold (lambda (c y)
|
#:on-enter (call credit-on-enter)
|
||||||
((credit-draw c) y)
|
#:on-leave (call credit-on-leave))))
|
||||||
(+ 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))))
|
|
||||||
|
|
||||||
(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))
|
||||||
|
(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
|
(make-credit
|
||||||
#:lines total-lines
|
#:lines (+ padding (* 2 fade) (credit-lines credit))
|
||||||
#:draw
|
#:draw (lambda (y) ((credit-draw credit) (+ y offset)))
|
||||||
|
#:update
|
||||||
(lambda (y)
|
(lambda (y)
|
||||||
(let* ((progress (/ (- credits-start y) (+ game-height
|
(when (<= y beg)
|
||||||
(* (line-height) total-lines))))
|
(cond
|
||||||
(offset (* total-lines (line-height)
|
((> y (- center (* (line-height) fade)))
|
||||||
(/ (1+ (- (cos (* progress 3.14)))) 2))))
|
;; Accelerate
|
||||||
((credit-draw credit) (+ y offset))))
|
(set! offset (+ offset (/ (- beg y) 2 fade credits-pace))))
|
||||||
#:update (lambda () ((credit-update credit)))
|
((> y (- center (* (line-height) (+ fade padding))))
|
||||||
#:on-enter (lambda () ((credit-on-enter credit)))
|
;; Match speed
|
||||||
#:on-leave (lambda () ((credit-on-leave credit)))))
|
(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-centering
|
||||||
(make-credit-group
|
(make-credit-group
|
||||||
(make-credit-text "Cirkoban was made by the")
|
(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-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))))))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue