summaryrefslogtreecommitdiff
path: root/test-subject
diff options
context:
space:
mode:
authorDavid Thompson <dthompson@vistahigherlearning.com>2021-05-04 08:26:53 -0400
committerDavid Thompson <dthompson@vistahigherlearning.com>2021-05-04 08:31:06 -0400
commit234e2e23b0e977ff9fed415846e9796332cb0759 (patch)
tree1e4aee670d7212ca1c19fe141ad7691b4d3d3ffa /test-subject
parent6983a70c175659ca48df89bc4282c068d09ab430 (diff)
Factor out splash screen and credits sequence into their own scenes.
Diffstat (limited to 'test-subject')
-rw-r--r--test-subject/assets.scm14
-rw-r--r--test-subject/common.scm24
-rw-r--r--test-subject/credits.scm64
-rw-r--r--test-subject/game.scm140
-rw-r--r--test-subject/splash.scm49
5 files changed, 178 insertions, 113 deletions
diff --git a/test-subject/assets.scm b/test-subject/assets.scm
index 68d3101..e3604a5 100644
--- a/test-subject/assets.scm
+++ b/test-subject/assets.scm
@@ -25,7 +25,10 @@
key-press-sound
device-sound
gameplay-music
- credits-music))
+ credits-music
+ play-click-sound
+ play-key-press-sound
+ play-device-sound))
(define (scope-datadir file-name)
(let ((prefix (or (getenv "TEST_SUBJECT_DATADIR") (getcwd))))
@@ -54,3 +57,12 @@
(define-asset device-sound (load-audio (scope-datadir "assets/sounds/switch38.wav")))
(define-asset gameplay-music (load-audio (scope-datadir "assets/sounds/ambientmain_0.ogg") #:mode 'stream))
(define-asset credits-music (load-audio (scope-datadir "assets/sounds/end-theme.mp3") #:mode 'stream))
+
+(define (play-click-sound)
+ (audio-play (asset-ref click-sound)))
+
+(define (play-key-press-sound)
+ (audio-play (asset-ref key-press-sound)))
+
+(define (play-device-sound)
+ (audio-play (asset-ref device-sound)))
diff --git a/test-subject/common.scm b/test-subject/common.scm
new file mode 100644
index 0000000..9e756b3
--- /dev/null
+++ b/test-subject/common.scm
@@ -0,0 +1,24 @@
+(define-module (test-subject common)
+ #:use-module (chickadee graphics color)
+ #:use-module (chickadee graphics viewport)
+ #:use-module (chickadee math vector)
+ #:use-module (oop goops)
+ #:use-module (starling node-2d)
+ #:use-module (starling scene)
+ #:export (%window-width
+ %window-height
+ %game-width
+ %game-height
+ set-cameras!))
+
+(define %window-width 1280)
+(define %window-height 720)
+(define %game-width 640)
+(define %game-height 360)
+
+(define-method (set-cameras! (scene <scene-2d>))
+ (set! (cameras scene)
+ (list (make <camera-2d>
+ #:resolution (vec2 %game-width %game-height)
+ #:viewport (make-viewport 0 0 %window-width %window-height
+ #:clear-color black)))))
diff --git a/test-subject/credits.scm b/test-subject/credits.scm
new file mode 100644
index 0000000..98c9257
--- /dev/null
+++ b/test-subject/credits.scm
@@ -0,0 +1,64 @@
+(define-module (test-subject credits)
+ #:use-module (chickadee graphics color)
+ #:use-module (chickadee math vector)
+ #:use-module (chickadee scripting)
+ #:use-module (oop goops)
+ #:use-module (starling kernel)
+ #:use-module (starling node)
+ #:use-module (starling node-2d)
+ #:use-module (starling scene)
+ #:use-module (test-subject assets)
+ #:use-module (test-subject common)
+ #:export (<credits>))
+
+(define-class <credits> (<scene-2d>)
+ (true-ending? #:getter true-ending? #:init-keyword #:true-ending?
+ #:init-value #f)
+ (click-channel #:getter click-channel #:init-thunk make-channel))
+
+(define-method (on-boot (credits <credits>))
+ (set-cameras! credits)
+ (attach-to credits
+ (make <sprite>
+ #:name 'background
+ #:texture lightness)
+ (make <label>
+ #:name 'label
+ #:font monogram-font
+ #:color black
+ #:align 'center
+ #:vertical-align 'center
+ #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0)))))
+
+(define-method (on-enter (credits <credits>))
+ (define* (credit line #:optional (sleep? #t))
+ (set! (text (& credits label)) line)
+ (when sleep? (sleep 120)))
+ (run-script credits
+ (set! (background-music credits) credits-music)
+ (set! (background-music-loop? credits) #f)
+ (sleep 60)
+ (credit "The Test Subject")
+ (credit "developed by David Thompson (GPLv3) https://dthompson.us")
+ (credit "made for the Spring Lisp Game Jam 2021 https://itch.io/jam/spring-lisp-game-jam-2021")
+ (credit "monogram font by datagoblin (CC0) https://datagoblin.itch.io/monogram")
+ (credit "old fax font by George Blackwell (CC-BY 4.0) https://georgeblackwell.itch.io/old-fax")
+ (credit "UI sounds by Kenney (CC0) https://opengameart.org/content/51-ui-sound-effects-buttons-switches-and-clicks")
+ (credit "background music by brandon75689 (CC0) https://opengameart.org/content/tragic-ambient-main-menu")
+ (credit "credits music by tcarisland (CC-BY 4.0) https://opengameart.org/content/the-end")
+ (if (true-ending? credits)
+ (credit "congratulations on reaching the true ending!")
+ (credit "the true ending still awaits you..."))
+ (credit "click to play again" #f)
+ (channel-clear! (click-channel credits))
+ (channel-get (click-channel credits))
+ (play-click-sound)
+ (tween 120 white black
+ (lambda (color)
+ (set! (tint (& credits background)) color))
+ #:interpolate color-lerp)
+ (pop-scene (current-kernel))))
+
+(define-method (on-mouse-release (credits <credits>) button x y)
+ (when (eq? button 'left)
+ (channel-put! (click-channel credits) #t)))
diff --git a/test-subject/game.scm b/test-subject/game.scm
index 0540215..b7dc1af 100644
--- a/test-subject/game.scm
+++ b/test-subject/game.scm
@@ -17,15 +17,13 @@
#:use-module (starling ring-buffer)
#:use-module (starling scene)
#:use-module (test-subject assets)
+ #:use-module (test-subject common)
+ #:use-module (test-subject credits)
#:use-module (test-subject device)
#:use-module (test-subject text-box)
#:duplicates (merge-generics replace warn-override-core warn last)
- #:export (launch-game))
+ #:export (<game>))
-(define window-width 1280)
-(define window-height 720)
-(define game-width 640)
-(define game-height 360)
(define player-display-name "")
(define-theme gui-theme
@@ -56,16 +54,8 @@
"The Wiremind"
"??????"))
-(define (play-click-sound)
- (audio-play (asset-ref click-sound)))
-
-(define (play-key-press-sound)
- (audio-play (asset-ref key-press-sound)))
-
-(define (play-device-sound)
- (audio-play (asset-ref device-sound)))
-
(define-method (reset-game (game <game>))
+ (detach-all game)
(set! (background-music game) #f)
(set! (subject-name-known? game) #f)
(set! (has-fridge-key? game) #f)
@@ -105,6 +95,7 @@
(match choices
(()
(set! (state game) 'dialog)
+ (channel-clear! (click-channel game))
(channel-get (click-channel game))
(play-click-sound)
(detach c)
@@ -118,7 +109,7 @@
(make <vertical-container>
#:name 'choices
#:rank 9
- #:position (vec2 (/ game-width 4.0)
+ #:position (vec2 (/ %game-width 4.0)
76.0)
#:children
(map (match-lambda
@@ -127,7 +118,7 @@
#:margin 2.0
#:children
(list (make <button>
- #:width (/ game-width 2.0)
+ #:width (/ %game-width 2.0)
#:height 24.0
#:text str
#:listeners
@@ -150,31 +141,6 @@
(define-method (increment-friendship (game <game>))
(set! (friendship game) (+ (friendship game) 1)))
-(define-method (splash (game <game>))
- (set! (state game) 'splash)
- (attach-to game
- (make <sprite>
- #:name 'intro-lightness
- #:texture lightness)
- (make <label>
- #:name 'intro-splash
- #:font monogram-font
- #:color black
- #:align 'center
- #:vertical-align 'center
- #:position (vec2 (/ game-width 2.0) (/ game-height 2.0))))
- (set! (text (& game intro-splash)) "Nonexistent Game Studio sheepishly presents")
- (sleep 120)
- (set! (text (& game intro-splash)) "The Test Subject - A Spring Lisp Game Jam 2021 submission")
- (sleep 120)
- (tween 120 white black
- (lambda (color)
- (set! (tint (& game intro-lightness)) color))
- #:interpolate color-lerp)
- (detach (& game intro-lightness)
- (& game intro-splash))
- (intro game))
-
(define-method (intro (game <game>))
(set! (state game) 'intro)
(attach-to game
@@ -247,9 +213,9 @@
(make <vertical-container>
#:name 'pin-pad
#:rank 9
- #:position (vec2 (- (/ game-width 2.0)
+ #:position (vec2 (- (/ %game-width 2.0)
(/ (* 5.0 32.0) 2.0))
- (- (/ game-height 2.0)
+ (- (/ %game-height 2.0)
(/ (* 3.0 32.0) 2.0)))
#:children
(list (make <margin-container>
@@ -665,13 +631,13 @@ diz--"))
#:font old-fax-font
#:text (car pages)
#:color black
- #:position (vec2 (+ (/ game-width 4.0) 2.0)
- (- game-height
+ #:position (vec2 (+ (/ %game-width 4.0) 2.0)
+ (- %game-height
(font-line-height
(asset-ref old-fax-font)))))
(make <horizontal-container>
#:name 'buttons
- #:position (vec2 (- (/ game-width 2.0)
+ #:position (vec2 (- (/ %game-width 2.0)
(/ (+ 70.0 32.0 32.0)
2.0))
0.0)
@@ -966,6 +932,11 @@ if you would just open the door.")
(set! (background-music-loop? game) #t)
(fade-in))
+(define-method (roll-credits (game <game>))
+ (set! (first-playthrough? game) #f)
+ (push-scene (current-kernel)
+ (make <credits> #:true-ending? (>= (friendship game) 3))))
+
(define-method (good-ending (game <game>))
(set! (state game) 'good-ending)
(attach-to game
@@ -982,8 +953,7 @@ if you would just open the door.")
(dialog game player-display-name "> The footsteps resume. They grow quieter... eventually it is silent.")
(dialog game player-display-name "> You breathe deeply, pick up your notebook, and head for the exit.")
(sleep 60)
- (detach-all game)
- (credits game))
+ (roll-credits game))
(define-method (bad-ending-1 (game <game>))
(set! (state game) 'bad-ending-1)
@@ -1002,8 +972,7 @@ if you would just open the door.")
(dialog game (subject-name game) "You did the right thing, in the end. For that I am grateful.")
(dialog game (subject-name game) "You won't feel a thing. The rest won't be so lucky.")
(sleep 10)
- (detach-all game)
- (credits game))
+ (roll-credits game))
(define-method (bad-ending-2 (game <game>))
(set! (state game) 'bad-ending-1)
@@ -1031,64 +1000,17 @@ time?")
"I guess it's game over for you.")
(dialog game player-display-name
"> You collapse onto the floor, struggling to breathe...")
- (detach-all game)
- (credits game))
-
-(define-method (credits (game <game>))
- (define (credit line)
- (set! (text (& game credits)) line)
- (sleep 120))
- (set! (state game) 'credits)
- (set! (background-music game) credits-music)
- (set! (background-music-loop? game) #f)
- (attach-to game
- (make <sprite>
- #:name 'background
- #:texture lightness)
- (make <label>
- #:name 'credits
- #:font monogram-font
- #:color black
- #:align 'center
- #:vertical-align 'center
- #:position (vec2 (/ game-width 2.0) (/ game-height 2.0))))
- (sleep 60)
- (credit "The Test Subject")
- (credit "developed by David Thompson (GPLv3) https://dthompson.us")
- (credit "made for the Spring Lisp Game Jam 2021 https://itch.io/jam/spring-lisp-game-jam-2021")
- (credit "monogram font by datagoblin (CC0) https://datagoblin.itch.io/monogram")
- (credit "old fax font by George Blackwell (CC-BY 4.0) https://georgeblackwell.itch.io/old-fax")
- (credit "UI sounds by Kenney (CC0) https://opengameart.org/content/51-ui-sound-effects-buttons-switches-and-clicks")
- (credit "background music by brandon75689 (CC0) https://opengameart.org/content/tragic-ambient-main-menu")
- (credit "credits music by tcarisland (CC-BY 4.0) https://opengameart.org/content/the-end")
- (if (>= (friendship game) 3)
- (credit "congratulations on reaching the true ending!")
- (credit "the true ending still awaits you..."))
- (credit "click to play again")
- (set! (first-playthrough? game) #f)
- (channel-get (click-channel game))
- (play-click-sound)
- (tween 120 white black
- (lambda (color)
- (set! (tint (& game background)) color))
- #:interpolate color-lerp)
- (detach-all game)
- (reset-game game)
- (intro game))
+ (roll-credits game))
(define-method (on-boot (game <game>))
- (set! (cameras game)
- (list (make <camera-2d>
- #:resolution (vec2 game-width game-height)
- #:viewport (make-viewport 0 0 window-width window-height
- #:clear-color black))))
+ (set-cameras! game)
;; Dialog nodes.
(parameterize ((current-theme gui-theme))
(set! (dialog-container game)
(make <vertical-container>
#:name 'dialog-container
#:rank 999
- #:position (vec2 (/ (* game-width .25) 2.0) 0.0)
+ #:position (vec2 (/ (* %game-width .25) 2.0) 0.0)
#:children
(list (make <margin-container>
#:name 'name-margin
@@ -1099,10 +1021,12 @@ time?")
#:font monogram-font)))
(make <text-box>
#:name 'text-box
- #:width (round (* game-width .75))
- #:height 60.0)))))
+ #:width (round (* %game-width .75))
+ #:height 60.0))))))
+
+(define-method (on-enter (game <game>))
(run-script game
- (splash game)))
+ (intro game)))
(define-method (on-mouse-move (game <game>) x y x-rel y-rel buttons)
(case (state game)
@@ -1113,7 +1037,7 @@ time?")
(define-method (on-mouse-release (game <game>) button x y)
(case (state game)
- ((dialog credits)
+ ((dialog)
(when (eq? button 'left)
(channel-put! (click-channel game) #t)))
((terminal)
@@ -1135,11 +1059,3 @@ time?")
(case (state game)
((terminal)
(channel-put! (terminal-channel game) text))))
-
-(define (launch-game)
- (boot-kernel (make <kernel>
- #:window-config (make <window-config>
- #:title "The Test Subject - Spring Lisp Game Jam 2021"
- #:width window-width
- #:height window-height))
- (lambda () (make <game>))))
diff --git a/test-subject/splash.scm b/test-subject/splash.scm
new file mode 100644
index 0000000..f014807
--- /dev/null
+++ b/test-subject/splash.scm
@@ -0,0 +1,49 @@
+(define-module (test-subject splash)
+ #:use-module (chickadee graphics color)
+ #:use-module (chickadee math vector)
+ #:use-module (chickadee scripting)
+ #:use-module (oop goops)
+ #:use-module (starling kernel)
+ #:use-module (starling node)
+ #:use-module (starling node-2d)
+ #:use-module (starling scene)
+ #:use-module (test-subject assets)
+ #:use-module (test-subject common)
+ #:use-module (test-subject game)
+ #:export (launch-game))
+
+(define-class <splash> (<scene-2d>))
+
+(define-method (on-boot (splash <splash>))
+ (set-cameras! splash)
+ (attach-to splash
+ (make <sprite>
+ #:name 'background
+ #:texture lightness)
+ (make <label>
+ #:name 'label
+ #:font monogram-font
+ #:color black
+ #:align 'center
+ #:vertical-align 'center
+ #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0)))))
+
+(define-method (on-enter (splash <splash>))
+ (run-script splash
+ (set! (text (& splash label)) "Nonexistent Game Studio sheepishly presents")
+ (sleep 120)
+ (set! (text (& splash label)) "The Test Subject - A Spring Lisp Game Jam 2021 submission")
+ (sleep 120)
+ (tween 120 white black
+ (lambda (color)
+ (set! (tint (& splash background)) color))
+ #:interpolate color-lerp)
+ (replace-scene (current-kernel) (make <game>))))
+
+(define (launch-game)
+ (boot-kernel (make <kernel>
+ #:window-config (make <window-config>
+ #:title "The Test Subject - Spring Lisp Game Jam 2021"
+ #:width %window-width
+ #:height %window-height))
+ (lambda () (make <splash>))))