diff --git a/game.scm b/game.scm index b130f73..e57b27d 100644 --- a/game.scm +++ b/game.scm @@ -227,14 +227,6 @@ (set! *level* ((vector-ref levels idx) (collected-gem? idx))) (update-objects!))) -(define (load-credits!) - (replace-game-state! 'credits) - (set! *actormap* (make-whactormap)) - (clear-snapshots!) - (set! *credits-top* credits-start) - (with-goblins - (set! *level* (load-credits #f)) - (update-objects!))) (define (load-level! idx) ;; TODO: Maybe show a little achievement popup when all gems @@ -402,55 +394,46 @@ ;; Credits (define credits-margin 40.0) ;; pixels - -(define credits-speed 30.0) ;; frames per line (inverse speed) - +(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-top* credits-start) - -(define _line-height #f) -(define (line-height) - (unless _line-height - (set-font! context "normal 16px monogram") - (let ((metrics (measure-text context "Aj"))) - (set! _line-height - (* (+ (text-metrics-actual-bounding-box-ascent metrics) - (text-metrics-actual-bounding-box-descent metrics)) - 1.2)))) - _line-height) +(define line-height + (let ((lh #f)) + (lambda () + (unless lh + (set-font! context "normal 16px monogram") + (let ((metrics (measure-text context "Aj"))) + (set! lh + (* (+ (text-metrics-actual-bounding-box-ascent metrics) + (text-metrics-actual-bounding-box-descent metrics)) + 1.2)))) + lh))) (define-record-type - (_make-credit height draw) + (_make-credit lines draw) credit? - (height credit-height) + (lines credit-lines) (draw credit-draw)) -(define* (make-credit #:key height draw) - (_make-credit height draw)) +(define* (make-credit #:key (lines 1) + (draw (lambda (y) #f))) + (_make-credit lines draw)) (define* (make-credit-group #:rest credits) (make-credit - #:height (fold (lambda (c prev) - (+ prev (credit-height c))) - 0 credits) + #:lines (fold (lambda (c lines) + (+ lines (credit-lines c))) + 0 credits) #:draw (lambda (top) - (do ((i 0 (1+ i)) - (y top (+ y (* (credit-height (list-ref credits i)) - (line-height))))) - ((= i (length credits))) - ((credit-draw (list-ref credits i)) y))))) - -(define* (make-credit-space #:optional (lines 1)) - (make-credit - #:height lines - #:draw (lambda (y) #f))) + (fold (lambda (c y) + ((credit-draw c) y) + (+ y (* (credit-lines c) (line-height)))) + top credits)))) (define (make-credit-text text) (make-credit - #:height 1 #:draw (lambda (y) (set-fill-color! context "#fff") @@ -462,8 +445,7 @@ (define (make-credit-underline text) (make-credit-group (make-credit-text text) - (make-credit-text (make-string (string-length text) - #\-)))) + (make-credit-text (make-string (string-length text) #\-)))) (define credits (vector (make-credit-group @@ -472,8 +454,7 @@ (make-credit-group (make-credit-text "Cirkoban was made by the") (make-credit-text "Spritely Institute")) - (make-credit-group - (make-credit-text "https://spritely.institute")) + (make-credit-text "https://spritely.institute") (make-credit-group (make-credit-underline "Game Design") (make-credit-text "Christine Lemmer-Webber")) @@ -497,27 +478,66 @@ (make-credit-group (make-credit-underline "Other") (make-credit-text "monogram font by datagoblin")) - (make-credit-space 4) + (make-credit #:lines 4) (make-credit-text "Thank you for playing!"))) +(define-record-type + (make-credits-state top first-visible-index) + credits-state? + (top credits-state-top set-credits-state-top!) + (first-visible-index + credits-state-first-visible-index + set-credits-state-first-visible-index!)) + +(define *credits* (make-credits-state credits-start 0)) + +(define (credits-top) + (credits-state-top *credits*)) +(define (credits-first-visible-index) + (credits-state-first-visible-index *credits*)) +(define (set-credits-top! top) + (set-credits-state-top! *credits* top)) +(define (set-credits-first-visible-index! index) + (set-credits-state-first-visible-index! *credits* index)) + +(define (credit-height credit) + (+ (* (credit-lines credit) (line-height)) + credits-margin)) + (define (draw-credits) (draw-level) - (let ((height (lambda (c) - (+ (* (credit-height c) (line-height)) - credits-margin))) - (i 0) - (y *credits-top*)) - ;; Ignore credits that are higher than the top of the game - (while (and (< i (vector-length credits)) - (< y (- (height (vector-ref credits i))) credits-end)) - (set! y (+ y (height (vector-ref credits i)))) - (set! i (1+ i))) - ;; Draw credits that are higher than the bottom of the game - (while (and (< i (vector-length credits)) (<= y credits-start)) - ((credit-draw (vector-ref credits i)) y) - (set! y (+ y (height (vector-ref credits i)))) - (set! i (1+ i)))) - (set! *credits-top* (- *credits-top* (/ (line-height) credits-speed)))) + (let lp ((i (credits-first-visible-index)) + (y (credits-top))) + (when (and (< i (vector-length credits)) + (<= y credits-start)) + (let* ((c (vector-ref credits i))) + ((credit-draw c) y) + (lp (1+ i) (+ y (credit-height c))))))) + +(define (load-credits!) + (replace-game-state! 'credits) + (set! *actormap* (make-whactormap)) + (clear-snapshots!) + (with-goblins + (set! *level* (load-credits #f)) + (update-objects!)) + ;; Update function + (run-script + (lambda () + (set-credits-top! credits-start) + (set-credits-first-visible-index! 0) + (while (< (credits-first-visible-index) (vector-length credits)) + ;; Remove credits as they leave the screen and become invisible + (let ((bottom (+ (credits-top) + (credit-height (vector-ref + credits + (credits-first-visible-index)))))) + (when (< bottom credits-end) + (set-credits-top! bottom) + (set-credits-first-visible-index! (1+ (credits-first-visible-index))))) + ;; Advance credits + (set-credits-top! (- (credits-top) (/ (line-height) credits-pace))) + (wait 1))))) (define (reset-game!) (run-script