summaryrefslogtreecommitdiff
path: root/bonnie-bee
diff options
context:
space:
mode:
Diffstat (limited to 'bonnie-bee')
-rw-r--r--bonnie-bee/actor.scm60
-rw-r--r--bonnie-bee/assets.scm4
-rw-r--r--bonnie-bee/bullet.scm109
-rw-r--r--bonnie-bee/flower.scm37
-rw-r--r--bonnie-bee/game.scm50
-rw-r--r--bonnie-bee/player.scm35
6 files changed, 209 insertions, 86 deletions
diff --git a/bonnie-bee/actor.scm b/bonnie-bee/actor.scm
index db49372..a734d6a 100644
--- a/bonnie-bee/actor.scm
+++ b/bonnie-bee/actor.scm
@@ -10,7 +10,11 @@
hitbox
world-hitbox
quadtree
- on-collide))
+ on-collide
+ <damageable>
+ dead?
+ damage
+ on-death))
(define-class <actor> (<node-2d>)
(velocity #:getter velocity #:init-form (vec2 0.0 0.0))
@@ -41,27 +45,37 @@
(refresh-world-hitbox actor)
(add-to-quadtree actor))
-(define-method (update (actor <actor>) dt)
+(define-method (collision-check (actor <actor>))
(let ((p (position actor))
- (v (velocity actor))
(r (world-hitbox actor)))
- (unless (and (= (vec2-x v) 0.0) (= (vec2-y v) 0.0))
- (remove-from-quadtree actor)
- (vec2-add! p v)
- (refresh-world-hitbox actor)
- (quadtree-find
- (quadtree actor) r
- (lambda (other)
- ;; Calculate overlap.
- (let* ((ro (world-hitbox other))
- (xo (max (- (min (rect-right r) (rect-right ro))
- (max (rect-left r) (rect-left ro)))
- 0.0))
- (yo (max (- (min (rect-top r) (rect-top ro))
- (max (rect-bottom r) (rect-bottom ro)))
- 0.0)))
- (if (or (= xo 0.0) (= yo 0.0))
- #f ; no collision
- (on-collide actor other)))))
- (add-to-quadtree actor)
- (dirty! actor))))
+ (quadtree-find
+ (quadtree actor) r
+ (lambda (other)
+ (and (not (eq? other actor))
+ (rect-intersects? r (world-hitbox other))
+ (on-collide actor other))))))
+
+(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))
+ (collision-check actor)
+ (begin
+ (remove-from-quadtree actor)
+ (vec2-add! p v)
+ (refresh-world-hitbox actor)
+ (collision-check actor)
+ (add-to-quadtree actor)
+ (dirty! actor)))))
+
+(define-class <damageable> ()
+ (health #:accessor health #:init-keyword #:health))
+
+(define-method (dead? (d <damageable>))
+ (= (health d) 0))
+
+(define-method (damage (d <damageable>) x)
+ (set! (health d) (max (- (health d) x) 0)))
+
+(define-method (on-death (d <damageable>) bullets)
+ #t)
diff --git a/bonnie-bee/assets.scm b/bonnie-bee/assets.scm
index 3c71bcc..5337215 100644
--- a/bonnie-bee/assets.scm
+++ b/bonnie-bee/assets.scm
@@ -5,7 +5,8 @@
#:use-module (starling asset)
#:export (chonkly-font
bee-atlas
- bullet-atlas))
+ bullet-atlas
+ flower-image))
(define (scope-datadir file-name)
(let ((prefix (or (getenv "BONNIE_BEE_DATADIR") (getcwd))))
@@ -14,3 +15,4 @@
(define-asset chonkly-font (load-font (scope-datadir "assets/fonts/Chonkly.otf") 16))
(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")))
diff --git a/bonnie-bee/bullet.scm b/bonnie-bee/bullet.scm
index ecf7b53..0fb351b 100644
--- a/bonnie-bee/bullet.scm
+++ b/bonnie-bee/bullet.scm
@@ -9,25 +9,36 @@
#:use-module (chickadee math vector)
#:use-module (chickadee utils)
#:use-module (oop goops)
+ #:use-module (srfi srfi-9)
#:use-module (starling asset)
#:use-module (starling node)
#:use-module (starling node-2d)
- #:export (<bullet>
- type
+ #:export (<bullet-type>
+ name
+ player-primary-bullet
pollen-pickup
<bullets>
+ <bullet>
+ type
+ kill-bullet
add-bullet))
-(define-class <bullet> ()
- (type #:getter type #:init-keyword #:type)
+(define-class <bullet-type> ()
+ (name #:getter name #:init-keyword #:name)
(atlas-index #:getter atlas-index #:init-keyword #:atlas-index)
(hitbox #:getter hitbox #:init-keyword #:hitbox))
(define (bullet-texture bullet)
- (texture-atlas-ref (asset-ref bullet-atlas) (atlas-index bullet)))
+ (texture-atlas-ref (asset-ref bullet-atlas)
+ (atlas-index (type bullet))))
+(define player-primary-bullet
+ (make <bullet-type> #:name 'player-primary #:atlas-index 4
+ #:hitbox (make-rect -7.0 -7.0 14.0 14.0)))
+
+;; Yeah... pollen is a bullet. Didn't you know that??
(define pollen-pickup
- (make <bullet> #:type 'pollen #:atlas-index 6
+ (make <bullet-type> #:name 'pollen #:atlas-index 6
#:hitbox (make-rect -10.0 -10.0 20.0 20.0)))
(define (make-bullet-sprite-batch)
@@ -35,16 +46,16 @@
(texture-parent
(texture-atlas-ref (asset-ref bullet-atlas) 0))))
-(define (make-vector* size thunk)
+(define (make-vector* size proc)
(let ((v (make-vector size)))
(for-range ((i size))
- (vector-set! v i (thunk)))
+ (vector-set! v i (proc i)))
v))
-(define (make-null-vec2)
+(define (make-null-vec2 i)
(vec2 0.0 0.0))
-(define (make-null-rect)
+(define (make-null-rect i)
(make-rect 0.0 0.0 0.0 0.0))
(define %max-bullets 2048)
@@ -55,22 +66,48 @@
(batch #:getter batch #:init-thunk make-bullet-sprite-batch)
(capacity #:getter capacity #:init-value %max-bullets)
(size #:accessor size #:init-value 0)
- (descriptors #:getter descriptors #:init-form (make-vector %max-bullets #f))
- (velocities #:getter velocities
- #:init-form (make-vector* %max-bullets make-null-vec2))
- (hitboxes #:getter hitboxes
- #:init-form (make-vector* %max-bullets make-null-rect))
- (regions #:getter regions
- #:init-form (make-vector* %max-bullets make-null-rect)))
-
-(define-method (add-bullet (bullets <bullets>) bullet position velocity)
+ (descriptors #:accessor descriptors)
+ (velocities #:accessor velocities)
+ (hitboxes #:accessor hitboxes)
+ (regions #:accessor regions))
+
+(define-method (initialize (bullets <bullets>) args)
+ (define (make-descriptor i)
+ (make <bullet> #:parent bullets #:index i))
+ (next-method)
+ (set! (descriptors bullets) (make-vector* %max-bullets make-descriptor))
+ (set! (velocities bullets) (make-vector* %max-bullets make-null-vec2))
+ (set! (hitboxes bullets) (make-vector* %max-bullets make-null-rect))
+ (set! (regions bullets) (make-vector* %max-bullets make-null-rect)))
+
+(define-class <bullet> ()
+ (parent #:getter parent #:init-keyword #:parent)
+ (type #:accessor type)
+ (index #:accessor index #:init-keyword #:index)
+ (alive? #:accessor alive? #:init-value #f))
+
+(define-method (dead? (bullet <bullet>))
+ (not (alive? bullet)))
+
+(define-method (kill-bullet (bullet <bullet>))
+ (set! (alive? bullet) #f))
+
+(define-method (velocity (bullet <bullet>))
+ (vector-ref (velocities (parent bullet)) (index bullet)))
+
+(define-method (world-hitbox (bullet <bullet>))
+ (vector-ref (hitboxes (parent bullet)) (index bullet)))
+
+(define-method (add-bullet (bullets <bullets>) bullet-type position velocity)
(let ((i (size bullets)))
(when (< i (capacity bullets))
- (let ((bh (hitbox bullet))
+ (let ((bh (hitbox bullet-type))
+ (d (vector-ref (descriptors bullets) i))
(v (vector-ref (velocities bullets) i))
(h (vector-ref (hitboxes bullets) i))
(r (vector-ref (regions bullets) i)))
- (vector-set! (descriptors bullets) i bullet)
+ (set! (type d) bullet-type)
+ (set! (alive? d) #t)
(vec2-copy! velocity (vector-ref (velocities bullets) i))
(set-rect-x! h (+ (vec2-x position) (rect-x bh)))
(set-rect-y! h (+ (vec2-y position) (rect-y bh)))
@@ -81,7 +118,7 @@
(set-rect-width! r 16.0)
(set-rect-height! r 16.0)
(set! (size bullets) (+ i 1))
- (quadtree-insert! (quadtree bullets) r bullet)))))
+ (quadtree-insert! (quadtree bullets) h d)))))
(define-method (remove-bullet (bullets <bullets>) i)
(let* ((s (- (size bullets) 1))
@@ -96,16 +133,18 @@
(h (vector-ref hs i)))
(when (or (> i s) (< i 0))
(error "bullet index out of bounds" i))
+ (set! (index (vector-ref ds s)) i)
(vector-set! ds i (vector-ref ds s))
(vector-set! rs i (vector-ref rs s))
(vector-set! vs i (vector-ref vs s))
(vector-set! hs i (vector-ref hs s))
+ (set! (index d) s)
(vector-set! ds s d)
(vector-set! rs s r)
(vector-set! vs s v)
(vector-set! hs s h)
(set! (size bullets) s)
- (quadtree-delete! q r d)))
+ (quadtree-delete! q h d)))
(define-method (render (bullets <bullets>) alpha)
(let ((ds (descriptors bullets))
@@ -132,37 +171,21 @@
(v (vector-ref vs i))
(h (vector-ref hs i)))
(cond
- ((or (< (rect-left h) -16.0)
+ ((or (dead? d)
+ (< (rect-left h) -16.0)
(> (rect-right h) 336.0)
(< (rect-bottom h) -16.0)
(> (rect-top h) 256.0))
- (pk 'remove i)
(remove-bullet bullets i)
(loop i))
((and (= (vec2-x v) 0.0)
(= (vec2-y v) 0.0))
(loop (+ i 1)))
(else
- (quadtree-delete! q r d)
+ (quadtree-delete! q h d)
(set-rect-x! r (+ (rect-x r) (vec2-x v)))
(set-rect-y! r (+ (rect-y r) (vec2-y v)))
(set-rect-x! h (+ (rect-x h) (vec2-x v)))
(set-rect-y! h (+ (rect-y h) (vec2-y v)))
- (quadtree-find
- (quadtree bullets) r
- (lambda (other)
- ;; Calculate overlap.
- (if (is-a? other <actor>)
- (let* ((ro (world-hitbox other))
- (xo (max (- (min (rect-right r) (rect-right ro))
- (max (rect-left r) (rect-left ro)))
- 0.0))
- (yo (max (- (min (rect-top r) (rect-top ro))
- (max (rect-bottom r) (rect-bottom ro)))
- 0.0)))
- (if (or (= xo 0.0) (= yo 0.0))
- #f ; no collision
- (on-collide d other)))
- #f)))
- (quadtree-insert! q r d)
+ (quadtree-insert! q h d)
(loop (+ i 1)))))))))
diff --git a/bonnie-bee/flower.scm b/bonnie-bee/flower.scm
new file mode 100644
index 0000000..cafa4f8
--- /dev/null
+++ b/bonnie-bee/flower.scm
@@ -0,0 +1,37 @@
+(define-module (bonnie-bee flower)
+ #:use-module (bonnie-bee actor)
+ #:use-module (bonnie-bee assets)
+ #:use-module (bonnie-bee bullet)
+ #:use-module (chickadee math)
+ #: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 (<flower>))
+
+(define-class <flower> (<actor> <damageable>))
+
+(define-method (on-boot (flower <flower>))
+ (attach-to flower
+ (make <sprite>
+ #:texture flower-image
+ #: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))
+
+(define-method (on-death (flower <flower>) bullets)
+ (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)))))))
diff --git a/bonnie-bee/game.scm b/bonnie-bee/game.scm
index 5290ab8..ad1d9c3 100644
--- a/bonnie-bee/game.scm
+++ b/bonnie-bee/game.scm
@@ -3,6 +3,7 @@
#:use-module (bonnie-bee assets)
#:use-module (bonnie-bee bullet)
#:use-module (bonnie-bee common)
+ #:use-module (bonnie-bee flower)
#:use-module (bonnie-bee player)
#:use-module (chickadee data quadtree)
#:use-module (chickadee graphics color)
@@ -21,34 +22,36 @@
(define-class <game> (<scene-2d>)
(quadtree #:getter quadtree #:init-form (make-quadtree %game-bounds)))
+(define-method (spawn (game <game>) (actor <actor>))
+ (set! (quadtree actor) (quadtree game))
+ (attach-to game actor))
+
+(define-method (player (game <game>))
+ (& game player))
+
+(define-method (bullets (game <game>))
+ (& game bullets))
+
(define-method (on-boot (game <game>))
+ (set! *random-state* (random-state-from-platform))
(set-cameras! game)
(attach-to game
(make <bullets>
#:name 'bullets
- #:quadtree (quadtree game)))
- (let loop ((i 0))
- (when (< i 100)
- (add-bullet (& game bullets) pollen-pickup
- (vec2 (* (random:uniform) 320.0)
- (* (random:uniform) 240.0))
- (vec2 (random:uniform)
- (random:uniform)))
- (loop (+ i 1)))))
-
-(define-method (spawn (game <game>) (actor <actor>))
- (set! (quadtree actor) (quadtree game))
- (attach-to game actor))
+ #:quadtree (quadtree game))))
(define-method (on-enter (game <game>))
(spawn game
(make <player>
#:name 'player
#:position (vec2 (/ %game-width 2.0) 20.0)
- #:hitbox (make-rect -2.0 -2.0 4.0 4.0))))
-
-(define-method (player (game <game>))
- (& game player))
+ #: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)))
(define-method (on-key-press (game <game>) key modifiers repeat?)
(case key
@@ -77,3 +80,16 @@
(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))
diff --git a/bonnie-bee/player.scm b/bonnie-bee/player.scm
index 6e8f7fb..9a5da1c 100644
--- a/bonnie-bee/player.scm
+++ b/bonnie-bee/player.scm
@@ -1,7 +1,9 @@
(define-module (bonnie-bee player)
#:use-module (bonnie-bee actor)
#:use-module (bonnie-bee assets)
+ #:use-module (bonnie-bee bullet)
#:use-module (chickadee math vector)
+ #:use-module (chickadee scripting)
#:use-module (oop goops)
#:use-module (starling node)
#:use-module (starling node-2d)
@@ -13,14 +15,17 @@
shoot?
speed
lives
- pollen))
+ pollen
+ shoot-maybe))
(define-class <player> (<actor>)
(move-left? #:accessor move-left? #:init-value #f)
(move-right? #:accessor move-right? #:init-value #f)
(move-down? #:accessor move-down? #:init-value #f)
(move-up? #:accessor move-up? #:init-value #f)
- (shoot? #:accessor shoot? #: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)
(lives #:accessor lives #:init-value 3)
(pollen #:accessor pollen #:init-value 0))
@@ -32,6 +37,12 @@
#:index 12
#:origin (vec2 16.0 16.0))))
+(define-method (on-change (player <player>) slot-name old new)
+ (case slot-name
+ ((shoot?)
+ (when (and new (not (and old new)))
+ (set! (last-shot player) 0)))))
+
(define-method (update (player <player>) dt)
(let ((v (velocity player)))
(set-vec2! v
@@ -42,3 +53,23 @@
(vec2-normalize! v)
(vec2-mult! v (speed player)))
(next-method))
+
+(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))
+
+(define-method (shoot-maybe (player <player>) bullets)
+ (with-agenda (agenda player)
+ (when (and (shoot? player)
+ (>= (- (agenda-time) (last-shot player))
+ (shot-interval player)))
+ (let ((p (position player)))
+ (set! (last-shot player) (agenda-time))
+ (add-bullet bullets
+ player-primary-bullet
+ (vec2 (vec2-x p) (+ (vec2-y p) 14.0))
+ (vec2 0.0 6.0))))))