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

144
game.scm
View file

@ -227,14 +227,6 @@
(set! *level* ((vector-ref levels idx) (collected-gem? idx))) (set! *level* ((vector-ref levels idx) (collected-gem? idx)))
(update-objects!))) (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) (define (load-level! idx)
;; TODO: Maybe show a little achievement popup when all gems ;; TODO: Maybe show a little achievement popup when all gems
@ -402,55 +394,46 @@
;; Credits ;; Credits
(define credits-margin 40.0) ;; pixels (define credits-margin 40.0) ;; pixels
(define credits-pace 30.0) ;; frames per line (inverse speed)
(define credits-speed 30.0) ;; frames per line (inverse speed)
(define credits-start (+ game-height (* 0.75 tile-height))) (define credits-start (+ game-height (* 0.75 tile-height)))
(define credits-end (* 0.75 tile-height)) (define credits-end (* 0.75 tile-height))
(define *credits-top* credits-start) (define line-height
(let ((lh #f))
(define _line-height #f) (lambda ()
(define (line-height) (unless lh
(unless _line-height (set-font! context "normal 16px monogram")
(set-font! context "normal 16px monogram") (let ((metrics (measure-text context "Aj")))
(let ((metrics (measure-text context "Aj"))) (set! lh
(set! _line-height (* (+ (text-metrics-actual-bounding-box-ascent metrics)
(* (+ (text-metrics-actual-bounding-box-ascent metrics) (text-metrics-actual-bounding-box-descent metrics))
(text-metrics-actual-bounding-box-descent metrics)) 1.2))))
1.2)))) lh)))
_line-height)
(define-record-type <credit> (define-record-type <credit>
(_make-credit height draw) (_make-credit lines draw)
credit? credit?
(height credit-height) (lines credit-lines)
(draw credit-draw)) (draw credit-draw))
(define* (make-credit #:key height draw) (define* (make-credit #:key (lines 1)
(_make-credit height draw)) (draw (lambda (y) #f)))
(_make-credit lines draw))
(define* (make-credit-group #:rest credits) (define* (make-credit-group #:rest credits)
(make-credit (make-credit
#:height (fold (lambda (c prev) #:lines (fold (lambda (c lines)
(+ prev (credit-height c))) (+ lines (credit-lines c)))
0 credits) 0 credits)
#:draw #:draw
(lambda (top) (lambda (top)
(do ((i 0 (1+ i)) (fold (lambda (c y)
(y top (+ y (* (credit-height (list-ref credits i)) ((credit-draw c) y)
(line-height))))) (+ y (* (credit-lines c) (line-height))))
((= i (length credits))) top 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) (define (make-credit-text text)
(make-credit (make-credit
#:height 1
#:draw #:draw
(lambda (y) (lambda (y)
(set-fill-color! context "#fff") (set-fill-color! context "#fff")
@ -462,8 +445,7 @@
(define (make-credit-underline text) (define (make-credit-underline text)
(make-credit-group (make-credit-group
(make-credit-text text) (make-credit-text text)
(make-credit-text (make-string (string-length text) (make-credit-text (make-string (string-length text) #\-))))
#\-))))
(define credits (define credits
(vector (make-credit-group (vector (make-credit-group
@ -472,8 +454,7 @@
(make-credit-group (make-credit-group
(make-credit-text "Cirkoban was made by the") (make-credit-text "Cirkoban was made by the")
(make-credit-text "Spritely Institute")) (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-group
(make-credit-underline "Game Design") (make-credit-underline "Game Design")
(make-credit-text "Christine Lemmer-Webber")) (make-credit-text "Christine Lemmer-Webber"))
@ -497,27 +478,66 @@
(make-credit-group (make-credit-group
(make-credit-underline "Other") (make-credit-underline "Other")
(make-credit-text "monogram font by datagoblin")) (make-credit-text "monogram font by datagoblin"))
(make-credit-space 4) (make-credit #:lines 4)
(make-credit-text "Thank you for playing!"))) (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) (define (draw-credits)
(draw-level) (draw-level)
(let ((height (lambda (c) (let lp ((i (credits-first-visible-index))
(+ (* (credit-height c) (line-height)) (y (credits-top)))
credits-margin))) (when (and (< i (vector-length credits))
(i 0) (<= y credits-start))
(y *credits-top*)) (let* ((c (vector-ref credits i)))
;; Ignore credits that are higher than the top of the game ((credit-draw c) y)
(while (and (< i (vector-length credits)) (lp (1+ i) (+ y (credit-height c)))))))
(< y (- (height (vector-ref credits i))) credits-end))
(set! y (+ y (height (vector-ref credits i)))) (define (load-credits!)
(set! i (1+ i))) (replace-game-state! 'credits)
;; Draw credits that are higher than the bottom of the game (set! *actormap* (make-whactormap))
(while (and (< i (vector-length credits)) (<= y credits-start)) (clear-snapshots!)
((credit-draw (vector-ref credits i)) y) (with-goblins
(set! y (+ y (height (vector-ref credits i)))) (set! *level* (load-credits #f))
(set! i (1+ i)))) (update-objects!))
(set! *credits-top* (- *credits-top* (/ (line-height) credits-speed)))) ;; 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!) (define (reset-game!)
(run-script (run-script