SuperKamiGuru/foss-mmo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Created update script in 'load-credits'

Browse source
This commit is contained in:
Amy Grinn 2025-01-10 12:36:55 -05:00
parent afef0fd480
commit 2870a88536
No known key found for this signature in database
GPG key ID: 6B558BED1DCF3192
1 changed files with 82 additions and 62 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

132
game.scm
View file

@ -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
(define line-height
(let ((lh #f))
(lambda ()
(unless lh
(set-font! context "normal 16px monogram")
(let ((metrics (measure-text context "Aj")))
(set! _line-height
(set! lh
(* (+ (text-metrics-actual-bounding-box-ascent metrics)
(text-metrics-actual-bounding-box-descent metrics))
1.2))))
_line-height)
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)))
#: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