diff options
Diffstat (limited to 'bonnie-bee')
| -rw-r--r-- | bonnie-bee/actor.scm | 60 | ||||
| -rw-r--r-- | bonnie-bee/assets.scm | 4 | ||||
| -rw-r--r-- | bonnie-bee/bullet.scm | 109 | ||||
| -rw-r--r-- | bonnie-bee/flower.scm | 37 | ||||
| -rw-r--r-- | bonnie-bee/game.scm | 50 | ||||
| -rw-r--r-- | bonnie-bee/player.scm | 35 |
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)))))) |