From ae60497f7722e01ccceebe799b5820717e048eb3 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Wed, 20 Oct 2021 18:42:10 -0400
Subject: Haven't committed in days, oops!

---
 Makefile.am                        |   3 +
 assets/fonts/monogram_extended.ttf | Bin 0 -> 34164 bytes
 assets/images/background.png       | Bin 0 -> 4058 bytes
 assets/images/background.xcf       | Bin 0 -> 31043 bytes
 assets/images/beetle.png           | Bin 0 -> 2662 bytes
 assets/images/beetle.xcf           | Bin 0 -> 21364 bytes
 assets/images/flower-turret.png    | Bin 0 -> 1488 bytes
 assets/images/flower-turret.xcf    | Bin 0 -> 4387 bytes
 assets/images/flower.png           | Bin 1221 -> 1433 bytes
 assets/images/flower.xcf           | Bin 2915 -> 3623 bytes
 assets/images/moth.png             | Bin 0 -> 1337 bytes
 assets/images/moth.xcf             | Bin 0 -> 6853 bytes
 assets/images/particle.png         | Bin 0 -> 623 bytes
 assets/images/particle.xcf         | Bin 0 -> 874 bytes
 assets/images/popcorn.png          | Bin 0 -> 862 bytes
 assets/images/popcorn.xcf          | Bin 0 -> 1760 bytes
 assets/sounds/enemy-hit.wav        | Bin 0 -> 3188 bytes
 assets/sounds/enemy-shoot.wav      | Bin 0 -> 8672 bytes
 assets/sounds/explosion.wav        | Bin 0 -> 42548 bytes
 assets/sounds/intro.xm             | Bin 0 -> 600481 bytes
 assets/sounds/main.xm              | Bin 0 -> 736870 bytes
 assets/sounds/pickup.wav           | Bin 0 -> 10486 bytes
 assets/sounds/player-bomb.wav      | Bin 0 -> 14476 bytes
 assets/sounds/player-death.wav     | Bin 0 -> 75364 bytes
 assets/sounds/player-shoot.wav     | Bin 0 -> 35490 bytes
 assets/sounds/pollen-release.wav   | Bin 0 -> 8468 bytes
 bonnie-bee/actor.scm               |  89 ++++++-
 bonnie-bee/assets.scm              |  34 ++-
 bonnie-bee/background.scm          | 105 ++++++++
 bonnie-bee/bullet.scm              |  46 +++-
 bonnie-bee/common.scm              |   7 +-
 bonnie-bee/flower.scm              |  59 +++--
 bonnie-bee/game.scm                | 486 +++++++++++++++++++++++++++++++++----
 bonnie-bee/player.scm              | 114 ++++++++-
 bonnie-bee/popcorn.scm             |  39 +++
 bonnie-bee/splash.scm              |   2 +-
 bonnie-bee/turret.scm              |  49 ++++
 guix.scm                           |   4 +-
 38 files changed, 951 insertions(+), 86 deletions(-)
 create mode 100644 assets/fonts/monogram_extended.ttf
 create mode 100644 assets/images/background.png
 create mode 100644 assets/images/background.xcf
 create mode 100644 assets/images/beetle.png
 create mode 100644 assets/images/beetle.xcf
 create mode 100644 assets/images/flower-turret.png
 create mode 100644 assets/images/flower-turret.xcf
 create mode 100644 assets/images/moth.png
 create mode 100644 assets/images/moth.xcf
 create mode 100644 assets/images/particle.png
 create mode 100644 assets/images/particle.xcf
 create mode 100644 assets/images/popcorn.png
 create mode 100644 assets/images/popcorn.xcf
 create mode 100644 assets/sounds/enemy-hit.wav
 create mode 100644 assets/sounds/enemy-shoot.wav
 create mode 100644 assets/sounds/explosion.wav
 create mode 100644 assets/sounds/intro.xm
 create mode 100644 assets/sounds/main.xm
 create mode 100644 assets/sounds/pickup.wav
 create mode 100644 assets/sounds/player-bomb.wav
 create mode 100644 assets/sounds/player-death.wav
 create mode 100644 assets/sounds/player-shoot.wav
 create mode 100644 assets/sounds/pollen-release.wav
 create mode 100644 bonnie-bee/background.scm
 create mode 100644 bonnie-bee/popcorn.scm
 create mode 100644 bonnie-bee/turret.scm

diff --git a/Makefile.am b/Makefile.am
index 2e307b1..7fc78c3 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -27,11 +27,14 @@ bin_SCRIPTS =					\
 SOURCES = 					\
   bonnie-bee/common.scm				\
   bonnie-bee/assets.scm				\
+  bonnie-bee/background.scm			\
   bonnie-bee/actor.scm				\
   bonnie-bee/player.scm				\
   bonnie-bee/bullet.scm				\
   bonnie-bee/pollen.scm				\
   bonnie-bee/flower.scm				\
+  bonnie-bee/turret.scm				\
+  bonnie-bee/popcorn.scm			\
   bonnie-bee/game.scm				\
   bonnie-bee/splash.scm
 
