diff --git a/game.scm b/game.scm index c156c25..d51b675 100644 --- a/game.scm +++ b/game.scm @@ -281,6 +281,8 @@ (set-level! *level-idx*) (media-play audio:bg-music))))) +(define text-offset-y (* 0.75 tile-height)) + ;; Menu types (define-record-type @@ -393,10 +395,10 @@ ;; Credits -(define credits-margin 40.0) ;; pixels -(define credits-pace 30.0) ;; frames per line (inverse speed) -(define credits-start (+ game-height (* 0.75 tile-height))) -(define credits-end (* 0.75 tile-height)) +(define credits-margin 0.0) ;; lines +(define credits-pace 15.0) ;; ticks per line (inverse speed) +(define credits-start (+ game-height text-offset-y)) +(define credits-end text-offset-y) (define line-height (let ((lh #f)) @@ -407,7 +409,7 @@ (set! lh (* (+ (text-metrics-actual-bounding-box-ascent metrics) (text-metrics-actual-bounding-box-descent metrics)) - 1.2)))) + 1.25)))) lh))) (define-record-type @@ -421,13 +423,13 @@ (define* (make-credit #:key (lines 1) (draw (lambda (y) #f)) - (update (lambda (y) #f)) + (update (lambda (t) #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) + (let ((accumulate (lambda* (accessor #:key (init 0.0) preproc) (fold (lambda (c sum) (when preproc ((preproc c) sum)) (+ sum (accessor c))) @@ -459,67 +461,102 @@ (make-credit-text text) (make-credit-text (make-string (string-length text) #\-)))) -(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)))))) +(define* (make-credit-centering credit #:key (padding 6.0) (easing 4.0) + (on-enter-center (lambda () #f)) + (on-leave-center (lambda () #f))) + (let* ((pi 3.14159) + (offset 0.0) + (speed (/ (line-height) credits-pace)) + (center (/ (- (+ credits-start credits-end) (credit-height credit)) 2.0)) + (ease-height (* (line-height) easing)) + (ease-speed (lambda (y) (* speed (sin (/ y ease-height))))) + ;; Amount that credits scroll up during easing + (ease-travel (* ease-height (/ pi 2.0))) + ;; Start below center so that it eases right into the center + (beg (+ center (- ease-travel ease-height))) + (beg-mid (- beg ease-travel)) + (end-mid (- beg-mid (* (line-height) padding))) + (end (- end-mid ease-travel))) (make-credit - #:lines (+ padding (* 2 fade) (credit-lines credit)) + #:lines (+ padding (* 2 easing) (credit-lines credit)) #:draw (lambda (y) ((credit-draw credit) (+ y offset))) #:update + ;; Remember that y is decreasing as credits rise up the screen + ;; toward y=0, so the comparators might seem to be flipped but + ;; that's how they need to be. (lambda (y) - (when (<= y beg) + (when (and (<= y beg) (> y end)) (cond - ((> y (- center (* (line-height) fade))) + ((> y beg-mid) ;; Accelerate - (set! offset (+ offset (/ (- beg y) 2 fade credits-pace)))) - ((> y (- center (* (line-height) (+ fade padding)))) + (set! offset (+ offset (ease-speed (- beg y))))) + ((> y end-mid) ;; Match speed - (set! offset (+ offset (/ (line-height) credits-pace)))) - ((> y end) - ;; Decelarate - (set! offset (+ offset (/ (- y end) 2 fade credits-pace)))))) + (set! offset (+ offset speed)) + (when on-enter-center + (on-enter-center) + (set! on-enter-center #f))) + (else + ;; Decelerate + (when on-leave-center + (on-leave-center) + (set! on-leave-center #f)) + (set! offset (+ offset (ease-speed (- y end))))))) + ;; Call on-leave-center even if no easing is used + (when (and (<= y end) on-leave-center) + (on-leave-center) + (set! on-leave-center #f)) ((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.")) + (vector (make-credit-centering + (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 "https://spritely.institute") - (make-credit-group - (make-credit-underline "Game Design") - (make-credit-text "Christine Lemmer-Webber")) - (make-credit-group - (make-credit-underline "Level Design") - (make-credit-text "Christine Lemmer-Webber") - (make-credit-text "Juliana Sims") - (make-credit-text "David Thompson")) - (make-credit-group - (make-credit-underline "Pixel Art") - (make-credit-text "Christine Lemmer-Webber")) - (make-credit-group - (make-credit-underline "Music") - (make-credit-text "EncryptedWhispers") - (make-credit-text "Christine Lemmer-Webber")) - (make-credit-group - (make-credit-underline "Programming") - (make-credit-text "Juliana Sims") - (make-credit-text "David Thompson") - (make-credit-text "Amy Grinn")) - (make-credit-group - (make-credit-underline "Other") - (make-credit-text "monogram font by datagoblin")) (make-credit-centering - (make-credit-text "Thank you for playing!") - #:fade 1))) + (make-credit-text "https://spritely.institute")) + (make-credit-centering + (make-credit-group + (make-credit-underline "Game Design") + (make-credit-text "Christine Lemmer-Webber"))) + (make-credit-centering + (make-credit-group + (make-credit-underline "Level Design") + (make-credit-text "Christine Lemmer-Webber") + (make-credit-text "Juliana Sims") + (make-credit-text "David Thompson")) + #:on-enter-center (lambda () (pk "Level Design centering!!")) + #:on-leave-center (lambda () (pk "Level Design leaving center!!"))) + (make-credit-centering + (make-credit-group + (make-credit-underline "Pixel Art") + (make-credit-text "Christine Lemmer-Webber")) + #:easing 0 + #:on-enter-center (lambda () (pk "Pixel Art centering!!")) + #:on-leave-center (lambda () (pk "Pixel Art leaving center!!"))) + (make-credit-centering + (make-credit-group + (make-credit-underline "Music") + (make-credit-text "EncryptedWhispers") + (make-credit-text "Christine Lemmer-Webber"))) + (make-credit-centering + (make-credit-group + (make-credit-underline "Programming") + (make-credit-text "Juliana Sims") + (make-credit-text "David Thompson") + (make-credit-text "Amy Grinn"))) + (make-credit-centering + (make-credit-group + (make-credit-underline "Other") + (make-credit-text "monogram font by datagoblin"))) + (make-credit-centering + (make-credit-text "Thank you for playing!")))) (define-record-type (make-credits-state credits top first-visible-index next-visible-index) @@ -572,7 +609,8 @@ (<= y credits-start)) (let ((c (vector-ref (credits) i))) ((credit-draw c) y) - (lp (1+ i) (+ y (credit-height c) credits-margin)))))) + (lp (1+ i) (+ y (credit-height c) (* (line-height) + credits-margin))))))) (define (update-credits!) (let ((i (credits-first-visible-index))) @@ -588,12 +626,12 @@ ((credit-on-enter c)) (set-credits-next-visible-index! i)) ((credit-update c) y) - (lp (1+ i) (+ y (credit-height c) credits-margin))))) + (lp (1+ i) (+ y (credit-height c) (* (line-height) credits-margin)))))) ;; Remove credits as they leave the screen (let* ((c (vector-ref (credits) i)) (bottom (+ (credits-top) (credit-height c)))) (when (< bottom credits-end) - (set-credits-top! (+ bottom credits-margin)) + (set-credits-top! (+ bottom (* (line-height) credits-margin))) (set-credits-first-visible-index! (1+ i)) ((credit-on-leave c)))) ;; Advance credits @@ -946,7 +984,6 @@ ;; + num menu items + 1 for ellipses if num items is too big ;; + the y padding again (let* ((padding-y 1) - (text-offset-y (* 0.75 tile-height)) (width 8.0) (num-items (vector-length (menu-items (current-menu)))) (height (+ 2 ;; Menu title + back/ellipses