summaryrefslogtreecommitdiff
path: root/bonnie-bee/game.scm
diff options
context:
space:
mode:
Diffstat (limited to 'bonnie-bee/game.scm')
-rw-r--r--bonnie-bee/game.scm486
1 files changed, 442 insertions, 44 deletions
diff --git a/bonnie-bee/game.scm b/bonnie-bee/game.scm
index ad1d9c3..ffdbc3e 100644
--- a/bonnie-bee/game.scm
+++ b/bonnie-bee/game.scm
@@ -1,16 +1,23 @@
(define-module (bonnie-bee game)
#:use-module (bonnie-bee actor)
#:use-module (bonnie-bee assets)
+ #:use-module (bonnie-bee background)
#:use-module (bonnie-bee bullet)
#:use-module (bonnie-bee common)
#:use-module (bonnie-bee flower)
#:use-module (bonnie-bee player)
+ #:use-module (bonnie-bee turret)
+ #:use-module (bonnie-bee popcorn)
+ #:use-module (chickadee)
+ #:use-module (chickadee audio)
#:use-module (chickadee data quadtree)
#:use-module (chickadee graphics color)
+ #:use-module (chickadee graphics particles)
#:use-module (chickadee math rect)
#: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)
@@ -20,10 +27,20 @@
(define %game-bounds (make-rect 0.0 0.0 %game-width %game-height))
(define-class <game> (<scene-2d>)
- (quadtree #:getter quadtree #:init-form (make-quadtree %game-bounds)))
+ (state #:accessor state #:init-value 'play)
+ (quadtree #:getter quadtree #:init-form (make-quadtree %game-bounds))
+ (scroll-speed #:getter scroll-speed #:init-value 0.0)
+ (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>))
@@ -32,64 +49,445 @@
(define-method (bullets (game <game>))
(& game bullets))
+(define-method (particles (game <game>))
+ (& game particles))
+
(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)))
(make <bullets>
#:name 'bullets
- #:quadtree (quadtree game))))
+ #:rank 3
+ #:quadtree (quadtree game))
+ (make <label>
+ #:name 'hud-lives
+ #:rank 5
+ #:position (vec2 2.0 2.0)
+ #:font monogram-font
+ #:text "lives 0")
+ (make <label>
+ #:name 'hud-pollen
+ #:rank 5
+ #:position (vec2 (/ %game-width 2.0) 2.0)
+ #:font monogram-font
+ #:text "pollen 0"
+ #:align 'center)
+ (make <label>
+ #:name 'hud-score
+ #:rank 5
+ #:position (vec2 (- %game-width 2.0) 2.0)
+ #:font monogram-font
+ #:text "score 0"
+ #:align 'right)))
-(define-method (on-enter (game <game>))
+(define-method (play-music (game <game>) music-asset)
+ (set-source-audio! (music-source game) (asset-ref music-asset))
+ (source-play (music-source game)))
+
+(define* (make-turret p #:key (interval 0.5) (speed 1.0))
+ (let ((turret (make <turret>
+ #:rank 1
+ #:position p
+ #:hitbox (make-rect -32.0 -32.0 64.0 64.0)
+ #:health 50
+ #:points 200)))
+ (run-script turret
+ (sleep (steps 1))
+ (forever
+ (let ((theta (+ (angle-to turret (player (parent turret)))
+ (* (- (* (random:uniform) 2.0) 1.0) 0.2)))
+ (speed 1.5))
+ (audio-play (asset-ref enemy-shoot-sound))
+ (add-bullet (bullets (parent turret))
+ medium-enemy-bullet
+ (position turret)
+ (vec2 (* (cos theta) speed)
+ (* (sin theta) speed))))
+ (sleep interval)))
+ turret))
+
+(define (make-flower p)
+ (make <flower>
+ #:rank 1
+ #:position p
+ #:hitbox (make-rect -32.0 -32.0 64.0 64.0)
+ #:health 30
+ #:points 100))
+
+(define* (make-popcorn p #:optional (v (vec2 0.0 0.0)))
+ (make <popcorn>
+ #:rank 2
+ #:position p
+ #:velocity v
+ #:hitbox (make-rect -16.0 -16.0 32.0 32.0)
+ #:health 1
+ #:points 10))
+
+(define-method (change-state (game <game>) new-state)
+ (set! (state game) new-state))
+
+(define-method (run-level (game <game>))
+ ;; Outline:
+ ;;
+ ;; * There are flowers all around, bee moving between them happily.
+ ;; Then the boss shows up, and blasts all the flowers away.
+ ;;
+ ;; * Level starts scrolling, player gets control and is taught the
+ ;; controls with just flowers around.
+ ;;
+ ;; * A few popcorn enemies appear
+ ;;
+ ;; * Turrets begin to appear, along with more popcorn
+ ;;
+ ;; * Moths appear
+ ;;
+ ;; * Boss
+ (define (tutorial message key)
+ (let ((l (make <label>
+ #:name 'tutorial
+ #:rank 5
+ #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0))
+ #:font monogram-font
+ #:text message
+ #:align 'center)))
+ (attach-to game l)
+ (if key
+ (wait-until (key-pressed? key))
+ (sleep 2.0))
+ (detach l)))
+ (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 174.0 227.0)))
+ (flower-2 (make-flower (vec2 50.0 226.0)))
+ (flower-3 (make-flower (vec2 280.0 201.0)))
+ (flower-4 (make-flower (vec2 121.0 197.0)))
+ (flower-5 (make-flower (vec2 54.0 134.0)))
+ (flower-6 (make-flower (vec2 150.0 121.0)))
+ (flower-7 (make-flower (vec2 256.0 131.0)))
+ (flower-8 (make-flower (vec2 307.0 109.0))))
+ (define (shoot-at flower)
+ (audio-play (asset-ref enemy-shoot-sound))
+ (add-bullet (bullets game)
+ medium-enemy-bullet
+ (position popcorn)
+ (vec2* (direction-to popcorn flower) bullet-speed)))
+ (change-state game 'intro)
+ (play-music game intro-music)
+ (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 76.0)))
+ (spawn game (make-flower (vec2 26.0 58.0)))
+ (spawn game (make-flower (vec2 247.0 45.0)))
+ (spawn game (make-flower (vec2 169.0 12.0)))
+ (spawn game (make-flower (vec2 53.0 7.0)))
+ (teleport (player game) 169.0 12.0)
+ (sleep 0.5)
+ (audio-play (asset-ref pollen-release-sound))
+ (sleep 0.5)
+ (move-to (player game) 247.0 45.0 1.0)
+ (sleep 0.1)
+ (audio-play (asset-ref pollen-release-sound))
+ (sleep 0.5)
+ (move-to (player game) 102.0 76.0 1.0)
+ (sleep 0.1)
+ (audio-play (asset-ref pollen-release-sound))
+ (sleep 0.5)
+ (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)
+ (sleep 1.5)
+ (change-velocity popcorn 0.0 0.0)
+ (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-5)
+ (sleep 0.3)
+ (shoot-at flower-6)
+ (sleep 0.3)
+ (shoot-at flower-7)
+ (sleep 0.3)
+ (shoot-at flower-8)
+ (sleep 2.0)
+ (change-velocity popcorn 0.0 1.5)
+ (sleep 1.0)))
+ (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)
+ ;; Wave 1
+ (define (popcorn-line n spawn-point velocity delay)
+ (let loop ((i 0))
+ (when (< i n)
+ (spawn game (make-popcorn (vec2-copy spawn-point) velocity))
+ (sleep delay)
+ (loop (+ i 1)))))
+ (spawn game (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))))
+ (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
+ (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))))
+ (sleep 1.0)
+ (run-script game
+ (popcorn-line 30 (vec2 -16.0 220.0)
+ (vec2 2.0 -2.0) 0.2))
+ (run-script game
+ (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))))
+ (sleep 2.0)
+ (run-script game
+ (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))))
+ (popcorn-line 20 (vec2 (+ %game-width 16.0) 20.0)
+ (vec2 -2.0 2.0) 0.2)
+ (sleep 3.0)
+ ;; Wave 2
+ ;; popcorn that shoots, more flowers
+ (let loop ((i 0))
+ (when (< i 4)
+ (spawn game
+ (make-turret (vec2 (random 320) 240)))
+ (loop (+ i 1))))
+
+ ;; Wave 3
+ ;; turrets, more popcorn, more flowers
+ ;; Wave 4
+ ;; moths, turrets, popcorn, flowers
+ ;; Wave 5
+ ;; intense moths, turrets, popcorn, flowers
+ ;; Boss
+ ;; big beetle thing. no flowers. good luck.
+
+ ;; Victory
+ (sleep 5.0)
+ (game-complete game)
+
+ ;; (let loop ((i 0))
+ ;; (when (< i 2)
+ ;; (spawn game
+ ;; (make-turret (vec2 (random 320) 240)))
+ ;; (loop (+ i 1))))
+
+ ;; (let loop ((i 0))
+ ;; (when (< i 8)
+ ;; (spawn game
+ ;; (make-flower (vec2 (random 320) (random 240))))
+ ;; (loop (+ i 1))))
+
+ ;; (forever
+ ;; (spawn game
+ ;; (make-popcorn (vec2 (random 320) (+ 120 (random 120)))))
+ ;; (sleep 2.0))
+ ))
+
+(define-method (reset-game (game <game>))
+ (disable-pollen!)
+ (change-scroll-speed game 0.0)
+ (clear-bullets (bullets game))
+ (quadtree-clear! (quadtree game))
+ (for-each-child (lambda (child)
+ (when (or (is-a? child <actor>)
+ (memq (name child) '(game-over game-complete tutorial)))
+ (detach child)))
+ game)
(spawn game
(make <player>
#:name 'player
+ #:rank 4
#:position (vec2 (/ %game-width 2.0) 20.0)
- #:hitbox (make-rect -2.0 -2.0 4.0 4.0)))
- (spawn game
- (make <flower>
- #:position (vec2 (/ %game-width 2.0)
- (/ %game-height 2.0))
- #:hitbox (make-rect -32.0 -32.0 64.0 64.0)
- #:health 10)))
+ #:hitbox (make-rect -0.5 -0.5 1.0 1.0)))
+ (run-level game))
+
+(define-method (on-enter (game <game>))
+ (reset-game game))
+
+(define-method (game-complete (game <game>))
+ (tween 1.0 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)
+ (play-music game intro-music)
+ (change-state game 'game-complete)
+ (stop-scripts game)
+ (let ((p (player game)))
+ (stop-scripts p)
+ (set! (shoot? p) #f)
+ (set! (move-left? p) #f)
+ (set! (move-right? p) #f)
+ (set! (move-down? p) #f)
+ (set! (move-up? p) #f))
+ (let ((group (make <node-2d>
+ #:name 'game-complete
+ #:rank 5)))
+ (attach-to game group)
+ (attach-to group
+ (make <label>
+ #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0))
+ #:font monogram-font
+ #:text "WELL DONE, LITTLE BEE!"
+ #:align 'center)
+ (make <label>
+ #:position (vec2 (/ %game-width 2.0) (- (/ %game-height 2.0) 20.0))
+ #:font monogram-font
+ #:text "press ENTER to play again"
+ #:align 'center))))
+
+(define-method (game-over (game <game>))
+ (change-state game 'game-over)
+ (stop-scripts game)
+ (let ((p (player game)))
+ (stop-scripts p)
+ (hide p)
+ (set! (shoot? p) #f)
+ (set! (move-left? p) #f)
+ (set! (move-right? p) #f)
+ (set! (move-down? p) #f)
+ (set! (move-up? p) #f))
+ (let ((group (make <node-2d>
+ #:name 'game-over
+ #:rank 5)))
+ (attach-to game group)
+ (attach-to group
+ (make <label>
+ #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0))
+ #:font monogram-font
+ #:text "GAME OVER"
+ #:align 'center)
+ (make <label>
+ #:position (vec2 (/ %game-width 2.0) (- (/ %game-height 2.0) 20.0))
+ #:font monogram-font
+ #:text "press ENTER to try again"
+ #:align 'center))))
(define-method (on-key-press (game <game>) key modifiers repeat?)
- (case key
- ((q)
- (pop-scene (current-kernel)))
- ((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))))
+ (case (state game)
+ ((play)
+ (case key
+ ((q)
+ (pop-scene (current-kernel)))
+ ((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)))))
+ ((game-over game-complete)
+ (case key
+ ((q)
+ (pop-scene (current-kernel)))
+ ((return)
+ (reset-game game))))
+ ((intro)
+ (case key
+ ((q)
+ (pop-scene (current-kernel)))))))
(define-method (on-key-release (game <game>) key modifiers)
- (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))))
+ (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)
(next-method)
- (shoot-maybe (player game) (bullets game))
- (for-each-child (lambda (child)
- (when (and (is-a? child <damageable>)
- (dead? child))
- (on-death child (bullets game))
- (quadtree-delete! (quadtree game)
- (world-hitbox child)
- child)
- (detach child)))
- game))
+ (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)))))