From afef0fd480a87564a75bc3d8ed450ce3bb8213b9 Mon Sep 17 00:00:00 2001
From: Amy Grinn <grinn.amy@gmail.com>
Date: Wed, 8 Jan 2025 12:26:08 -0500
Subject: [PATCH 1/6] Rewrite existing credits

Each credit has its own draw function

Credits outside of the visible game area are not drawn
---
 game.js                      |   7 +-
 game.scm                     | 200 ++++++++++++++++++++++-------------
 modules/dom/canvas.scm       |   6 +-
 modules/dom/text-metrics.scm |  34 ++++++
 modules/srfi/srf-1.scm       |   3 +
 5 files changed, 174 insertions(+), 76 deletions(-)
 create mode 100644 modules/dom/text-metrics.scm
 create mode 100644 modules/srfi/srf-1.scm

diff --git a/game.js b/game.js
index 47780a6..6d59abb 100644
--- a/game.js
+++ b/game.js
@@ -81,7 +81,12 @@ window.addEventListener("load", async () => {
           translate: (ctx, x, y) => ctx.translate(x, y),
           rotate: (ctx, angle) => ctx.rotate(angle),
           setTransform: (ctx, a, b, c, d, e, f) => ctx.setTransform(a, b, c, d, e, f),
-          setImageSmoothingEnabled: (ctx, enabled) => ctx.imageSmoothingEnabled = (enabled == 1)
+          setImageSmoothingEnabled: (ctx, enabled) => ctx.imageSmoothingEnabled = (enabled == 1),
+          measureText: (ctx, text) => ctx.measureText(text),
+        },
+        textMetrics: {
+          actualBoundingBoxAscent: (metrics) => metrics.actualBoundingBoxAscent,
+          actualBoundingBoxDescent: (metrics) => metrics.actualBoundingBoxDescent,
         },
         math: {
           random: () => Math.random()
diff --git a/game.scm b/game.scm
index 493aa18..b130f73 100644
--- a/game.scm
+++ b/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))
diff --git a/modules/dom/canvas.scm b/modules/dom/canvas.scm
index a75fc09..266eeda 100644
--- a/modules/dom/canvas.scm
+++ b/modules/dom/canvas.scm
@@ -39,7 +39,8 @@
             translate!
             rotate!
             set-transform!
