Created update script in 'load-credits'

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