summaryrefslogtreecommitdiff
path: root/bonnie-bee
diff options
context:
space:
mode:
Diffstat (limited to 'bonnie-bee')
-rw-r--r--bonnie-bee/actor.scm89
-rw-r--r--bonnie-bee/assets.scm34
-rw-r--r--bonnie-bee/background.scm105
-rw-r--r--bonnie-bee/bullet.scm46
-rw-r--r--bonnie-bee/common.scm7
-rw-r--r--bonnie-bee/flower.scm59
-rw-r--r--bonnie-bee/game.scm486
-rw-r--r--bonnie-bee/player.scm114
-rw-r--r--bonnie-bee/popcorn.scm39
-rw-r--r--bonnie-bee/splash.scm2
-rw-r--r--bonnie-bee/turret.scm49
11 files changed, 946 insertions, 84 deletions
diff --git a/bonnie-bee/actor.scm b/bonnie-bee/actor.scm
index a734d6a..1e21144 100644
--- a/bonnie-bee/actor.scm
+++ b/bonnie-bee/actor.scm
@@ -1,8 +1,12 @@
(define-module (bonnie-bee actor)
+ #:use-module (bonnie-bee assets)
+ #:use-module (bonnie-bee common)
+ #:use-module (chickadee audio)
#:use-module (chickadee data quadtree)
#:use-module (chickadee math rect)
#:use-module (chickadee math vector)
#:use-module (oop goops)
+ #:use-module (starling asset)
#:use-module (starling node)
#:use-module (starling node-2d)
#:export (<actor>
@@ -10,18 +14,45 @@
hitbox
world-hitbox
quadtree
+ change-velocity
+ direction-to
+ angle-to
+ after-move
on-collide
- <damageable>
dead?
+ out-of-bounds?
+ <damageable>
+ points
damage
- on-death))
+ on-death
+ <grounded>
+ player
+ bullets
+ scroll-speed))
(define-class <actor> (<node-2d>)
- (velocity #:getter velocity #:init-form (vec2 0.0 0.0))
+ (velocity #:getter velocity #:init-keyword #:velocity #:init-form (vec2 0.0 0.0))
(hitbox #:getter hitbox #:init-keyword #:hitbox)
(world-hitbox #:getter world-hitbox #:init-form (make-rect 0.0 0.0 0.0 0.0))
(quadtree #:accessor quadtree #:init-keyword #:quadtree))
+(define-method (change-velocity (actor <actor>) dx dy)
+ (set-vec2! (velocity actor) dx dy))
+
+(define-method (direction-to (actor <actor>) (other <actor>))
+ (let ((dir (vec2- (position other) (position actor))))
+ (vec2-normalize! dir)
+ dir))
+
+(define-method (angle-to (actor <actor>) (other <actor>))
+ (let ((p1 (position actor))
+ (p2 (position other)))
+ (atan (- (vec2-y p2) (vec2-y p1))
+ (- (vec2-x p2) (vec2-x p1)))))
+
+(define-method (scroll-speed (actor <actor>))
+ 0.0)
+
(define-method (add-to-quadtree (actor <actor>))
(quadtree-insert! (quadtree actor) (world-hitbox actor) actor))
@@ -38,7 +69,6 @@
(set-rect-height! wh (rect-height h))))
(define-method (on-collide a b)
- (pk 'unhandled-collision a b)
#f)
(define-method (on-enter (actor <actor>))
@@ -55,27 +85,66 @@
(rect-intersects? r (world-hitbox other))
(on-collide actor other))))))
+(define-method (after-move (actor <actor>))
+ #t)
+
(define-method (update (actor <actor>) dt)
(let ((p (position actor))
- (v (velocity actor)))
- (if (and (= (vec2-x v) 0.0) (= (vec2-y v) 0.0))
+ (v (velocity actor))
+ (scroll-speed (scroll-speed actor)))
+ (if (and (= (vec2-x v) 0.0)
+ (= (vec2-y v) 0.0)
+ (= scroll-speed 0.0))
(collision-check actor)
(begin
(remove-from-quadtree actor)
- (vec2-add! p v)
+ (set-vec2! p
+ (+ (vec2-x p) (vec2-x v))
+ (+ (vec2-y p) (vec2-y v) (- (* scroll-speed dt))))
+ (after-move actor)
(refresh-world-hitbox actor)
(collision-check actor)
(add-to-quadtree actor)
(dirty! actor)))))
+(define-method (dead? (actor <actor>))
+ #f)
+
+(define-method (dead? x)
+ #f)
+
+(define %bounds
+ (let ((padding 16.0))
+ (make-rect (- padding)
+ (- padding)
+ (+ %game-width (* padding 2.0))
+ (+ %game-height (* padding 2.0)))))
+
+(define-method (out-of-bounds? (actor <actor>))
+ (not (rect-intersects? (world-hitbox actor) %bounds)))
+
+(define-method (out-of-bounds? x)
+ #f)
+
(define-class <damageable> ()
- (health #:accessor health #:init-keyword #:health))
+ (health #:accessor health #:init-keyword #:health)
+ (points #:getter points #:init-keyword #:points))
(define-method (dead? (d <damageable>))
(= (health d) 0))
(define-method (damage (d <damageable>) x)
- (set! (health d) (max (- (health d) x) 0)))
+ (set! (health d) (max (- (health d) x) 0))
+ (unless (dead? d)
+ (audio-play (asset-ref enemy-hit-sound) #:volume 0.25)))
-(define-method (on-death (d <damageable>) bullets)
+(define-method (on-death (d <damageable>))
#t)
+
+(define-class <grounded> ())
+
+(define-method (scroll-speed (g <grounded>))
+ (scroll-speed (parent g)))
+
+(define-generic player)
+(define-generic bullets)
diff --git a/bonnie-bee/assets.scm b/bonnie-bee/assets.scm
index 5337215..6b92649 100644
--- a/bonnie-bee/assets.scm
+++ b/bonnie-bee/assets.scm
@@ -4,15 +4,47 @@
#:use-module (chickadee graphics texture)
#:use-module (starling asset)
#:export (chonkly-font
+ monogram-font
+ background-image
+ particle-image
bee-atlas
bullet-atlas
- flower-image))
+ popcorn-image
+ flower-image
+ turret-image
+ moth-image
+ explosion-sound
+ pickup-sound
+ enemy-shoot-sound
+ enemy-hit-sound
+ player-death-sound
+ player-shoot-sound
+ player-bomb-sound
+ pollen-release-sound
+ intro-music
+ main-music))
(define (scope-datadir file-name)
(let ((prefix (or (getenv "BONNIE_BEE_DATADIR") (getcwd))))
(string-append prefix "/" file-name)))
(define-asset chonkly-font (load-font (scope-datadir "assets/fonts/Chonkly.otf") 16))
+(define-asset monogram-font (load-font (scope-datadir "assets/fonts/monogram_extended.ttf") 12))
+(define-asset background-image (load-image (scope-datadir "assets/images/background.png")))
+(define-asset particle-image (load-image (scope-datadir "assets/images/particle.png")))
(define-asset bee-atlas (load-tileset (scope-datadir "assets/images/bee.png") 32 32))
(define-asset bullet-atlas (load-tileset (scope-datadir "assets/images/bullets.png") 16 16))
(define-asset flower-image (load-image (scope-datadir "assets/images/flower.png")))
+(define-asset popcorn-image (load-image (scope-datadir "assets/images/popcorn.png")))
+(define-asset turret-image (load-image (scope-datadir "assets/images/flower-turret.png")))
+(define-asset moth-image (load-image (scope-datadir "assets/images/moth.png")))
+(define-asset explosion-sound (load-audio (scope-datadir "assets/sounds/explosion.wav")))
+(define-asset pickup-sound (load-audio (scope-datadir "assets/sounds/pickup.wav")))
+(define-asset enemy-shoot-sound (load-audio (scope-datadir "assets/sounds/enemy-shoot.wav")))
+(define-asset enemy-hit-sound (load-audio (scope-datadir "assets/sounds/enemy-hit.wav")))
+(define-asset player-death-sound (load-audio (scope-datadir "assets/sounds/player-death.wav")))
+(define-asset player-shoot-sound (load-audio (scope-datadir "assets/sounds/player-shoot.wav")))
+(define-asset player-bomb-sound (load-audio (scope-datadir "assets/sounds/player-bomb.wav")))
+(define-asset pollen-release-sound (load-audio (scope-datadir "assets/sounds/pollen-release.wav")))
+(define-asset intro-music (load-audio (scope-datadir "assets/sounds/intro.wav") #:mode 'stream))
+(define-asset main-music (load-audio (scope-datadir "assets/sounds/main.wav") #:mode 'stream))
diff --git a/bonnie-bee/background.scm b/bonnie-bee/background.scm
new file mode 100644
index 0000000..f374556
--- /dev/null
+++ b/bonnie-bee/background.scm
@@ -0,0 +1,105 @@
+(define-module (bonnie-bee background)
+ #:use-module (bonnie-bee assets)
+ #:use-module (bonnie-bee common)
+ #:use-module (chickadee graphics buffer)
+ #:use-module (chickadee graphics engine)
+ #:use-module (chickadee graphics shader)
+ #:use-module (chickadee graphics texture)
+ #:use-module (chickadee math)
+ #:use-module (chickadee math matrix)
+ #:use-module (chickadee math vector)
+ #:use-module (chickadee scripting)
+ #:use-module (chickadee utils)
+ #:use-module (oop goops)
+ #:use-module (starling node)
+ #:use-module (starling node-2d)
+ #:export (<background>
+ scroll-y))
+
+(define (make-background-shader)
+ (strings->shader
+ "
+#ifdef GLSL330
+layout (location = 0) in vec2 position;
+layout (location = 1) in vec2 tex;
+#elif defined(GLSL130)
+in vec2 position;
+in vec2 tex;
+#elif defined(GLSL120)
+attribute vec2 position;
+attribute vec2 tex;
+#endif
+#ifdef GLSL120
+varying vec2 fragTex;
+#else
+out vec2 fragTex;
+#endif
+uniform mat4 mvp;
+
+void main(void) {
+ fragTex = tex;
+ gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
+}
+"
+ "
+#ifdef GLSL120
+varying vec2 fragTex;
+#else
+in vec2 fragTex;
+#endif
+#ifdef GLSL330
+out vec4 fragColor;
+#else
+#define fragColor gl_FragColor
+#endif
+uniform sampler2D image;
+uniform float scrollY;
+
+void main (void) {
+ vec2 uv = vec2(fragTex.x, fragTex.y + scrollY);
+ fragColor = texture(image, uv);
+}
+"))
+
+(define-geometry-type <background-vertex>
+ background-vertex-ref
+ background-vertex-set!
+ background-vertex-append!
+ (position vec2)
+ (texture vec2))
+
+(define (make-background-geometry)
+ (let* ((g (make-geometry <background-vertex> 4 #:index-capacity 6))
+ (x1 0.0)
+ (y1 0.0)
+ (x2 (exact->inexact %game-width))
+ (y2 (exact->inexact %game-height))
+ (s1 0.0)
+ (t1 0.0)
+ (s2 1.0)
+ (t2 1.0))
+ (with-geometry g
+ (background-vertex-append! g
+ (x1 y1 s1 t1)
+ (x2 y1 s2 t1)
+ (x2 y2 s2 t2)
+ (x1 y2 s1 t2))
+ (geometry-index-append! g 0 3 2 0 2 1))
+ g))
+
+(define-class <background> (<node-2d>)
+ (scroll-y #:accessor scroll-y #:init-value 0.0)
+ (texture #:accessor texture #:init-keyword #:texture #:asset? #t)
+ (shader #:getter shader #:init-thunk make-background-shader)
+ (geometry #:getter geometry #:init-thunk make-background-geometry)
+ (mvp-matrix #:getter mvp-matrix #:init-thunk make-identity-matrix4))
+
+(define-method (render (background <background>) alpha)
+ (let ((mvp (mvp-matrix background))
+ (t (texture background)))
+ (matrix4-mult! mvp (world-matrix background) (current-projection))
+ (with-graphics-state ((g:texture-0 t))
+ (shader-apply (shader background)
+ (geometry-vertex-array (geometry background))
+ #:scroll-y (/ (scroll-y background) (texture-height t))
+ #:mvp mvp))))
diff --git a/bonnie-bee/bullet.scm b/bonnie-bee/bullet.scm
index 0fb351b..2cd722b 100644
--- a/bonnie-bee/bullet.scm
+++ b/bonnie-bee/bullet.scm
@@ -14,10 +14,18 @@
#:use-module (starling node)
#:use-module (starling node-2d)
#:export (<bullet-type>
- name
+ player-bullet?
+ player-primary-bullet?
+ player-bomb-bullet?
+ enemy-bullet?
player-primary-bullet
+ player-bomb-bullet
+ large-enemy-bullet
+ medium-enemy-bullet
+ small-enemy-bullet
pollen-pickup
<bullets>
+ clear-bullets
<bullet>
type
kill-bullet
@@ -36,6 +44,22 @@
(make <bullet-type> #:name 'player-primary #:atlas-index 4
#:hitbox (make-rect -7.0 -7.0 14.0 14.0)))
+(define player-bomb-bullet
+ (make <bullet-type> #:name 'player-bomb #:atlas-index 5
+ #:hitbox (make-rect -4.0 -4.0 8.0 8.0)))
+
+(define large-enemy-bullet
+ (make <bullet-type> #:name 'large-enemy #:atlas-index 0
+ #:hitbox (make-rect -4.0 -4.0 8.0 8.0)))
+
+(define medium-enemy-bullet
+ (make <bullet-type> #:name 'medium-enemy #:atlas-index 1
+ #:hitbox (make-rect -2.0 -2.0 4.0 4.0)))
+
+(define small-enemy-bullet
+ (make <bullet-type> #:name 'small-enemy #:atlas-index 2
+ #:hitbox (make-rect -0.5 -0.5 1.0 1.0)))
+
;; Yeah... pollen is a bullet. Didn't you know that??
(define pollen-pickup
(make <bullet-type> #:name 'pollen #:atlas-index 6
@@ -80,6 +104,9 @@
(set! (hitboxes bullets) (make-vector* %max-bullets make-null-rect))
(set! (regions bullets) (make-vector* %max-bullets make-null-rect)))
+(define-method (clear-bullets (bullets <bullets>))
+ (set! (size bullets) 0))
+
(define-class <bullet> ()
(parent #:getter parent #:init-keyword #:parent)
(type #:accessor type)
@@ -189,3 +216,20 @@
(set-rect-y! h (+ (rect-y h) (vec2-y v)))
(quadtree-insert! q h d)
(loop (+ i 1)))))))))
+
+(define (player-bullet? bullet)
+ (let ((t (type bullet)))
+ (or (eq? t player-primary-bullet)
+ (eq? t player-bomb-bullet))))
+
+(define (player-primary-bullet? bullet)
+ (eq? (type bullet) player-primary-bullet))
+
+(define (player-bomb-bullet? bullet)
+ (eq? (type bullet) player-bomb-bullet))
+
+(define (enemy-bullet? bullet)
+ (let ((t (type bullet)))
+ (or (eq? t small-enemy-bullet)
+ (eq? t medium-enemy-bullet)
+ (eq? t large-enemy-bullet))))
diff --git a/bonnie-bee/common.scm b/bonnie-bee/common.scm
index fa9f14a..75a6bc4 100644
--- a/bonnie-bee/common.scm
+++ b/bonnie-bee/common.scm
@@ -1,4 +1,5 @@
(define-module (bonnie-bee common)
+ #:use-module (chickadee game-loop)
#:use-module (chickadee graphics color)
#:use-module (chickadee graphics viewport)
#:use-module (chickadee math vector)
@@ -9,7 +10,8 @@
%window-height
%game-width
%game-height
- set-cameras!))
+ set-cameras!
+ steps))
(define %window-width 960)
(define %window-height 720)
@@ -22,3 +24,6 @@
#:resolution (vec2 %game-width %game-height)
#:viewport (make-viewport 0 0 %window-width %window-height
#:clear-color black)))))
+
+(define (steps n)
+ (* n (current-timestep)))
diff --git a/bonnie-bee/flower.scm b/bonnie-bee/flower.scm
index cafa4f8..2c018e9 100644
--- a/bonnie-bee/flower.scm
+++ b/bonnie-bee/flower.scm
@@ -2,16 +2,33 @@
#:use-module (bonnie-bee actor)
#:use-module (bonnie-bee assets)
#:use-module (bonnie-bee bullet)
+ #:use-module (chickadee audio)
+ #:use-module (chickadee graphics particles)
#:use-module (chickadee math)
+ #:use-module (chickadee math rect)
#:use-module (chickadee math vector)
#:use-module (chickadee scripting)
#:use-module (chickadee utils)
#:use-module (oop goops)
+ #:use-module (starling asset)
#:use-module (starling node)
#:use-module (starling node-2d)
- #:export (<flower>))
+ #:export (<flower>
+ pollen-enabled?
+ enable-pollen!
+ disable-pollen!))
-(define-class <flower> (<actor> <damageable>))
+(define-class <flower> (<grounded> <damageable> <actor>)
+ (emit-pollen? #:allocation #:class #:init-value #f))
+
+(define (pollen-enabled?)
+ (class-slot-ref <flower> 'emit-pollen?))
+
+(define (enable-pollen!)
+ (class-slot-set! <flower> 'emit-pollen? #t))
+
+(define (disable-pollen!)
+ (class-slot-set! <flower> 'emit-pollen? #f))
(define-method (on-boot (flower <flower>))
(attach-to flower
@@ -20,18 +37,30 @@
#:origin (vec2 32.0 32.0))))
(define-method (on-collide (flower <flower>) (bullet <bullet>))
- (if (eq? (type bullet) player-primary-bullet)
- (begin
- (damage flower 1)
- (kill-bullet bullet)
- #t)
- #f))
+ (cond
+ ((player-bullet? bullet)
+ (damage flower 1)
+ (kill-bullet bullet)
+ #t)
+ ((and (not (pollen-enabled?)) (enemy-bullet? bullet))
+ (damage flower 1000)
+ (kill-bullet bullet))
+ (else #f)))
-(define-method (on-death (flower <flower>) bullets)
+(define-method (on-death (flower <flower>))
(let ((p (position flower)))
- (for-range ((i 16))
- (let ((theta (- (* (random:uniform) (/ pi -2.0)) (/ pi 4.0)))
- (speed (+ (* (random:uniform) 1.0) 1.0)))
- (add-bullet bullets pollen-pickup p
- (vec2 (* (cos theta) speed)
- (* (sin theta) speed)))))))
+ (if (pollen-enabled?)
+ (begin
+ (audio-play (asset-ref pollen-release-sound))
+ (for-range ((i 16))
+ (let ((theta (- (* (random:uniform) (/ pi -2.0)) (/ pi 4.0)))
+ (speed (+ (* (random:uniform) 1.0) 1.0)))
+ (add-bullet (bullets (parent flower))
+ pollen-pickup p
+ (vec2 (* (cos theta) speed)
+ (* (sin theta) speed))))))
+ (begin
+ (audio-play (asset-ref explosion-sound))
+ (add-particle-emitter (particles (particles (parent flower)))
+ (make-particle-emitter (make-rect (vec2-x p) (vec2-y p) 1.0 1.0)
+ 10 5))))))
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)))))
diff --git a/bonnie-bee/player.scm b/bonnie-bee/player.scm
index 9a5da1c..6f6cd91 100644
--- a/bonnie-bee/player.scm
+++ b/bonnie-bee/player.scm
@@ -2,12 +2,19 @@
#:use-module (bonnie-bee actor)
#:use-module (bonnie-bee assets)
#:use-module (bonnie-bee bullet)
+ #:use-module (bonnie-bee common)
+ #:use-module (bonnie-bee flower)
+ #:use-module (chickadee audio)
+ #:use-module (chickadee game-loop)
+ #:use-module (chickadee math)
#:use-module (chickadee math vector)
#:use-module (chickadee scripting)
#:use-module (oop goops)
+ #:use-module (starling asset)
#:use-module (starling node)
#:use-module (starling node-2d)
- #:export (<player>
+ #:export (%max-pollen
+ <player>
move-left?
move-right?
move-down?
@@ -16,7 +23,12 @@
speed
lives
pollen
- shoot-maybe))
+ score
+ shoot-maybe
+ bomb
+ add-to-score))
+
+(define %max-pollen 50)
(define-class <player> (<actor>)
(move-left? #:accessor move-left? #:init-value #f)
@@ -25,10 +37,13 @@
(move-up? #:accessor move-up? #:init-value #f)
(shoot? #:accessor shoot? #:init-value #f #:watch? #t)
(last-shot #:accessor last-shot #:init-value 0)
- (shot-interval #:getter shot-interval #:init-value 2)
- (speed #:accessor speed #:init-value 2.0)
+ (shot-interval #:getter shot-interval #:init-value (steps 2))
+ (speed #:accessor speed #:init-value 2.5)
(lives #:accessor lives #:init-value 3)
- (pollen #:accessor pollen #:init-value 0))
+ (invincible? #:accessor invincible? #:init-value #f)
+ (pollen #:accessor pollen #:init-value 0)
+ (score #:accessor score #:init-value 0)
+ (bombing? #:accessor bombing? #:init-value #f))
(define-method (on-boot (player <player>))
(attach-to player
@@ -43,6 +58,19 @@
(when (and new (not (and old new)))
(set! (last-shot player) 0)))))
+(define-method (after-move (player <player>))
+ (let ((p (position player)))
+ (cond
+ ((< (vec2-x p) 8.0)
+ (set-vec2-x! p 8.0))
+ ((> (vec2-x p) 312.0)
+ (set-vec2-x! p 312.0)))
+ (cond
+ ((< (vec2-y p) 8.0)
+ (set-vec2-y! p 8.0))
+ ((> (vec2-y p) 232.0)
+ (set-vec2-y! p 232.0)))))
+
(define-method (update (player <player>) dt)
(let ((v (velocity player)))
(set-vec2! v
@@ -54,13 +82,42 @@
(vec2-mult! v (speed player)))
(next-method))
+(define-method (lose-life (player <player>))
+ (unless (invincible? player)
+ (set! (lives player) (max (- (lives player) 1) 0))
+ (set! (invincible? player) #t)
+ (audio-play (asset-ref player-death-sound))
+ (run-script player
+ (blink player 20 (steps 5))
+ (set! (invincible? player) #f))))
+
(define-method (on-collide (player <player>) (bullet <bullet>))
- (if (eq? (type bullet) pollen-pickup)
- (begin
- (kill-bullet bullet)
- (set! (pollen player) (+ (pollen player) 1))
- #t)
- #f))
+ (cond
+ ((eq? (type bullet) pollen-pickup)
+ (audio-play (asset-ref pickup-sound) #:volume 0.3)
+ (kill-bullet bullet)
+ (add-to-score player 1)
+ (set! (pollen player) (min (+ (pollen player) 1) %max-pollen))
+ #t)
+ ((or (eq? (type bullet) small-enemy-bullet)
+ (eq? (type bullet) medium-enemy-bullet)
+ (eq? (type bullet) large-enemy-bullet))
+ (kill-bullet bullet)
+ (lose-life player)
+ #t)
+ (else #f)))
+
+(define-method (on-collide (player <player>) (thing <damageable>))
+ (lose-life player))
+
+(define-method (on-collide (thing <damageable>) (player <player>))
+ (lose-life player))
+
+(define-method (on-collide (player <player>) (flower <flower>))
+ #f)
+
+(define-method (on-collide (flower <flower>) (player <player>))
+ #f)
(define-method (shoot-maybe (player <player>) bullets)
(with-agenda (agenda player)
@@ -69,7 +126,42 @@
(shot-interval player)))
(let ((p (position player)))
(set! (last-shot player) (agenda-time))
+ (audio-play (asset-ref player-shoot-sound) #:volume 0.2)
(add-bullet bullets
player-primary-bullet
(vec2 (vec2-x p) (+ (vec2-y p) 14.0))
(vec2 0.0 6.0))))))
+
+(define-method (bomb (player <player>))
+ (unless (or (bombing? player) (< (pollen player) 10))
+ (run-script player
+ (let* ((times (floor (/ (pollen player) 10)))
+ (num-bullets 64)
+ (theta-step (/ tau num-bullets))
+ (radius 16.0)
+ (speed 5.0)
+ (p (position player))
+ (bullets (bullets (parent player))))
+ (set! (bombing? player) #t)
+ (set! (pollen player) 0)
+ (set! (invincible? player) #t)
+ (let loop ((i 0))
+ (when (< i times)
+ (audio-play (asset-ref player-bomb-sound))
+ (let shot-loop ((j 0))
+ (when (< j num-bullets)
+ (let ((theta (* j theta-step)))
+ (add-bullet bullets
+ player-bomb-bullet
+ (vec2/polar p radius theta)
+ (vec2 (* (cos theta) speed)
+ (* (sin theta) speed))))
+ (shot-loop (+ j 1))))
+ (sleep (* (current-timestep) 3))
+ (loop (+ i 1))))
+ (sleep 1.0)
+ (set! (invincible? player) #f)
+ (set! (bombing? player) #f)))))
+
+(define-method (add-to-score (player <player>) points)
+ (set! (score player) (+ (score player) points)))
diff --git a/bonnie-bee/popcorn.scm b/bonnie-bee/popcorn.scm
new file mode 100644
index 0000000..8c70326
--- /dev/null
+++ b/bonnie-bee/popcorn.scm
@@ -0,0 +1,39 @@
+(define-module (bonnie-bee popcorn)
+ #:use-module (bonnie-bee actor)
+ #:use-module (bonnie-bee assets)
+ #:use-module (bonnie-bee bullet)
+ #:use-module (chickadee audio)
+ #:use-module (chickadee graphics particles)
+ #:use-module (chickadee math)
+ #:use-module (chickadee math rect)
+ #:use-module (chickadee math vector)
+ #:use-module (chickadee scripting)
+ #:use-module (chickadee utils)
+ #:use-module (oop goops)
+ #:use-module (starling asset)
+ #:use-module (starling node)
+ #:use-module (starling node-2d)
+ #:export (<popcorn>))
+
+(define-class <popcorn> (<damageable> <actor>))
+
+(define-method (on-boot (popcorn <popcorn>))
+ (attach-to popcorn
+ (make <sprite>
+ #:texture popcorn-image
+ #:origin (vec2 16.0 16.0))))
+
+(define-method (on-collide (popcorn <popcorn>) (bullet <bullet>))
+ (if (player-bullet? bullet)
+ (begin
+ (damage popcorn 1)
+ (kill-bullet bullet)
+ #t)
+ #f))
+
+(define-method (on-death (popcorn <popcorn>))
+ (audio-play (asset-ref explosion-sound))
+ (let ((p (position popcorn)))
+ (add-particle-emitter (particles (particles (parent popcorn)))
+ (make-particle-emitter (make-rect (vec2-x p) (vec2-y p) 1.0 1.0)
+ 4 3))))
diff --git a/bonnie-bee/splash.scm b/bonnie-bee/splash.scm
index 292fd05..3b8fba6 100644
--- a/bonnie-bee/splash.scm
+++ b/bonnie-bee/splash.scm
@@ -29,7 +29,7 @@
(unless (getenv "SKIP_SPLASH")
(run-script splash
(set! (text (& splash label)) "made with chickadee")
- (sleep 30)
+ (sleep 0.5)
(replace-scene (current-kernel) (make <game>)))))
(define (launch-game)
diff --git a/bonnie-bee/turret.scm b/bonnie-bee/turret.scm
new file mode 100644
index 0000000..29a3654
--- /dev/null
+++ b/bonnie-bee/turret.scm
@@ -0,0 +1,49 @@
+(define-module (bonnie-bee turret)
+ #:use-module (bonnie-bee actor)
+ #:use-module (bonnie-bee assets)
+ #:use-module (bonnie-bee bullet)
+ #:use-module (chickadee audio)
+ #:use-module (chickadee graphics particles)
+ #:use-module (chickadee math)
+ #:use-module (chickadee math rect)
+ #:use-module (chickadee math vector)
+ #:use-module (chickadee scripting)
+ #:use-module (chickadee utils)
+ #:use-module (oop goops)
+ #:use-module (starling asset)
+ #:use-module (starling node)
+ #:use-module (starling node-2d)
+ #:export (<turret>))
+
+(define-class <turret> (<grounded> <damageable> <actor>))
+
+(define-method (on-boot (turret <turret>))
+ (attach-to turret
+ (make <sprite>
+ #:texture turret-image
+ #:origin (vec2 32.0 32.0))))
+
+(define-method (on-collide (turret <turret>) (bullet <bullet>))
+ (cond
+ ((player-primary-bullet? bullet)
+ (damage turret 1)
+ (kill-bullet bullet)
+ #t)
+ ((player-bomb-bullet? bullet)
+ (damage turret 10)
+ (kill-bullet bullet))
+ (else #f)))
+
+(define-method (on-death (turret <turret>))
+ (audio-play (asset-ref explosion-sound))
+ (let ((p (position turret)))
+ (add-particle-emitter (particles (particles (parent turret)))
+ (make-particle-emitter (make-rect (vec2-x p) (vec2-y p) 1.0 1.0)
+ 10 3))
+ (for-range ((i 8))
+ (let ((theta (- (* (random:uniform) (/ pi -2.0)) (/ pi 4.0)))
+ (speed (+ (* (random:uniform) 1.0) 1.0)))
+ (add-bullet (bullets (parent turret))
+ medium-enemy-bullet p
+ (vec2 (* (cos theta) speed)
+ (* (sin theta) speed)))))))