Created update script in 'load-credits'
This commit is contained in:
parent
afef0fd480
commit
2870a88536
1 changed files with 82 additions and 62 deletions
144
game.scm
144
game.scm
|
@ -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
|
||||||
|
|
Loading…
Add table
Reference in a new issue