Added update, on-enter, and on-leave hooks

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