Rewrite existing credits

Each credit has its own draw function

Credits outside of the visible game area are not drawn

game.scm

@@ -20,6 +20,7 @@
 ;;; Code:
 
 (use-modules (dom canvas)
+             (dom text-metrics)
              (dom document)
              (dom element)
              (dom event)
@@ -62,7 +63,8 @@
              (math)
              (math rect)
              (math vector)
-             (scheme base))
+             (scheme base)
+             (srfi srfi-1))
 
 (define game-width 320.0)
 (define game-height 240.0)
@@ -228,8 +230,8 @@
 (define (load-credits!)
   (replace-game-state! 'credits)
   (set! *actormap* (make-whactormap))
-  (set-vec2-y! *credits-scroll* 0.0)
   (clear-snapshots!)
+  (set! *credits-top* credits-start)
   (with-goblins
    (set! *level* (load-credits #f))
    (update-objects!)))
@@ -396,6 +398,127 @@
       (pop-menu-history!)
       ((cdr (vector-ref (menu-items (current-menu)) (current-menu-index))))))
 
+
+;; Credits
+
+(define credits-margin 40.0) ;; pixels
+
+(define credits-speed 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-record-type <credit>
+  (_make-credit height draw)
+  credit?
+  (height credit-height)
+  (draw credit-draw))
+
+(define* (make-credit #:key height draw)
+  (_make-credit height draw))
+
+(define* (make-credit-group #:rest credits)
+  (make-credit
+   #:height (fold (lambda (c prev)
+                    (+ prev (credit-height 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)))
+
+(define (make-credit-text text)
+  (make-credit
+   #:height 1
+   #:draw
+   (lambda (y)
+     (set-fill-color! context "#fff")
+     (set-text-align! context "center")
+     (set-font! context "normal 16px monogram")
+     (fill-text context text
+                (* 0.7 game-width) y))))
+
+(define (make-credit-underline text)
+  (make-credit-group
+   (make-credit-text text)
+   (make-credit-text (make-string (string-length text)
+                                  #\-))))
+
+(define credits
+  (vector (make-credit-group
+           (make-credit-text "Phew, you made it!")
+           (make-credit-text "Time to relax."))
+          (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-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-space 4)
+          (make-credit-text "Thank you for playing!")))
+
+(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))))
+
 (define (reset-game!)
   (run-script
    (lambda ()
@@ -786,7 +909,7 @@
                        (vec2-x center) y-text))
           (set-text-align! context "left")
           ;; indicator
-          (when (= (+ r r-page-offset) (current-menu-index))
+          (when (= r-page (current-menu-index))
             (fill-text context "▸" x-gutter y-text))
           ;; Menu items
           (when (>= r -1)
@@ -842,77 +965,6 @@
 (define (draw-interstitial)
   (draw-level))
 
-(define *credits-scroll* (vec2 0.0 0.0))
-(define credits
-  #("Phew, you made it!"
-    "Time to relax."
-    #f
-    #f
-    "Cirkoban was made by the"
-    "Spritely Institute"
-    #f
-    "https://spritely.institute"
-    #f
-    "Game Design"
-    "-----------"
-    "Christine Lemmer-Webber"
-    #f
-    "Level Design"
-    "------------"
-    "Christine Lemmer-Webber"
-    "Juliana Sims"
-    "David Thompson"
-    #f
-    "Pixel Art"
-    "---------"
-    "Christine Lemmer-Webber"
-    #f
-    "Music"
-    "-----"
-    "EncryptedWhispers"
-    "Christine Lemmer-Webber"
-    #f
-    "Programming"
-    "-----------"
-    "Juliana Sims"
-    "David Thompson"
-    #f
-    "Other"
-    "-----"
-    "monogram font by datagoblin"
-    #f
-    #f
-    #f
-    #f
-    #f
-    #f
-    #f
-    #f
-    "Thank you for playing!"))
-(define credits-line-spacing 16.0)
-(define max-credits-scroll
-  (+ game-height (* (- (vector-length credits) 9) credits-line-spacing)))
-(define (draw-credits)
-  (draw-level)
-  (set-fill-color! context "#ffffff")
-  (set-text-align! context "center")
-  (set-font! context "normal 16px monogram")
-  (set-vec2-y! *credits-scroll*
-               (min (+ (vec2-y *credits-scroll*) 0.5)
-                    max-credits-scroll))
-  (let* ((x (* game-width 0.7))
-         (lines-on-screen 15)
-         (scroll-y (vec2-y *credits-scroll*))
-         ;; TODO: Only render the lines on screen.
-         (start 0)
-         (end (vector-length credits)))
-    (let lp ((i start) (y (- game-height scroll-y)))
-      (when (< i end)
-        (match (vector-ref credits i)
-          (#f #f)
-          (str (fill-text context str x y)))
-        (lp (1+ i) (+ y credits-line-spacing))))))
-
 (define *frame-time* (current-time*))
 (define (draw time)
   (unless (and (real? time) (inexact? time))