-            set-image-smoothing-enabled!))
+            set-image-smoothing-enabled!
+            measure-text))
 
 ;; HTMLCanvasElement
 (define-foreign get-context
@@ -98,3 +99,6 @@
 (define-foreign set-image-smoothing-enabled!
   "canvas" "setImageSmoothingEnabled"
   (ref extern) i32 -> none)
+(define-foreign measure-text
+  "canvas" "measureText"
+  (ref extern) (ref string) -> (ref extern))
diff --git a/modules/dom/text-metrics.scm b/modules/dom/text-metrics.scm
new file mode 100644
index 0000000..e5dce2d
--- /dev/null
+++ b/modules/dom/text-metrics.scm
@@ -0,0 +1,34 @@
+;;; Copyright (C) 2025 Amy Grinn <amy@spritely.institute>
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;    http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; Commentary:
+;;;
+;;; HTML canvas TextMetrics interface bindings
+;;;
+;;; Code:
+
+(define-module (dom text-metrics)
+  #:pure
+  #:use-module (scheme base)
+  #:use-module (hoot ffi)
+  #:export (text-metrics-actual-bounding-box-ascent
+            text-metrics-actual-bounding-box-descent))
+
+(define-foreign text-metrics-actual-bounding-box-ascent
+  "textMetrics" "actualBoundingBoxAscent"
+  (ref extern) -> i32)
+
+(define-foreign text-metrics-actual-bounding-box-descent
+  "textMetrics" "actualBoundingBoxDescent"
+  (ref extern) -> i32)
diff --git a/modules/srfi/srf-1.scm b/modules/srfi/srf-1.scm
new file mode 100644
index 0000000..26f8376
--- /dev/null
+++ b/modules/srfi/srf-1.scm
@@ -0,0 +1,3 @@
+(define-module (srfi srfi-1)
+  #:use-module ((scheme base) #:select (fold))
+  #:re-export (fold))

From 2870a88536d2b515e8113b9ea96cdf6aaca381ab Mon Sep 17 00:00:00 2001
From: Amy Grinn <grinn.amy@gmail.com>
Date: Fri, 10 Jan 2025 12:36:55 -0500
Subject: [PATCH 2/6] Created update script in 'load-credits'

---
 game.scm | 144 +++++++++++++++++++++++++++++++------------------------
 1 file changed, 82 insertions(+), 62 deletions(-)

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 <credit>
-  (_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 <credits-state>
+  (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

From 8842e0120769ba589bcc405e19567572e6b01095 Mon Sep 17 00:00:00 2001
From: Amy Grinn <grinn.amy@gmail.com>
Date: Wed, 15 Jan 2025 09:15:57 -0500
Subject: [PATCH 3/6] Added update, on-enter, and on-leave hooks

---
 game.scm | 105 ++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 69 insertions(+), 36 deletions(-)

diff --git a/game.scm b/game.scm
index e57b27d..df2ef91 100644
--- a/game.scm
+++ b/game.scm
@@ -411,14 +411,20 @@
       lh)))
 
 (define-record-type <credit>
-  (_make-credit lines draw)
+  (_make-credit lines draw update on-enter on-leave)
   credit?
   (lines credit-lines)
-  (draw credit-draw))
+  (draw credit-draw)
+  (update credit-update)
+  (on-enter credit-on-enter)
+  (on-leave credit-on-leave))
 
 (define* (make-credit #:key (lines 1)
-                      (draw (lambda (y) #f)))
-  (_make-credit lines draw))
+                      (draw (lambda (y) #f))
+                      (update (lambda () #f))
+                      (on-enter (lambda () #f))
+                      (on-leave (lambda () #f)))
+  (_make-credit lines draw update on-enter on-leave))
 
 (define* (make-credit-group #:rest credits)
   (make-credit
@@ -430,7 +436,16 @@
      (fold (lambda (c y)
              ((credit-draw c) y)
              (+ y (* (credit-lines c) (line-height))))
-           top credits))))
+           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)
   (make-credit
@@ -448,6 +463,8 @@
    (make-credit-text (make-string (string-length text) #\-))))
 
 (define credits
+
+(define (make-credits)
   (vector (make-credit-group
            (make-credit-text "Phew, you made it!")
            (make-credit-text "Time to relax."))
@@ -481,24 +498,45 @@
           (make-credit #:lines 4)
           (make-credit-text "Thank you for playing!")))
 
-(define-record-type <credits-state>
-  (make-credits-state top first-visible-index)
+(define-record-type <credits>
+  (make-credits-state credits top first-visible-index next-visible-index)
   credits-state?
+  (credits credits-state-credits)
   (top credits-state-top set-credits-state-top!)
   (first-visible-index
    credits-state-first-visible-index
-   set-credits-state-first-visible-index!))
+   set-credits-state-first-visible-index!)
+  (next-visible-index
+   credits-state-next-visible-index
+   set-credits-state-next-visible-index!))
 
-(define *credits* (make-credits-state credits-start 0))
+(define *credits* #f)
 
+(define (credits)
+  (credits-state-credits *credits*))
 (define (credits-top)
   (credits-state-top *credits*))
 (define (credits-first-visible-index)
   (credits-state-first-visible-index *credits*))
+(define (credits-next-visible-index)
+  (credits-state-next-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 (set-credits-next-visible-index! index)
+  (set-credits-state-next-visible-index! *credits* index))
+(define (credits-reset!)
+  (set! *credits* (make-credits-state (make-credits) credits-start 0 -1)))  
+
+(define (load-credits!)
+  (credits-reset!)
+  (replace-game-state! 'credits)
+  (set! *actormap* (make-whactormap))
+  (clear-snapshots!)
+  (with-goblins
+   (set! *level* (load-credits #f))
+   (update-objects!)))
 
 (define (credit-height credit)
   (+ (* (credit-lines credit) (line-height))
@@ -508,36 +546,29 @@
   (draw-level)
   (let lp ((i (credits-first-visible-index))
            (y (credits-top)))
-    (when (and (< i (vector-length credits))
+    (when (and (< i (vector-length (credits)))
                (<= 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)
         (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 (update-credits!)
+  (let ((i (credits-first-visible-index)))
+    (when (< i (vector-length (credits)))
+      (let* ((c (vector-ref (credits) i))
+             (bottom (+ (credits-top) (credit-height c))))
+        ;; Remove credits as they leave the screen and become invisible
+        (when (< bottom credits-end)
+          (set-credits-top! bottom)
+          (set-credits-first-visible-index! (1+ i))
+          ((credit-on-leave c))))
+      ;; Update credits
+      (vector-map (lambda (c) ((credit-update c))) (credits))
+      ;; Advance credits
+      (set-credits-top! (- (credits-top) (/ (line-height) credits-pace))))))
 
 (define (reset-game!)
   (run-script
@@ -676,7 +707,9 @@
   (maybe-poll-gamepad)
   (scheduler-tick! (current-scheduler))
   (particle-pool-update! particles)
-  (timeout update-callback dt))
+  (timeout update-callback dt)
+  (when (equal? (current-game-state) 'credits)
+    (update-credits!)))
 (define update-callback (procedure->external update))
 
 ;; Rendering

From 4f5676d3a5038ae2e6c140499db9d9125248c6d6 Mon Sep 17 00:00:00 2001
From: Amy Grinn <grinn.amy@gmail.com>
Date: Wed, 15 Jan 2025 09:16:13 -0500
Subject: [PATCH 4/6] Added centering credit

---
 game.scm | 18 +++++++++++++++---
 1 file changed, 15 insertions(+), 3 deletions(-)

diff --git a/game.scm b/game.scm
index df2ef91..6e0cc23 100644
--- a/game.scm
+++ b/game.scm
@@ -462,7 +462,19 @@
    (make-credit-text text)
    (make-credit-text (make-string (string-length text) #\-))))
 
-(define credits
+(define (make-credit-centering total-lines credit)
+  (make-credit
+   #:lines total-lines
+   #:draw
+   (lambda (y)
+     (let* ((progress (/ (- credits-start y) (+ game-height
+                                                (* (line-height) total-lines))))
+            (offset (* total-lines (line-height)
+                       (/ (1+ (- (cos (* progress 3.14)))) 2))))
+       ((credit-draw credit) (+ y offset))))
+   #:update (lambda () ((credit-update credit)))
+   #:on-enter (lambda () ((credit-on-enter credit)))
+   #:on-leave (lambda () ((credit-on-leave credit)))))
 
 (define (make-credits)
   (vector (make-credit-group
@@ -495,8 +507,8 @@
           (make-credit-group
            (make-credit-underline "Other")
            (make-credit-text "monogram font by datagoblin"))
-          (make-credit #:lines 4)
-          (make-credit-text "Thank you for playing!")))
+          (make-credit-centering
+           10 (make-credit-text "Thank you for playing!"))))
 
 (define-record-type <credits>
   (make-credits-state credits top first-visible-index next-visible-index)

From f67eb809109ddefcdac054b499a2a14c1e7def65 Mon Sep 17 00:00:00 2001
From: Amy Grinn <grinn.amy@gmail.com>
Date: Thu, 16 Jan 2025 16:31:36 -0500
Subject: [PATCH 5/6] Centering credit

---
 game.scm | 113 ++++++++++++++++++++++++++++++++-----------------------
 1 file changed, 65 insertions(+), 48 deletions(-)

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

From 0b39ba733d34a7ad8018726cd77c4635787d73b3 Mon Sep 17 00:00:00 2001
From: Amy Grinn <grinn.amy@gmail.com>
Date: Thu, 23 Jan 2025 13:39:39 -0500
Subject: [PATCH 6/6] Easing in and out of center using a sin function

---
 game.scm | 147 ++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 92 insertions(+), 55 deletions(-)

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 <menu>
@@ -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 <credit>
@@ -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 <credits>
   (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