diff --git a/assets/fonts/monogram_extended.ttf b/assets/fonts/monogram_extended.ttf
new file mode 100644
index 0000000..948c06a
Binary files /dev/null and b/assets/fonts/monogram_extended.ttf differ
diff --git a/assets/images/background.png b/assets/images/background.png
new file mode 100644
index 0000000..638fcdc
Binary files /dev/null and b/assets/images/background.png differ
diff --git a/assets/images/background.xcf b/assets/images/background.xcf
new file mode 100644
index 0000000..55cc2fb
Binary files /dev/null and b/assets/images/background.xcf differ
diff --git a/assets/images/beetle.png b/assets/images/beetle.png
new file mode 100644
index 0000000..2544efd
Binary files /dev/null and b/assets/images/beetle.png differ
diff --git a/assets/images/beetle.xcf b/assets/images/beetle.xcf
new file mode 100644
index 0000000..a23c50d
Binary files /dev/null and b/assets/images/beetle.xcf differ
diff --git a/assets/images/flower-turret.png b/assets/images/flower-turret.png
new file mode 100644
index 0000000..86e40ca
Binary files /dev/null and b/assets/images/flower-turret.png differ
diff --git a/assets/images/flower-turret.xcf b/assets/images/flower-turret.xcf
new file mode 100644
index 0000000..65ef52b
Binary files /dev/null and b/assets/images/flower-turret.xcf differ
diff --git a/assets/images/flower.png b/assets/images/flower.png
index 76e077a..f0d35c6 100644
Binary files a/assets/images/flower.png and b/assets/images/flower.png differ
diff --git a/assets/images/flower.xcf b/assets/images/flower.xcf
index 1d22889..3c34d04 100644
Binary files a/assets/images/flower.xcf and b/assets/images/flower.xcf differ
diff --git a/assets/images/moth.png b/assets/images/moth.png
new file mode 100644
index 0000000..e46c84a
Binary files /dev/null and b/assets/images/moth.png differ
diff --git a/assets/images/moth.xcf b/assets/images/moth.xcf
new file mode 100644
index 0000000..0cd0305
Binary files /dev/null and b/assets/images/moth.xcf differ
diff --git a/assets/images/particle.png b/assets/images/particle.png
new file mode 100644
index 0000000..0d55a93
Binary files /dev/null and b/assets/images/particle.png differ
diff --git a/assets/images/particle.xcf b/assets/images/particle.xcf
new file mode 100644
index 0000000..66da7fc
Binary files /dev/null and b/assets/images/particle.xcf differ
diff --git a/assets/images/popcorn.png b/assets/images/popcorn.png
new file mode 100644
index 0000000..d35cfce
Binary files /dev/null and b/assets/images/popcorn.png differ
diff --git a/assets/images/popcorn.xcf b/assets/images/popcorn.xcf
new file mode 100644
index 0000000..b765b71
Binary files /dev/null and b/assets/images/popcorn.xcf differ
diff --git a/assets/sounds/enemy-hit.wav b/assets/sounds/enemy-hit.wav
new file mode 100644
index 0000000..8f7fbc5
Binary files /dev/null and b/assets/sounds/enemy-hit.wav differ
diff --git a/assets/sounds/enemy-shoot.wav b/assets/sounds/enemy-shoot.wav
new file mode 100644
index 0000000..a49c17e
Binary files /dev/null and b/assets/sounds/enemy-shoot.wav differ
diff --git a/assets/sounds/explosion.wav b/assets/sounds/explosion.wav
new file mode 100644
index 0000000..0cdc2c7
Binary files /dev/null and b/assets/sounds/explosion.wav differ
diff --git a/assets/sounds/intro.xm b/assets/sounds/intro.xm
new file mode 100644
index 0000000..1254601
Binary files /dev/null and b/assets/sounds/intro.xm differ
diff --git a/assets/sounds/main.xm b/assets/sounds/main.xm
new file mode 100644
index 0000000..bf6f179
Binary files /dev/null and b/assets/sounds/main.xm differ
diff --git a/assets/sounds/pickup.wav b/assets/sounds/pickup.wav
new file mode 100644
index 0000000..ce8caa5
Binary files /dev/null and b/assets/sounds/pickup.wav differ
diff --git a/assets/sounds/player-bomb.wav b/assets/sounds/player-bomb.wav
new file mode 100644
index 0000000..369b07b
Binary files /dev/null and b/assets/sounds/player-bomb.wav differ
diff --git a/assets/sounds/player-death.wav b/assets/sounds/player-death.wav
new file mode 100644
index 0000000..113fc8d
Binary files /dev/null and b/assets/sounds/player-death.wav differ
diff --git a/assets/sounds/player-shoot.wav b/assets/sounds/player-shoot.wav
new file mode 100644
index 0000000..db38cce
Binary files /dev/null and b/assets/sounds/player-shoot.wav differ
diff --git a/assets/sounds/pollen-release.wav b/assets/sounds/pollen-release.wav
new file mode 100644
index 0000000..4de8538
Binary files /dev/null and b/assets/sounds/pollen-release.wav differ
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)))))))
diff --git a/guix.scm b/guix.scm
index afc5f0d..e002da1 100644
--- a/guix.scm
+++ b/guix.scm
@@ -136,7 +136,7 @@ Scheme.  It contains all of the basic components needed to develop
      (license license:gpl3+))))
 
 (define starling
-  (let ((commit "d0250dcd5ebe6de0bb7236b2805869ccd4d45537"))
+  (let ((commit "a1a9494515a25d00f4065e7bfa145acec4da8b73"))
     (package
      (name "starling")
      (version (string-append "0.1.0-1." (string-take commit 7)))
@@ -147,7 +147,7 @@ Scheme.  It contains all of the basic components needed to develop
                     (commit commit)))
               (sha256
                (base32
-                "1mdjmwbxfwbh67xxwmw9idwa22319fnipj9hd9pp3m8d0gp94r4y"))))
+                "08rqacyyilc7yz59rq87jshs6vxy4zd9s335143d6b8i1cnpnmv0"))))
      (build-system gnu-build-system)
      (arguments
       '(#:make-flags '("GUILE_AUTO_COMPILE=0")
-- 
cgit v1.2.3