diff options
Diffstat (limited to 'bonnie-bee')
| -rw-r--r-- | bonnie-bee/actor.scm | 89 | ||||
| -rw-r--r-- | bonnie-bee/assets.scm | 34 | ||||
| -rw-r--r-- | bonnie-bee/background.scm | 105 | ||||
| -rw-r--r-- | bonnie-bee/bullet.scm | 46 | ||||
| -rw-r--r-- | bonnie-bee/common.scm | 7 | ||||
| -rw-r--r-- | bonnie-bee/flower.scm | 59 | ||||
| -rw-r--r-- | bonnie-bee/game.scm | 486 | ||||
| -rw-r--r-- | bonnie-bee/player.scm | 114 | ||||
| -rw-r--r-- | bonnie-bee/popcorn.scm | 39 | ||||
| -rw-r--r-- | bonnie-bee/splash.scm | 2 | ||||
| -rw-r--r-- | bonnie-bee/turret.scm | 49 |
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))))))) |