From 58266627bf3ea66dfc6f8434c32304758d1d9e98 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Fri, 15 Oct 2021 23:29:49 -0400 Subject: Day 1 check-in. --- Makefile.am | 11 +++ assets/fonts/Chonkly.otf | Bin 0 -> 10668 bytes assets/images/bee.png | Bin 0 -> 2678 bytes assets/images/bee.xcf | Bin 0 -> 28100 bytes assets/images/bullets.png | Bin 0 -> 1514 bytes assets/images/bullets.xcf | Bin 0 -> 3001 bytes bonnie-bee/actor.scm | 67 ++++++++++++++++++ bonnie-bee/assets.scm | 16 +++++ bonnie-bee/bullet.scm | 168 ++++++++++++++++++++++++++++++++++++++++++++++ bonnie-bee/common.scm | 24 +++++++ bonnie-bee/game.scm | 79 ++++++++++++++++++++++ bonnie-bee/player.scm | 44 ++++++++++++ bonnie-bee/pollen.scm | 11 +++ bonnie-bee/splash.scm | 38 ++++++++++- 14 files changed, 457 insertions(+), 1 deletion(-) create mode 100644 assets/fonts/Chonkly.otf create mode 100644 assets/images/bee.png create mode 100644 assets/images/bee.xcf create mode 100644 assets/images/bullets.png create mode 100644 assets/images/bullets.xcf create mode 100644 bonnie-bee/actor.scm create mode 100644 bonnie-bee/assets.scm create mode 100644 bonnie-bee/bullet.scm create mode 100644 bonnie-bee/common.scm create mode 100644 bonnie-bee/game.scm create mode 100644 bonnie-bee/player.scm create mode 100644 bonnie-bee/pollen.scm diff --git a/Makefile.am b/Makefile.am index f1a2592..441b145 100644 --- a/Makefile.am +++ b/Makefile.am @@ -25,7 +25,18 @@ bin_SCRIPTS = \ scripts/bonnie-bee SOURCES = \ + bonnie-bee/common.scm \ + bonnie-bee/assets.scm \ + bonnie-bee/actor.scm \ + bonnie-bee/player.scm \ + bonnie-bee/bullet.scm \ + bonnie-bee/pollen.scm \ + bonnie-bee/game.scm \ bonnie-bee/splash.scm +fontsdir = $(pkgdatadir)/assets/fonts +dist_fonts_DATA = \ + assets/fonts/Chonkly.otf + EXTRA_DIST += \ COPYING diff --git a/assets/fonts/Chonkly.otf b/assets/fonts/Chonkly.otf new file mode 100644 index 0000000..fc64a65 Binary files /dev/null and b/assets/fonts/Chonkly.otf differ diff --git a/assets/images/bee.png b/assets/images/bee.png new file mode 100644 index 0000000..7fec5ef Binary files /dev/null and b/assets/images/bee.png differ diff --git a/assets/images/bee.xcf b/assets/images/bee.xcf new file mode 100644 index 0000000..b6c7e9e Binary files /dev/null and b/assets/images/bee.xcf differ diff --git a/assets/images/bullets.png b/assets/images/bullets.png new file mode 100644 index 0000000..917ac17 Binary files /dev/null and b/assets/images/bullets.png differ diff --git a/assets/images/bullets.xcf b/assets/images/bullets.xcf new file mode 100644 index 0000000..c7209a9 Binary files /dev/null and b/assets/images/bullets.xcf differ diff --git a/bonnie-bee/actor.scm b/bonnie-bee/actor.scm new file mode 100644 index 0000000..db49372 --- /dev/null +++ b/bonnie-bee/actor.scm @@ -0,0 +1,67 @@ +(define-module (bonnie-bee actor) + #:use-module (chickadee data quadtree) + #:use-module (chickadee math rect) + #:use-module (chickadee math vector) + #:use-module (oop goops) + #:use-module (starling node) + #:use-module (starling node-2d) + #:export ( + velocity + hitbox + world-hitbox + quadtree + on-collide)) + +(define-class () + (velocity #:getter 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 (add-to-quadtree (actor )) + (quadtree-insert! (quadtree actor) (world-hitbox actor) actor)) + +(define-method (remove-from-quadtree (actor )) + (quadtree-delete! (quadtree actor) (world-hitbox actor) actor)) + +(define-method (refresh-world-hitbox (actor )) + (let ((p (position actor)) + (h (hitbox actor)) + (wh (world-hitbox actor))) + (set-rect-x! wh (+ (vec2-x p) (rect-x h))) + (set-rect-y! wh (+ (vec2-y p) (rect-y h))) + (set-rect-width! wh (rect-width h)) + (set-rect-height! wh (rect-height h)))) + +(define-method (on-collide a b) + (pk 'unhandled-collision a b) + #f) + +(define-method (on-enter (actor )) + (refresh-world-hitbox actor) + (add-to-quadtree actor)) + +(define-method (update (actor ) dt) + (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)))) diff --git a/bonnie-bee/assets.scm b/bonnie-bee/assets.scm new file mode 100644 index 0000000..3c71bcc --- /dev/null +++ b/bonnie-bee/assets.scm @@ -0,0 +1,16 @@ +(define-module (bonnie-bee assets) + #:use-module (chickadee audio) + #:use-module (chickadee graphics font) + #:use-module (chickadee graphics texture) + #:use-module (starling asset) + #:export (chonkly-font + bee-atlas + bullet-atlas)) + +(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 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)) diff --git a/bonnie-bee/bullet.scm b/bonnie-bee/bullet.scm new file mode 100644 index 0000000..ecf7b53 --- /dev/null +++ b/bonnie-bee/bullet.scm @@ -0,0 +1,168 @@ +(define-module (bonnie-bee bullet) + #:use-module (bonnie-bee actor) + #:use-module (bonnie-bee assets) + #:use-module (chickadee data quadtree) + #:use-module (chickadee graphics sprite) + #:use-module (chickadee graphics texture) + #:use-module (chickadee math matrix) + #:use-module (chickadee math rect) + #:use-module (chickadee math vector) + #:use-module (chickadee utils) + #:use-module (oop goops) + #:use-module (starling asset) + #:use-module (starling node) + #:use-module (starling node-2d) + #:export ( + type + pollen-pickup + + add-bullet)) + +(define-class () + (type #:getter type #:init-keyword #:type) + (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))) + +(define pollen-pickup + (make #:type 'pollen #:atlas-index 6 + #:hitbox (make-rect -10.0 -10.0 20.0 20.0))) + +(define (make-bullet-sprite-batch) + (make-sprite-batch + (texture-parent + (texture-atlas-ref (asset-ref bullet-atlas) 0)))) + +(define (make-vector* size thunk) + (let ((v (make-vector size))) + (for-range ((i size)) + (vector-set! v i (thunk))) + v)) + +(define (make-null-vec2) + (vec2 0.0 0.0)) + +(define (make-null-rect) + (make-rect 0.0 0.0 0.0 0.0)) + +(define %max-bullets 2048) +(define %identity-matrix (make-identity-matrix4)) + +(define-class () + (quadtree #:getter quadtree #:init-keyword #:quadtree) + (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 ) bullet position velocity) + (let ((i (size bullets))) + (when (< i (capacity bullets)) + (let ((bh (hitbox bullet)) + (v (vector-ref (velocities bullets) i)) + (h (vector-ref (hitboxes bullets) i)) + (r (vector-ref (regions bullets) i))) + (vector-set! (descriptors bullets) i bullet) + (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))) + (set-rect-width! h (rect-width bh)) + (set-rect-height! h (rect-height bh)) + (set-rect-x! r (- (vec2-x position) 8.0)) + (set-rect-y! r (- (vec2-y position) 8.0)) + (set-rect-width! r 16.0) + (set-rect-height! r 16.0) + (set! (size bullets) (+ i 1)) + (quadtree-insert! (quadtree bullets) r bullet))))) + +(define-method (remove-bullet (bullets ) i) + (let* ((s (- (size bullets) 1)) + (ds (descriptors bullets)) + (rs (regions bullets)) + (vs (velocities bullets)) + (hs (hitboxes bullets)) + (q (quadtree bullets)) + (d (vector-ref ds i)) + (r (vector-ref rs i)) + (v (vector-ref vs i)) + (h (vector-ref hs i))) + (when (or (> i s) (< i 0)) + (error "bullet index out of bounds" 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)) + (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))) + +(define-method (render (bullets ) alpha) + (let ((ds (descriptors bullets)) + (rs (regions bullets)) + (b (batch bullets))) + (sprite-batch-clear! b) + (for-range ((i (size bullets))) + (let ((d (vector-ref ds i)) + (r (vector-ref rs i))) + (sprite-batch-add* b r %identity-matrix + #:texture-region (bullet-texture d)))) + (draw-sprite-batch* b (world-matrix bullets)))) + +(define-method (update (bullets ) dt) + (let ((ds (descriptors bullets)) + (rs (regions bullets)) + (vs (velocities bullets)) + (hs (hitboxes bullets)) + (q (quadtree bullets))) + (let loop ((i 0)) + (when (< i (size bullets)) + (let ((d (vector-ref ds i)) + (r (vector-ref rs i)) + (v (vector-ref vs i)) + (h (vector-ref hs i))) + (cond + ((or (< (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) + (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 ) + (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) + (loop (+ i 1))))))))) diff --git a/bonnie-bee/common.scm b/bonnie-bee/common.scm new file mode 100644 index 0000000..fa9f14a --- /dev/null +++ b/bonnie-bee/common.scm @@ -0,0 +1,24 @@ +(define-module (bonnie-bee common) + #:use-module (chickadee graphics color) + #:use-module (chickadee graphics viewport) + #:use-module (chickadee math vector) + #:use-module (oop goops) + #:use-module (starling scene) + #:use-module (starling node-2d) + #:export (%window-width + %window-height + %game-width + %game-height + set-cameras!)) + +(define %window-width 960) +(define %window-height 720) +(define %game-width 320) +(define %game-height 240) + +(define-method (set-cameras! (scene )) + (set! (cameras scene) + (list (make + #:resolution (vec2 %game-width %game-height) + #:viewport (make-viewport 0 0 %window-width %window-height + #:clear-color black))))) diff --git a/bonnie-bee/game.scm b/bonnie-bee/game.scm new file mode 100644 index 0000000..5290ab8 --- /dev/null +++ b/bonnie-bee/game.scm @@ -0,0 +1,79 @@ +(define-module (bonnie-bee game) + #:use-module (bonnie-bee actor) + #:use-module (bonnie-bee assets) + #:use-module (bonnie-bee bullet) + #:use-module (bonnie-bee common) + #:use-module (bonnie-bee player) + #:use-module (chickadee data quadtree) + #:use-module (chickadee graphics color) + #:use-module (chickadee math rect) + #:use-module (chickadee math vector) + #:use-module (chickadee scripting) + #:use-module (oop goops) + #:use-module (starling kernel) + #:use-module (starling node) + #:use-module (starling node-2d) + #:use-module (starling scene) + #:export ()) + +(define %game-bounds (make-rect 0.0 0.0 %game-width %game-height)) + +(define-class () + (quadtree #:getter quadtree #:init-form (make-quadtree %game-bounds))) + +(define-method (on-boot (game )) + (set-cameras! game) + (attach-to game + (make + #: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 ) (actor )) + (set! (quadtree actor) (quadtree game)) + (attach-to game actor)) + +(define-method (on-enter (game )) + (spawn game + (make + #: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 player)) + +(define-method (on-key-press (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)))) + +(define-method (on-key-release (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)))) diff --git a/bonnie-bee/player.scm b/bonnie-bee/player.scm new file mode 100644 index 0000000..6e8f7fb --- /dev/null +++ b/bonnie-bee/player.scm @@ -0,0 +1,44 @@ +(define-module (bonnie-bee player) + #:use-module (bonnie-bee actor) + #:use-module (bonnie-bee assets) + #:use-module (chickadee math vector) + #:use-module (oop goops) + #:use-module (starling node) + #:use-module (starling node-2d) + #:export ( + move-left? + move-right? + move-down? + move-up? + shoot? + speed + lives + pollen)) + +(define-class () + (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) + (speed #:accessor speed #:init-value 2.0) + (lives #:accessor lives #:init-value 3) + (pollen #:accessor pollen #:init-value 0)) + +(define-method (on-boot (player )) + (attach-to player + (make + #:atlas bee-atlas + #:index 12 + #:origin (vec2 16.0 16.0)))) + +(define-method (update (player ) dt) + (let ((v (velocity player))) + (set-vec2! v + (+ (if (move-left? player) -1.0 0.0) + (if (move-right? player) 1.0 0.0)) + (+ (if (move-down? player) -1.0 0.0) + (if (move-up? player) 1.0 0.0))) + (vec2-normalize! v) + (vec2-mult! v (speed player))) + (next-method)) diff --git a/bonnie-bee/pollen.scm b/bonnie-bee/pollen.scm new file mode 100644 index 0000000..97aaf0e --- /dev/null +++ b/bonnie-bee/pollen.scm @@ -0,0 +1,11 @@ +(define-module (bonnie-bee pollen) + #:use-module (bonnie-bee actor) + #:use-module (bonnie-bee assets) + #:use-module (chickadee math rect) + #:use-module (chickadee math vector) + #:use-module (oop goops) + #:use-module (starling node) + #:use-module (starling node-2d) + #:export ()) + +(define-class ()) diff --git a/bonnie-bee/splash.scm b/bonnie-bee/splash.scm index 0c2a507..292fd05 100644 --- a/bonnie-bee/splash.scm +++ b/bonnie-bee/splash.scm @@ -1,5 +1,41 @@ (define-module (bonnie-bee splash) + #:use-module (bonnie-bee assets) + #:use-module (bonnie-bee common) + #:use-module (bonnie-bee game) + #:use-module (chickadee graphics color) + #:use-module (chickadee math vector) + #:use-module (chickadee scripting) + #:use-module (oop goops) + #:use-module (starling kernel) + #:use-module (starling node) + #:use-module (starling node-2d) + #:use-module (starling scene) #:export (launch-game)) +(define-class ()) + +(define-method (on-boot (splash )) + (set-cameras! splash) + (attach-to splash + (make