diff options
Diffstat (limited to 'bonnie-bee/game.scm')
| -rw-r--r-- | bonnie-bee/game.scm | 791 |
1 files changed, 447 insertions, 344 deletions
diff --git a/bonnie-bee/game.scm b/bonnie-bee/game.scm index 18b177b..40d5cb6 100644 --- a/bonnie-bee/game.scm +++ b/bonnie-bee/game.scm @@ -20,12 +20,20 @@ #:use-module (chickadee math vector) #:use-module (chickadee scripting) #:use-module (oop goops) - #:use-module (starling asset) - #:use-module (starling kernel) - #:use-module (starling node) - #:use-module (starling node-2d) - #:use-module (starling scene) - #:export (<game>)) + #:use-module (catbird) + #:use-module (catbird asset) + #:use-module (catbird kernel) + #:use-module (catbird observer) + #:use-module (catbird mode) + #:use-module (catbird node) + #:use-module (catbird node-2d) + #:use-module (catbird scene) + #:export (make-game-scene)) + + +;;; +;;; Shadow label +;;; (define %text-color (rgb #xfee761)) @@ -37,7 +45,7 @@ (make <label> #:name 'shadow #:position (vec2 0.0 1.0) - #:font (font label) + #:font (slot-ref label 'font) #:text (text label) #:color (color label))) (set! (color label) black)) @@ -46,79 +54,83 @@ (next-method) (case slot-name ((text) - (set! (text (& label shadow)) new))) ) + (set! (text (& label shadow)) new)))) -(define %game-bounds (make-rect 0.0 0.0 %game-width %game-height)) + +;;; +;;; Heads-up display +;;; -(define-class <game> (<scene-2d>) - (state #:accessor state #:init-value 'play) - (quadtree #:getter quadtree #:init-form (make-quadtree %game-bounds)) - (scroll-speed #:getter scroll-speed #:init-value 0.0) +(define-class <hud> (<node-2d>) (last-lives #:accessor last-lives #:init-value 0) (last-pollen #:accessor last-pollen #:init-value 0) - (last-score #:accessor last-score #:init-value 0) - (music-source #:getter music-source #:init-form (make-source #:loop? #t))) - -(define-method (change-scroll-speed (game <game>) speed) - (slot-set! game 'scroll-speed speed)) - -(define-method (spawn (game <game>) (actor <actor>)) - (set! (quadtree actor) (quadtree game)) - (quadtree-insert! (quadtree game) (world-hitbox actor) actor) - (attach-to game actor)) - -(define-method (player (game <game>)) - (& game player)) - -(define-method (bullets (game <game>)) - (& game bullets)) - -(define-method (particles (game <game>)) - (& game particles)) + (last-score #:accessor last-score #:init-value 0)) -(define-method (on-boot (game <game>)) - (set! *random-state* (random-state-from-platform)) - (set-cameras! game) - (attach-to game - (make <background> - #:name 'background - #:texture background-image) - (make <particles> - #:name 'particles - #:particles (make-particles 2048 - #:texture (asset-ref particle-image) - #:end-color (make-color 1.0 1.0 1.0 0.0))) - (make <bullets> - #:name 'bullets - #:rank 4 - #:quadtree (quadtree game)) +(define-method (on-boot (hud <hud>)) + (attach-to hud (make <shadow-label> - #:name 'hud-lives - #:rank 5 + #:name 'lives #:position (vec2 2.0 2.0) #:font monogram-font #:text "lives 0" #:color %text-color) (make <shadow-label> - #:name 'hud-pollen - #:rank 5 + #:name 'pollen #:position (vec2 (/ %game-width 2.0) 2.0) #:font monogram-font #:text "pollen 0" #:align 'center #:color %text-color) (make <shadow-label> - #:name 'hud-score - #:rank 5 + #:name 'score #:position (vec2 (- %game-width 2.0) 2.0) #:font monogram-font #:text "score 0" #:align 'right #:color %text-color))) -(define-method (play-music (game <game>) music-asset) - (set-source-audio! (music-source game) (asset-ref music-asset)) - (source-play (music-source game))) +(define-method (update (hud <hud>) dt) + (let ((p (& (parent hud) player))) + (when (not (= (last-lives hud) (lives p))) + (set! (text (& hud lives)) + (string-append "lives " (number->string (lives p))))) + (when (not (= (last-pollen hud) (pollen p))) + (let ((n (pollen p))) + (set! (text (& hud pollen)) + (string-append "pollen " + (if (= n %max-pollen) "MAX" (number->string n)))))) + (when (not (= (last-score hud) (score p))) + (set! (text (& hud score)) + (string-append "score " (number->string (score p))))) + (set! (last-lives hud) (lives p)) + (set! (last-pollen hud) (pollen p)) + (set! (last-score hud) (score p)))) + + +;;; +;;; Game scene +;;; + +(define %game-bounds (make-rect 0.0 0.0 %game-width %game-height)) +(define %default-player-position (vec2 (/ %game-width 2.0) 20.0)) + +(define-class <game-scene> (<scene>) + (quadtree #:getter quadtree #:init-form (make-quadtree %game-bounds)) + (scroll-speed #:getter scroll-speed #:init-value 0.0) + (music-source #:getter music-source #:init-form (make-source #:loop? #t)) + (intro-script #:accessor intro-script #:init-value #f)) + +(define-method (change-scroll-speed (scene <game-scene>) speed) + (slot-set! scene 'scroll-speed speed)) + +(define-method (spawn (scene <game-scene>) (actor <actor>)) + (set! (quadtree actor) (quadtree scene)) + (quadtree-insert! (quadtree scene) (world-hitbox actor) actor) + (attach-to scene actor)) + +(define-method (play-music (scene <game-scene>) music-asset) + (set-source-audio! (music-source scene) (artifact music-asset)) + (source-play (music-source scene))) (define* (make-turret p #:key (interval 0.5) (speed 1.0)) (let ((turret (make <turret> @@ -130,11 +142,11 @@ (run-script turret (sleep (steps 1)) (forever - (let ((theta (+ (angle-to turret (player (parent turret))) + (let ((theta (+ (angle-to turret (& (parent turret) player)) (* (- (* (random:uniform) 2.0) 1.0) 0.2))) (speed 1.5)) - (audio-play (asset-ref enemy-shoot-sound)) - (add-bullet (bullets (parent turret)) + (audio-play (artifact enemy-shoot-sound)) + (add-bullet (& (parent turret) bullets) medium-enemy-bullet (position turret) (vec2 (* (cos theta) speed) @@ -168,11 +180,14 @@ #:health 20 #:points 1000)) -(define-method (change-state (game <game>) new-state) - (set! (state game) new-state)) +(define-method (skip-intro (scene <game-scene>)) + (teleport (& scene player) + (vec2-x %default-player-position) + (vec2-y %default-player-position)) + (cancel-script (intro-script scene))) -(define-method (run-level (game <game>)) - (define (tutorial message key) +(define-method (run-level (scene <game-scene>)) + (define (tutorial message continue?) (let ((l (make <shadow-label> #:name 'tutorial #:rank 5 @@ -181,160 +196,196 @@ #:text message #:align 'center #:color %text-color))) - (attach-to game l) - (if key - (wait-until (key-pressed? key)) + (attach-to scene l) + (if continue? + (begin + (wait-until (continue?)) + (sleep 1.0)) (sleep 2.0)) (detach l))) - (run-script game - (fade-in game 1.0)) - (run-script game - (unless (getenv "SKIP_INTRO") - ;; Intro - (let ((popcorn (make-popcorn (vec2 (/ %game-width 2.0) (+ %game-height 16.0)))) - (bullet-speed 5.0) - (flower-1 (make-flower (vec2 194.0 210.0))) - (flower-2 (make-flower (vec2 50.0 206.0))) - (flower-3 (make-flower (vec2 280.0 201.0))) - (flower-4 (make-flower (vec2 121.0 197.0))) - (flower-5 (make-flower (vec2 58.0 134.0))) - (flower-6 (make-flower (vec2 145.0 135.0))) - (flower-7 (make-flower (vec2 220.0 151.0))) - (flower-8 (make-flower (vec2 290.0 129.0)))) - (define (shoot-at flower) - (add-bullet (bullets game) - medium-enemy-bullet - (position popcorn) - (vec2* (direction-to popcorn flower) bullet-speed))) - (change-state game 'intro) - (spawn game flower-1) - (spawn game flower-2) - (spawn game flower-3) - (spawn game flower-4) - (spawn game flower-5) - (spawn game flower-6) - (spawn game flower-7) - (spawn game flower-8) - (spawn game (make-flower (vec2 194.0 95.0))) - (spawn game (make-flower (vec2 102.0 82.0))) - (spawn game (make-flower (vec2 247.0 45.0))) - (spawn game (make-flower (vec2 159.0 40.0))) - (spawn game (make-flower (vec2 73.0 28.0))) - (teleport (player game) 159.0 40.0) - (play-music game intro-music) - (sleep 1.0) - (audio-play (asset-ref pollen-release-sound)) - (sleep 0.6) - (move-to (player game) 247.0 45.0 1.0) - (sleep 0.2) - (audio-play (asset-ref pollen-release-sound)) - (sleep 0.6) - (move-to (player game) 102.0 76.0 1.0) - (sleep 0.2) - (audio-play (asset-ref pollen-release-sound)) - (sleep 2.0) - (run-script game - (tween 1.0 1.0 0.0 - (lambda (volume) - (set-source-volume! (music-source game) volume)))) - (source-stop (music-source game)) - (spawn game popcorn) - (change-velocity popcorn 0.0 -1.0) - (tween 2.4 -1.0 0.0 - (lambda (dy) - (change-velocity popcorn 0.0 dy))) - (shoot-at flower-1) - (sleep 0.3) - (shoot-at flower-2) - (sleep 0.3) - (shoot-at flower-3) - (sleep 0.3) - (shoot-at flower-4) - (sleep 0.3) - (shoot-at flower-8) - (sleep 0.3) - (shoot-at flower-7) - (sleep 0.3) - (shoot-at flower-6) - (sleep 0.3) - (shoot-at flower-5) - (sleep 1.0) - (audio-play (asset-ref hehehe-sound)) - (sleep 1.0) - (tween 0.5 0.0 1.5 - (lambda (dy) - (change-velocity popcorn 0.0 dy))) - (sleep 1.0))) + (run-script scene + (fade-in scene 1.0)) + (run-script scene + (set! (scoring-enabled? (& scene player)) #f) + (set! (intro-script scene) + (run-script scene + ;; Intro + (let ((popcorn (make-popcorn (vec2 (/ %game-width 2.0) (+ %game-height 16.0)))) + (bullet-speed 5.0) + (flower-1 (make-flower (vec2 194.0 210.0))) + (flower-2 (make-flower (vec2 50.0 206.0))) + (flower-3 (make-flower (vec2 280.0 201.0))) + (flower-4 (make-flower (vec2 121.0 197.0))) + (flower-5 (make-flower (vec2 58.0 134.0))) + (flower-6 (make-flower (vec2 145.0 135.0))) + (flower-7 (make-flower (vec2 220.0 151.0))) + (flower-8 (make-flower (vec2 290.0 129.0)))) + (define (shoot-at flower) + (add-bullet (& scene bullets) + medium-enemy-bullet + (position popcorn) + (vec2* (direction-to popcorn flower) bullet-speed))) + (spawn scene flower-1) + (spawn scene flower-2) + (spawn scene flower-3) + (spawn scene flower-4) + (spawn scene flower-5) + (spawn scene flower-6) + (spawn scene flower-7) + (spawn scene flower-8) + (spawn scene (make-flower (vec2 194.0 95.0))) + (spawn scene (make-flower (vec2 102.0 82.0))) + (spawn scene (make-flower (vec2 247.0 45.0))) + (spawn scene (make-flower (vec2 159.0 40.0))) + (spawn scene (make-flower (vec2 73.0 28.0))) + (teleport (& scene player) 159.0 40.0) + (play-music scene intro-music) + (sleep 1.0) + (audio-play (artifact pollen-release-sound)) + (sleep 0.6) + (move-to (& scene player) 247.0 45.0 1.0) + (sleep 0.2) + (audio-play (artifact pollen-release-sound)) + (sleep 0.6) + (move-to (& scene player) 102.0 76.0 1.0) + (sleep 0.2) + (audio-play (artifact pollen-release-sound)) + (sleep 2.0) + (run-script scene + (tween 1.0 1.0 0.0 + (lambda (volume) + (set-source-volume! (music-source scene) volume)))) + (source-stop (music-source scene)) + (spawn scene popcorn) + (change-velocity popcorn 0.0 -1.0) + (tween 2.4 -1.0 0.0 + (lambda (dy) + (change-velocity popcorn 0.0 dy))) + (shoot-at flower-1) + (sleep 0.3) + (shoot-at flower-2) + (sleep 0.3) + (shoot-at flower-3) + (sleep 0.3) + (shoot-at flower-4) + (sleep 0.3) + (shoot-at flower-8) + (sleep 0.3) + (shoot-at flower-7) + (sleep 0.3) + (shoot-at flower-6) + (sleep 0.3) + (shoot-at flower-5) + (sleep 1.0) + (audio-play (artifact hehehe-sound)) + (sleep 1.0) + (tween 0.5 0.0 1.5 + (lambda (dy) + (change-velocity popcorn 0.0 dy))) + (sleep 1.0) + (enable-pollen!) + (replace-major-mode scene (make <play-mode>)) + (play-music scene main-music) + (set-source-volume! (music-source scene) 1.0) + ;; Tutorial + (tutorial "move with ARROW keys or controller DPAD" + (lambda () + (moving? (& scene player)))) + (tutorial "press Z key or A button to shoot" + (lambda () + (shoot? (& scene player)))) + (sleep 2.0) + (tutorial "shoot FLOWERS and collect POLLEN for special power" #f) + (tutorial "press X key or B button to unleash stored power" + (lambda () + (let ((p (& scene player))) + (or (bombing? p) + ;; Ensure bomb can be used to avoid a soft lock. + (begin + (unless (= (pollen p) %max-pollen) + (set! (pollen p) %max-pollen)) + #f))))) + (tutorial "godspeed you, little bee!" #f)))) + (join (intro-script scene)) + (set! (intro-script scene) #f) + ;; The intro and tutorial sequence set up a bunch of state, but if + ;; the player skips it, we need to set it up here. Each of the + ;; following operations may be no-ops, depending on how far into + ;; the intro the player was before they skipped it. (enable-pollen!) - (change-state game 'play) - (play-music game main-music) - (set-source-volume! (music-source game) 1.0) - (unless (getenv "SKIP_TUTORIAL") - ;; Tutorial - (tutorial "move with ARROW keys" #f) - (tutorial "press Z to shoot" 'z) - (sleep 2.0) - (tutorial "shoot FLOWERS and collect POLLEN for special power" #f) - (tutorial "press X to unleash stored power" 'x) - (tutorial "godspeed you, little bee!" #f)) - (change-scroll-speed game 15.0) + (unless (is-a? (major-mode scene) <play-mode>) + (replace-major-mode scene (make <play-mode>))) + (play-music scene main-music) + (set-source-volume! (music-source scene) 1.0) + (set! (pollen (& scene player)) 0) + (and=> (& scene tutorial) detach) + (clear-bullets (& scene bullets)) + (for-each-child (lambda (child) + (when (and (is-a? child <actor>) + (not (is-a? child <player>))) + (detach child))) + scene) + ;; Start the game + (set! (scoring-enabled? (& scene player)) #t) + (change-scroll-speed scene 15.0) + (sleep 1.0) ;; Wave 1 (define* (popcorn-line n spawn-point velocity delay #:optional script) (let loop ((i 0)) (when (< i n) (let ((popcorn (make-popcorn (vec2-copy spawn-point) velocity))) - (spawn game popcorn) + (spawn scene popcorn) (when script (run-script popcorn (script popcorn)))) (sleep delay) (loop (+ i 1))))) (define (spawn-flower x) - (spawn game (make-flower (vec2 x (+ %game-height 32.0))))) + (spawn scene (make-flower (vec2 x (+ %game-height 32.0))))) (unless (getenv "SKIP_WAVE1") - (spawn game (make-flower (vec2 (- %game-width 64.0) (+ %game-height 32.0)))) + (spawn scene (make-flower (vec2 (- %game-width 64.0) (+ %game-height 32.0)))) (popcorn-line 5 (vec2 64.0 (+ %game-height 16.0)) (vec2 0.0 -2.0) 0.2) (sleep 0.5) (popcorn-line 5 (vec2 (- %game-width 64.0) (+ %game-height 16.0)) (vec2 0.0 -2.0) 0.2) (sleep 0.5) - (spawn game (make-flower (vec2 64.0 (+ %game-height 32.0)))) + (spawn scene (make-flower (vec2 64.0 (+ %game-height 32.0)))) (popcorn-line 5 (vec2 (/ %game-width 2.0) (+ %game-height 16.0)) (vec2 0.0 -2.0) 0.2) (sleep 1.0) - (run-script game + (run-script scene (popcorn-line 10 (vec2 -16.0 220.0) (vec2 3.0 -0.5) 0.2)) (popcorn-line 10 (vec2 (+ %game-width 16.0) 200.0) (vec2 -3.0 -0.5) 0.2) - (spawn game (make-flower (vec2 (/ %game-width 2.0) (+ %game-height 32.0)))) + (spawn scene (make-flower (vec2 (/ %game-width 2.0) (+ %game-height 32.0)))) (sleep 1.0) - (run-script game + (run-script scene (popcorn-line 30 (vec2 -16.0 220.0) (vec2 2.0 -2.0) 0.2)) - (run-script game + (run-script scene (popcorn-line 30 (vec2 (+ %game-width 16.0) 220.0) (vec2 -2.0 -2.0) 0.2)) - (spawn game (make-flower (vec2 128.0 (+ %game-height 32.0)))) + (spawn scene (make-flower (vec2 128.0 (+ %game-height 32.0)))) (sleep 2.0) - (run-script game + (run-script scene (popcorn-line 20 (vec2 -16.0 20.0) (vec2 2.0 2.0) 0.2)) - (spawn game (make-flower (vec2 256.0 (+ %game-height 32.0)))) + (spawn scene (make-flower (vec2 256.0 (+ %game-height 32.0)))) (popcorn-line 20 (vec2 (+ %game-width 16.0) 20.0) (vec2 -2.0 2.0) 0.2) (sleep 3.0)) ;; Wave 2 (define (spawn-turret x) - (spawn game (make-turret (vec2 x (+ %game-height 32.0))))) + (spawn scene (make-turret (vec2 x (+ %game-height 32.0))))) (define (shoot-down enemy) (sleep 0.2) (repeat 10 - (add-bullet (bullets game) - medium-enemy-bullet - (position enemy) - (vec2 0.0 -2.0)) - (sleep 0.1))) + (add-bullet (& scene bullets) + medium-enemy-bullet + (position enemy) + (vec2 0.0 -2.0)) + (sleep 0.1))) (unless (getenv "SKIP_WAVE2") (popcorn-line 10 (vec2 (+ %game-width 16.0) 200.0) (vec2 -3.0 -0.5) 0.2) @@ -409,7 +460,7 @@ (popcorn-line 10 (vec2 (+ %game-width 16.0) 200.0) (vec2 -3.0 -0.5) 0.2) (sleep 1.0) - (run-script game + (run-script scene (spawn-turret (* %game-width 0.25)) (sleep 2.0) (spawn-turret (* %game-width 0.75)) @@ -425,14 +476,14 @@ (- (random:uniform) 0.5))) (+ %game-height 16.0)) (vec2 0.0 -2.0)))) - (spawn game popcorn) + (spawn scene popcorn) (run-script popcorn (sleep 0.5) (tween 0.5 -2.0 0.0 (lambda (dy) (change-velocity popcorn 0.0 dy))) (let ((d (vec2-normalize - (vec2- (vec2+ (position (player game)) (vec2 0.0 16.0)) + (vec2- (vec2+ (position (& scene player)) (vec2 0.0 16.0)) (position popcorn))))) (tween 0.5 0.0 4.0 (lambda (speed) @@ -442,7 +493,7 @@ ;; Wave 3 (define (spawn-moth p) (let ((moth (make-moth p))) - (spawn game moth) + (spawn scene moth) (run-script moth (sleep 0.2) (tween 1.0 -2.0 0.0 @@ -456,11 +507,11 @@ (n 9) (arc-step (/ (- arc-end arc-start) n)) (speed 1.9)) - (audio-play (asset-ref enemy-shoot-sound)) + (audio-play (artifact enemy-shoot-sound)) (let arc-loop ((j 0)) (when (< j n) (let ((theta (+ arc-start (* j arc-step)))) - (add-bullet (bullets game) + (add-bullet (& scene bullets) medium-enemy-bullet (position moth) (vec2 (* (cos theta) speed) @@ -507,11 +558,11 @@ (sleep 7.0)) ;; Boss (unless (getenv "SKIP_BOSS") - (run-script game + (run-script scene (repeat 8 - (audio-play (asset-ref alarm-sound)) + (audio-play (artifact alarm-sound)) (sleep 1.0))) - (run-script game + (run-script scene (let ((warning (make <shadow-label> #:name 'warning #:rank 9 @@ -520,11 +571,11 @@ #:text "WARNING!! BIG OL' BAD THING AHEAD!" #:align 'center #:color %text-color))) - (attach-to game warning) + (attach-to scene warning) (blink warning 15 0.25) (detach warning))) (sleep 7.0) - (spawn game (make <boss> + (spawn scene (make <boss> #:name 'boss #:rank 2 #:position (vec2 (/ %game-width 2.0) @@ -535,49 +586,65 @@ (sleep 4.5) (tween 1.0 15.0 0.0 (lambda (speed) - (change-scroll-speed game speed))) - (wait-until (dead? (& game boss))) - (clear-bullets (bullets game))) + (change-scroll-speed scene speed))) + (wait-until (dead? (& scene boss))) + (clear-bullets (& scene bullets))) ;; Victory! - (set! (invincible? (player game)) #t) - (add-to-score (player game) (* (lives (player game)) 50000)) - (game-complete game))) + (set! (invincible? (& scene player)) #t) + (add-to-score (& scene player) (* (lives (& scene player)) 50000)) + (game-complete scene))) -(define-method (reset-game (game <game>)) - (stop-scripts game) +(define-method (reset-game (scene <game-scene>)) + (stop-scripts scene) (disable-pollen!) - (change-scroll-speed game 0.0) - (clear-bullets (bullets game)) - (quadtree-clear! (quadtree game)) - (show (& game hud-lives)) - (show (& game hud-pollen)) + (change-scroll-speed scene 0.0) + (clear-bullets (& scene bullets)) + (quadtree-clear! (quadtree scene)) + (show (& scene hud lives)) + (show (& scene hud pollen)) (for-each-child (lambda (child) (when (or (is-a? child <actor>) (memq (name child) '(game-over game-complete tutorial warning))) (detach child))) - game) - (spawn game + scene) + (spawn scene (make <player> #:name 'player #:rank 3 - #:position (vec2 (/ %game-width 2.0) 20.0) + #:position (vec2-copy %default-player-position) #:hitbox (make-rect -0.5 -0.5 1.0 1.0))) - (run-level game)) + (run-level scene)) -(define-method (on-enter (game <game>)) - (reset-game game)) +(define-method (on-boot (scene <game-scene>)) + (attach-to scene + (make <background> + #:name 'background + #:texture background-image) + (make <particles> + #:name 'particles + #:particles (make-particles 2048 + #:texture (artifact particle-image) + #:end-color (make-color 1.0 1.0 1.0 0.0))) + (make <bullets> + #:name 'bullets + #:rank 4 + #:quadtree (quadtree scene)) + (make <hud> + #:name 'hud + #:rank 5))) -(define-method (game-complete (game <game>)) - (hide (& game hud-pollen)) +(define-method (game-complete (scene <game-scene>)) + (set! (scoring-enabled? (& scene player)) #f) + (hide (& scene hud pollen)) (tween 1.0 1.0 0.0 (lambda (volume) - (set-source-volume! (music-source game) volume))) - (source-stop (music-source game)) - (play-music game intro-music) - (set-source-volume! (music-source game) 1.0) - (change-state game 'pre-game-complete) - (let ((p (player game))) + (set-source-volume! (music-source scene) volume))) + (source-stop (music-source scene)) + (play-music scene intro-music) + (set-source-volume! (music-source scene) 1.0) + (replace-major-mode scene (make <nothing-mode>)) + (let ((p (& scene player))) (stop-scripts p) (set! (shoot? p) #f) (set! (move-left? p) #f) @@ -585,20 +652,20 @@ (set! (move-down? p) #f) (set! (move-up? p) #f)) (sleep 1.0) - (audio-play (asset-ref pickup-sound)) - (spawn game (make-flower (vec2 (/ %game-width 4) 160.0))) + (audio-play (artifact pickup-sound)) + (spawn scene (make-flower (vec2 (/ %game-width 4) 160.0))) (sleep 1.0) - (audio-play (asset-ref pickup-sound)) - (spawn game (make-flower (vec2 (/ %game-width 2) 160.0))) + (audio-play (artifact pickup-sound)) + (spawn scene (make-flower (vec2 (/ %game-width 2) 160.0))) (sleep 1.0) - (audio-play (asset-ref pickup-sound)) - (spawn game (make-flower (vec2 (- %game-width (/ %game-width 4)) 160.0))) + (audio-play (artifact pickup-sound)) + (spawn scene (make-flower (vec2 (- %game-width (/ %game-width 4)) 160.0))) (sleep 1.0) - (change-state game 'game-complete) + (replace-major-mode scene (make <game-complete-mode>)) (let ((group (make <node-2d> #:name 'game-complete #:rank 5))) - (attach-to game group) + (attach-to scene group) (attach-to group (make <shadow-label> #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0)) @@ -609,22 +676,23 @@ (make <shadow-label> #:position (vec2 (/ %game-width 2.0) (- (/ %game-height 2.0) 20.0)) #:font monogram-font - #:text "press ENTER to play again" + #:text "press ENTER key or START button to play again" #:align 'center #:color %text-color))) (forever - (add-bullet (bullets game) + (add-bullet (& scene bullets) pollen-pickup (vec2 (random %game-width) (+ %game-height 0.0)) (vec2 0.0 (- (+ (random:uniform) 0.5)))) (sleep 0.1))) -(define-method (game-over (game <game>)) - (hide (& game hud-lives)) - (hide (& game hud-pollen)) - (change-state game 'game-over) - (stop-scripts game) - (let ((p (player game))) +(define-method (game-over (scene <game-scene>)) + (set! (scoring-enabled? (& scene player)) #f) + (hide (& scene hud lives)) + (hide (& scene hud pollen)) + (replace-major-mode scene (make <game-over-mode>)) + (stop-scripts scene) + (let ((p (& scene player))) (stop-scripts p) (hide p) (set! (shoot? p) #f) @@ -632,14 +700,14 @@ (set! (move-right? p) #f) (set! (move-down? p) #f) (set! (move-up? p) #f)) - (run-script game - (tween 1.0 (scroll-speed game) 0.0 + (run-script scene + (tween 1.0 (scroll-speed scene) 0.0 (lambda (speed) - (change-scroll-speed game speed)))) + (change-scroll-speed scene speed)))) (let ((group (make <node-2d> #:name 'game-over #:rank 5))) - (attach-to game group) + (attach-to scene group) (attach-to group (make <shadow-label> #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0)) @@ -650,21 +718,21 @@ (make <shadow-label> #:position (vec2 (/ %game-width 2.0) (- (/ %game-height 2.0) 20.0)) #:font monogram-font - #:text "press ENTER to try again" + #:text "press ENTER key or START button to try again" #:align 'center #:color %text-color)))) -(define-method (toggle-pause (game <game>)) - (if (paused? game) +(define-method (toggle-pause (scene <game-scene>)) + (if (paused? scene) (begin - (detach (& game pause-overlay)) - (source-play (music-source game)) - (resume game)) + (detach (& scene pause-overlay)) + (source-play (music-source scene)) + (resume scene)) (let ((overlay (make <node-2d> #:name 'pause-overlay #:rank 99))) - (pause game) - (source-pause (music-source game)) + (pause scene) + (source-pause (music-source scene)) (attach-to overlay (make <sprite> #:texture darkness-image @@ -676,110 +744,145 @@ #:align 'center #:vertical-align 'center #:color %text-color)) - (attach-to game overlay)))) + (attach-to scene overlay)))) -(define-method (play-again (game <game>)) - (change-state game 'play-again) - (run-script game +(define-method (play-again (scene <game-scene>)) + (replace-major-mode scene (make <nothing-mode>)) + (run-script scene (tween 0.5 1.0 0.0 (lambda (volume) - (set-source-volume! (music-source game) volume))) - (source-stop (music-source game)) - (set-source-volume! (music-source game) 1.0)) - (run-script game - (fade-out game 1.0) - (reset-game game))) - -(define-method (close-game (game <game>)) - (pop-scene (current-kernel))) - -(define-method (on-quit (game <game>)) - (close-game game)) - -(define-method (on-key-press (game <game>) key modifiers repeat?) - (case (state game) - ((play) - (case key - ((left) - (set! (move-left? (player game)) #t)) - ((right) - (set! (move-right? (player game)) #t)) - ((down) - (set! (move-down? (player game)) #t)) - ((up) - (set! (move-up? (player game)) #t)) - ((z) - (set! (shoot? (player game)) #t)) - ((x) - (bomb (player game))) - ((escape) - (close-game game)) - ((return) - (toggle-pause game)))) - ((intro) - (case key - ((escape) - (close-game game)) - ((return) - (toggle-pause game)))) - ((game-over game-complete) - (case key - ((escape) - (close-game game)) - ((return) - (play-again game)))))) - -(define-method (on-key-release (game <game>) key modifiers) - (case (state game) - ((play) - (case key - ((left) - (set! (move-left? (player game)) #f)) - ((right) - (set! (move-right? (player game)) #f)) - ((down) - (set! (move-down? (player game)) #f)) - ((up) - (set! (move-up? (player game)) #f)) - ((z) - (set! (shoot? (player game)) #f)))))) - -(define-method (update (game <game>) dt) + (set-source-volume! (music-source scene) volume))) + (source-stop (music-source scene)) + (set-source-volume! (music-source scene) 1.0)) + (run-script scene + (fade-out scene 1.0) + (replace-major-mode scene (make <intro-mode>)))) + +(define-method (clean-up-actors (scene <game-scene>)) + (let ((p (& scene player))) + ;; This probably shouldn't be here, but it is. + (shoot-maybe p (& scene bullets)) + ;; Remove dead actors and actors that have gone too far off + ;; screen. + (for-each-child (lambda (child) + (cond + ((dead? child) + (on-death child) + (quadtree-delete! (quadtree scene) + (world-hitbox child) + child) + (add-to-score (& scene player) (points child)) + (detach child)) + ((out-of-bounds? child) + (quadtree-delete! (quadtree scene) + (world-hitbox child) + child) + (detach child)))) + scene) + (when (= (lives p) 0) ; bummer + (game-over scene)))) + +(define-method (update (scene <game-scene>) dt) (next-method) - (let ((bg (& game background))) - (set! (scroll-y bg) (+ (scroll-y bg) (* (scroll-speed game) dt)))) - (case (state game) - ((intro play) - (let ((p (player game))) - (when (not (= (last-lives game) (lives p))) - (set! (text (& game hud-lives)) - (string-append "lives " (number->string (lives p)))) - (when (= (lives p) 0) - (game-over game))) - (when (not (= (last-pollen game) (pollen p))) - (let ((n (pollen p))) - (set! (text (& game hud-pollen)) - (string-append "pollen " - (if (= n %max-pollen) "MAX" (number->string n)))))) - (when (not (= (last-score game) (score p))) - (set! (text (& game hud-score)) - (string-append "score " (number->string (score p))))) - (set! (last-lives game) (lives p)) - (set! (last-pollen game) (pollen p)) - (set! (last-score game) (score p)) - (shoot-maybe p (bullets game)) - (for-each-child (lambda (child) - (cond - ((dead? child) - (on-death child) - (quadtree-delete! (quadtree game) - (world-hitbox child) - child) - (add-to-score (player game) (points child)) - (detach child)) - ((out-of-bounds? child) - (quadtree-delete! (quadtree game) - (world-hitbox child) - child) - (detach child)))) - game))))) + (let ((bg (& scene background))) + (set! (scroll-y bg) (+ (scroll-y bg) (* (scroll-speed scene) dt))))) + + +;;; +;;; Modes +;;; + +(define-method (close-game (mode <major-mode>)) + (exit-catbird)) + +(define-method (pause-game (mode <major-mode>)) + (toggle-pause (parent mode))) + +(define-method (skip-intro (mode <major-mode>)) + (skip-intro (parent mode))) + +(define-class <intro-mode> (<major-mode>)) + +(define-method (on-enter (mode <intro-mode>)) + (reset-game (parent mode))) + +(define-method (update (mode <intro-mode>) dt) + (clean-up-actors (parent mode))) + +(bind-input <intro-mode> (key-press 'escape) close-game) +(bind-input <intro-mode> (key-press 'return) skip-intro) +(bind-input <intro-mode> (controller-press '0 'back) close-game) +(bind-input <intro-mode> (controller-press '0 'start) skip-intro) + +(define-class <play-mode> (<major-mode>)) + +(define-method (update (mode <play-mode>) dt) + (clean-up-actors (parent mode))) + +(define (move-command accessor value) + (lambda (mode) + (set! (accessor (& (parent mode) player)) value))) + +(define-method (player-shoot (mode <play-mode>)) + (set! (shoot? (& (parent mode) player)) #t)) + +(define-method (player-stop-shooting (mode <play-mode>)) + (set! (shoot? (& (parent mode) player)) #f)) + +(define-method (player-bomb (mode <play-mode>)) + (bomb (& (parent mode) player))) + +(define-method (skip-intro-or-pause-game (mode <play-mode>)) + (let ((scene (parent mode))) + (if (intro-script scene) + (skip-intro scene) + (toggle-pause scene)))) + +(bind-input <play-mode> (key-press 'left) (move-command move-left? #t)) +(bind-input <play-mode> (key-press 'right) (move-command move-right? #t)) +(bind-input <play-mode> (key-press 'down) (move-command move-down? #t)) +(bind-input <play-mode> (key-press 'up) (move-command move-up? #t)) +(bind-input <play-mode> (key-release 'left) (move-command move-left? #f)) +(bind-input <play-mode> (key-release 'right) (move-command move-right? #f)) +(bind-input <play-mode> (key-release 'down) (move-command move-down? #f)) +(bind-input <play-mode> (key-release 'up) (move-command move-up? #f)) +(bind-input <play-mode> (key-press 'z) player-shoot) +(bind-input <play-mode> (key-release 'z) player-stop-shooting) +(bind-input <play-mode> (key-press 'x) player-bomb) +(bind-input <play-mode> (key-press 'escape) close-game) +(bind-input <play-mode> (key-press 'return) skip-intro-or-pause-game) +(bind-input <play-mode> (controller-press 0 'dpad-left) (move-command move-left? #t)) +(bind-input <play-mode> (controller-press 0 'dpad-right) (move-command move-right? #t)) +(bind-input <play-mode> (controller-press 0 'dpad-down) (move-command move-down? #t)) +(bind-input <play-mode> (controller-press 0 'dpad-up) (move-command move-up? #t)) +(bind-input <play-mode> (controller-release 0 'dpad-left) (move-command move-left? #f)) +(bind-input <play-mode> (controller-release 0 'dpad-right) (move-command move-right? #f)) +(bind-input <play-mode> (controller-release 0 'dpad-down) (move-command move-down? #f)) +(bind-input <play-mode> (controller-release 0 'dpad-up) (move-command move-up? #f)) +(bind-input <play-mode> (controller-press 0 'a) player-shoot) +(bind-input <play-mode> (controller-release 0 'a) player-stop-shooting) +(bind-input <play-mode> (controller-press 0 'b) player-bomb) +(bind-input <play-mode> (controller-press 0 'back) close-game) +(bind-input <play-mode> (controller-press 0 'start) skip-intro-or-pause-game) + +(define-class <game-over-mode> (<major-mode>)) + +(define-method (play-game-again (mode <major-mode>)) + (play-again (parent mode))) + +(bind-input <game-over-mode> (key-press 'escape) close-game) +(bind-input <game-over-mode> (key-press 'return) play-game-again) +(bind-input <game-over-mode> (controller-press 0 'back) close-game) +(bind-input <game-over-mode> (controller-press 0 'start) play-game-again) + +(define-class <game-complete-mode> (<major-mode>)) + +(bind-input <game-complete-mode> (key-press 'escape) close-game) +(bind-input <game-complete-mode> (key-press 'return) play-game-again) +(bind-input <game-complete-mode> (controller-press 0 'back) close-game) +(bind-input <game-complete-mode> (controller-press 0 'start) play-game-again) + +(define (make-game-scene) + (let ((scene (make <game-scene>))) + (replace-major-mode scene (make <intro-mode>)) + scene)) |