Friday's progress. lots of placeholder art.

24 files changed, 173 insertions, 103 deletions

diff --git a/background.tsx b/background.tsx
new file mode 100644
index 0000000..f3b35d0
--- /dev/null
+++ b/background.tsx
@@ -0,0 +1,4 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<tileset version="1.8" tiledversion="1.8.6" name="background" tilewidth="240" tileheight="320" tilecount="1" columns="1">
+ <image source="images/background.png" width="240" height="320"/>
+</tileset>
diff --git a/fonts/VT323-Regular.ttf b/fonts/VT323-Regular.ttf
new file mode 100644
index 0000000..6aec599
--- /dev/null
+++ b/fonts/VT323-Regular.ttf
diff --git a/game.scm b/game.scm
index 33db2df..f746c29 100644
--- a/game.scm
+++ b/game.scm
@@ -132,6 +132,9 @@
        "image" "new"
        (ref string) -> (ref extern))
 
+     ;; Record types are only just beginning to be added to Hoot and
+     ;; there isn't support for mutable structs, yet. So, tagged
+     ;; vectors will have to do.
      (define-syntax-rule (define-type name
                            constructor
                            predicate
@@ -157,40 +160,41 @@
                   (vector-set! obj i val))))))
          ...))
 
-     ;; TODO: Add basic fmod as inline wasm function
-
-     ;; Hoot's exact and inexact aren't working right.  These next two
-     ;; procedures are alternatives for now.
-     (define (trunc x)
-       ;; rational? is also borked so can't use that here.
-       (unless (and (number? x) (inexact? x))
-         (error "expected inexact rational" x))
+     (define (assert-float x)
+       (unless (and (number? x) (inexact? x) (rational? x))
+         (error "expected inexact rational" x)))
+     (define (truncate x)
+       (assert-float x)
        (%inline-wasm
         '(func (param $x (ref eq)) (result (ref eq))
                (call $s64->scm
                      (i64.trunc_f64_s
                       (struct.get $flonum $val (ref.cast $flonum (local.get $x))))))
         x))
-     (define (inexact x)
-       (unless (exact-integer? x)
-         (error "expected exact integer" x))
+     (define (fmod x y)
+       (assert-float x)
+       (assert-float y)
        (%inline-wasm
-        '(func (param $x (ref eq)) (result (ref eq))
-               (if (ref eq)
-                   (call $fixnum? (local.get $x))
-                   (then
-                    (struct.new $flonum
-                                (i32.const 0)
-                                (f64.convert_i32_s
-                                 (call $fixnum->i32 (ref.cast i31 (local.get $x))))))
-                   (else
-                    (struct.new $flonum
-                                (i32.const 0)
-                                (f64.convert_i64_s
-                                 (call $bignum-get-i64
-                                       (struct.get $bignum $val
-                                                   (ref.cast $bignum (local.get $x)))))))))
-        x))
+        '(func (param $x (ref eq)) (param $y (ref eq)) (result (ref eq))
+               (struct.new
+                $flonum
+                (i32.const 0)
+                (f64.sub (struct.get
+                          $flonum $val
+                          (ref.cast $flonum (local.get $x)))
+                         (f64.mul
+                          (f64.trunc
+                           (f64.div
+                            (struct.get $flonum $val
+                                        (ref.cast $flonum
+                                                  (local.get $x)))
+                            (struct.get $flonum $val
+                                        (ref.cast $flonum
+                                                  (local.get $y)))))
+                          (struct.get $flonum $val
+                                      (ref.cast $flonum
+                                                (local.get $y)))))))
+        x y))
 
      (define s32-ref bytevector-s32-native-ref)
      (define s32-set! bytevector-s32-native-set!)
@@ -198,7 +202,6 @@
      (define f64-set! bytevector-ieee-double-native-set!)
 
      (define pi (* 4.0 (atan 1.0)))
-     (define 2pi (* 2.0 pi))
      (define pi/2 (/ pi 2.0))
      (define tau (* pi 2.0))
 
@@ -305,7 +308,11 @@
      (define image:player-bullets (load-image "images/player-bullets.png"))
      (define image:enemy-bullets (load-image "images/enemy-bullets.png"))
      (define image:map (load-image "images/map.png"))
-     (define image:enemies (load-image "images/enemies.png"))
+     (define image:turret (load-image "images/turret.png"))
+     (define image:popcorn (load-image "images/popcorn.png"))
+     (define image:flyer0 (load-image "images/flyer0.png"))
+     (define image:flyer1 (load-image "images/flyer1.png"))
+     (define image:boss (load-image "images/boss.png"))
      (define image:particles (load-image "images/particles.png"))
      (define sound:explosion (load-sound-effect "audio/explosion.wav"))
      (define sound:player-shoot (load-sound-effect "audio/player-shoot.wav"))
@@ -482,7 +489,7 @@
          (sound-effect-play sound:explosion)
          (do ((i 0 (+ i 1)))
              ((= i 16))
-           (let ((theta (* 2pi (/ i 16.0))))
+           (let ((theta (* tau (/ i 16.0))))
              (particle-pool-add! particles 'explosion 20 x y
                                  (* (cos theta) speed) (* (sin theta) speed))))))
 
@@ -609,8 +616,8 @@
      (define (point-collides-with-level? level x y)
        (match level
          (#('level height foreground collision objects)
-          (let ((tx (trunc (/ x tile-width)))
-                (ty (trunc (/ y tile-height))))
+          (let ((tx (truncate (/ x tile-width)))
+                (ty (truncate (/ y tile-height))))
             (and (>= tx 0) (< tx level-width)
                  (>= ty 0) (< tx height)
                  (= (bytevector-u8-ref collision (level-offset tx ty)) 1))))))
@@ -618,10 +625,10 @@
        (match level
          (#('level height foreground collision objects)
           (let* ((y (+ y (- (* height tile-height) game-height *scroll*)))
-                 (tx0 (trunc (/ x tile-width)))
-                 (ty0 (trunc (/ y tile-height)))
-                 (tx1 (trunc (/ (+ x w) tile-width)))
-                 (ty1 (trunc (/ (+ y h) tile-height))))
+                 (tx0 (truncate (/ x tile-width)))
+                 (ty0 (truncate (/ y tile-height)))
+                 (tx1 (truncate (/ (+ x w) tile-width)))
+                 (ty1 (truncate (/ (+ y h) tile-height))))
             (define (occupied? x y)
               (and (>= x 0) (< x level-width)
                    (>= y 0) (< x height)
@@ -637,7 +644,7 @@
                  (th tile-height)
                  (scroll (* *scroll* parallax))
                  (pixel-y-offset (- (* height th) scroll game-height))
-                 (scroll-y-offset (- height (trunc (/ scroll tile-height))))
+                 (scroll-y-offset (- height (truncate (/ scroll tile-height))))
                  (y-start (clamp (- scroll-y-offset 21) 0 height))
                  (y-end (clamp scroll-y-offset 0 height)))
             (do ((y y-start (+ y 1)))
@@ -664,7 +671,7 @@
           (let ((scroll (min (+ *scroll* *scroll-speed*) max-scroll)))
             (set! *last-scroll* *scroll*)
             (set! *scroll* scroll)
-            (let ((row (max (- (trunc
+            (let ((row (max (- (truncate
                                 (/ (- (* height tile-height)
                                       game-height scroll)
                                    tile-height)) 2)
@@ -674,13 +681,17 @@
                 (for-each (lambda (obj)
                             (match obj
                               (#('level-object x type)
-                               (match type
-                                 ('enemy-a
-                                  (spawn-enemy-a (+ (* x tile-width)
-                                                    (/ tile-width 2.0))
-                                                 (+ (* (- y row 3) tile-height)
-                                                    (/ tile-height 2.0))))
-                                 (_ #t)))))
+                               (let ((x* (+ (* x tile-width)
+                                            (/ tile-width 2.0)))
+                                     (y* (+ (* (- y row 3) tile-height)
+                                            (/ tile-height 2.0))))
+                                 (match type
+                                   ('turret (spawn-turret x* y*))
+                                   ('popcorn (spawn-popcorn x* y*))
+                                   ('flyer0 (spawn-flyer0 x* y*))
+                                   ('flyer1 (spawn-flyer1 x* y*))
+                                   ('boss (spawn-boss x* y*))
+                                   (_ #t))))))
                           (vector-ref objects y)))
               (set! *last-row-scanned* row))))))
 
@@ -698,11 +709,13 @@
        (points enemy-points set-enemy-points!)
        (spawn-time enemy-spawn-time set-enemy-spawn-time!)
        (animation enemy-animation set-enemy-animation!)
-       (image enemy-image set-enemy-image!))
+       (image enemy-image set-enemy-image!)
+       (image-size enemy-image-size set-enemy-image-size!))
      (define (make-enemy type health position size stationary? velocity
-                         script points animation image)
+                         script points animation image image-size)
        (%make-enemy type health position size stationary? velocity script
-                    points (inexact (current-jiffy)) animation image))
+                    points (inexact (current-jiffy)) animation image
+                    image-size))
      (define (enemy-x enemy)
        (vec2-x (enemy-position enemy)))
      (define (enemy-y enemy)
@@ -717,18 +730,18 @@
        (vec2-y (enemy-velocity enemy)))
      (define (enemy-damage! enemy damage)
        (match enemy
-         (#('enemy type health _ _ _ _ _ _ _ _ _)
+         (#('enemy type health _ _ _ _ _ _ _ _ _ _)
           (set-enemy-health! enemy (- health damage)))))
      (define (enemy-dead? enemy)
        (<= (enemy-health enemy) 0))
      (define (enemy-out-of-bounds? enemy)
        (match enemy
-         (#('enemy _ _ position size _ _ _ _ _ _ _)
+         (#('enemy _ _ position size _ _ _ _ _ _ _ _)
           (out-of-bounds? (vec2-x position) (vec2-y position)
                           (vec2-x size) (vec2-y size)))))
      (define (enemy-within-rect? enemy x y w h)
        (match enemy
-         (#('enemy _ _ position size _ _ _ _ _ _ _)
+         (#('enemy _ _ position size _ _ _ _ _ _ _ _)
           (let* ((w* (vec2-x size))
                  (h* (vec2-y size))
                  (x* (- (vec2-x position) (/ w* 2.0)))
@@ -744,7 +757,7 @@
            (script-cancel! script))))
      (define (enemy-update! enemy)
        (match enemy
-         (#('enemy _ _ position size stationary? velocity _ _ _ _ _)
+         (#('enemy _ _ position size stationary? velocity _ _ _ _ _ _)
           (if stationary?
               (set-vec2-y! position (+ (vec2-y position) (- *scroll* *last-scroll*)))
               (begin
@@ -753,18 +766,19 @@
      (define (draw-enemy enemy time)
        (let ((frame-duration 250.0))
          (match enemy
-           (#('enemy type _ position size _ _ _ _ spawn-time animation image)
+           (#('enemy type _ position size _ _ _ _ spawn-time animation
+                     image image-size)
             (let* ((tx (vector-ref animation
-                                   (modulo (trunc
-                                            (remainder (- time spawn-time)
-                                                       frame-duration))
+                                   (modulo (truncate
+                                            (fmod (- time spawn-time)
+                                                  frame-duration))
                                            (vector-length animation))))
                    (x (vec2-x position))
                    (y (vec2-y position))
                    (hbw (vec2-x size))
                    (hbh (vec2-y size))
-                   (w 64.0)
-                   (h 64.0))
+                   (w (vec2-x image-size))
+                   (h (vec2-y image-size)))
               (draw-image context image tx 0.0 w h
                           (- x (/ w 2.0)) (- y (/ h 2.0)) w h)
               (set-fill-color! context "#ff00ff80")
@@ -821,6 +835,8 @@
                       (explode (enemy-x enemy) (enemy-y enemy))
                       (set! *player-score*
                             (+ *player-score* (enemy-points enemy))))
+                    (when (eq? (enemy-type enemy) 'boss)
+                      (set! *game-state* 'game-win))
                     (enemy-pool-remove! pool i)
                     (loop i (- k 1)))
                    (else
@@ -843,7 +859,10 @@
 
      (define enemies (make-enemy-pool 64))
 
-     (define (spawn-enemy-a x y)
+     (define (spawn-enemy enemy)
+       (enemy-pool-add! enemies enemy))
+
+     (define (spawn-turret x y)
        (define (script enemy)
          (let ((speed 2.0))
            (wait 60)
@@ -859,10 +878,34 @@
                                  (* (vec2-y v) speed)))
              (wait 30)
              (loop (+ theta 0.2)))))
-       (let ((enemy (make-enemy 'foo 20 (vec2 x y) (vec2 16.0 16.0)
-                                #t (vec2 0.0 0.0) script 100
-                                #(0.0 0.0 0.0 0.0) image:enemies)))
-         (enemy-pool-add! enemies enemy)))
+       (spawn-enemy
+        (make-enemy 'turret 10 (vec2 x y) (vec2 16.0 16.0)
+                    #t (vec2 0.0 0.0) script 100
+                    #(0.0 0.0 0.0 0.0) image:turret (vec2 64.0 64.0))))
+
+     (define (spawn-popcorn x y)
+       (spawn-enemy
+        (make-enemy 'popcorn 1 (vec2 x y) (vec2 16.0 16.0)
+                    #t (vec2 0.0 0.0) #f 100
+                    #(0.0 0.0 0.0 0.0) image:popcorn (vec2 32.0 32.0))))
+
+     (define (spawn-flyer0 x y)
+       (spawn-enemy
+        (make-enemy 'flyer0 20 (vec2 x y) (vec2 16.0 16.0)
+                    #t (vec2 0.0 0.0) #f 100
+                    #(0.0 0.0 0.0 0.0) image:flyer0 (vec2 32.0 32.0))))
+
+     (define (spawn-flyer1 x y)
+       (spawn-enemy
+        (make-enemy 'flyer1 10 (vec2 x y) (vec2 16.0 16.0)
+                    #t (vec2 0.0 0.0) #f 100
+                    #(0.0 0.0 0.0 0.0) image:flyer1 (vec2 32.0 32.0))))
+
+     (define (spawn-boss x y)
+       (spawn-enemy
+        (make-enemy 'boss 100 (vec2 x y) (vec2 100.0 40.0)
+                    #t (vec2 0.0 0.0) #f 1000000
+                    #(0.0 0.0 0.0 0.0) image:boss (vec2 120.0 80.0))))
 
      ;; Player state:
      (define player-position (vec2 (/ game-width 2.0) (- game-height 12.0)))
@@ -956,21 +999,26 @@
                (dy -1.0))
            (particle-pool-add! particles 'muzzle-flash life x y ldx dy)
            (particle-pool-add! particles 'muzzle-flash life x y rdx dy)))
-       (vec2-add! player-position player-velocity)
-       (vec2-clamp! player-position 0.0 0.0 game-width game-height)
-       (set-vec2-x! player-hitbox-position
-                    (- (vec2-x player-position)
-                       (/ player-hitbox-width 2.0)))
-       (set-vec2-y! player-hitbox-position
-                    (- (vec2-y player-position)
-                       (/ player-hitbox-height 2.0)))
-       (when (and (let ((x (vec2-x player-hitbox-position))
-                        (y (vec2-y player-hitbox-position))
-                        (w player-hitbox-width)
-                        (h player-hitbox-height))
-                    (or (rect-collides-with-level? level x y w h)
-                        (find-enemy enemies x y w h))))
-         (player-die!))
+       (let ((old-x (vec2-x player-position))
+             (old-y (vec2-y player-position)))
+         (vec2-add! player-position player-velocity)
+         (vec2-clamp! player-position 0.0 0.0 game-width game-height)
+         (let ((x (vec2-x player-position))
+               (y (vec2-y player-position))
+               (hbx (vec2-x player-hitbox-position))
+               (hby (vec2-y player-hitbox-position))
+               (hbw player-hitbox-width)
+               (hbh player-hitbox-height))
+           (if (or (rect-collides-with-level? level x y hbw hbh)
+                   (find-enemy enemies x y hbw hbh))
+               (begin
+                 (set-vec2-x! player-position old-x)
+                 (set-vec2-y! player-position
+                              (+ old-y (- *scroll* *last-scroll*)))
+                 (player-die!))
+               (begin
+                 (set-vec2-x! player-hitbox-position (- x (/ hbw 2.0)))
+                 (set-vec2-y! player-hitbox-position (- y (/ hbh 2.0)))))))
        (when (firing?)
          (set! *player-fire-counter*
                (modulo (+ *player-fire-counter* 1)
@@ -1033,8 +1081,8 @@
        (let* ((win (current-window))
               (w (window-inner-width win))
               (h (window-inner-height win))
-              (gw (trunc game-width))
-              (gh (trunc game-height))
+              (gw (truncate game-width))
+              (gh (truncate game-height))
               (scale (max (min (quotient w gw) (quotient h gh)) 1))
               (cw (* gw scale))
               (ch (* gh scale)))
@@ -1055,7 +1103,7 @@
        (draw-bullets enemy-bullets))
 
      (define (draw-background image parallax)
-       (let ((scroll (remainder (* *scroll* parallax) game-height)))
+       (let ((scroll (fmod (* *scroll* parallax) game-height)))
          ;; Bottom
          (draw-image context image
                      0.0 0.0 game-width (- game-height scroll)
@@ -1067,8 +1115,8 @@
 
      (define (draw-hud)
        (let ((y (- game-height 8.0)))
-         ;; TODO: Don't strings every frame when the UI values rarely
-         ;; change.
+         ;; TODO: Don't allocate strings every frame when the UI
+         ;; values rarely change.
          (set-fill-color! context "#ffffff")
          (set-font! context "bold 16px monospace")
          (set-text-align! context "right")
@@ -1081,9 +1129,6 @@
        (clear-screen)
        (set-transform! context 1.0 0.0 0.0 1.0 0.0 0.0)
        (set-scale! context *canvas-scale* *canvas-scale*)
-       (set-fill-color! context "#3f2832")
-       (fill-rect context 0.0 0.0 game-width game-height)
-       ;; (draw-level-background level)
        (draw-background image:background 0.75)
        (draw-level-foreground level)
        (draw-particles particles)
diff --git a/images/background.ase b/images/background.ase
index 93a3150..62fce24 100644
--- a/images/background.ase
+++ b/images/background.ase
diff --git a/images/background.png b/images/background.png
index 00db1c4..7513677 100644
--- a/images/background.png
+++ b/images/background.png
diff --git a/images/background2.ase b/images/background2.ase
new file mode 100644
index 0000000..70d6ce4
--- /dev/null
+++ b/images/background2.ase
diff --git a/images/background2.png b/images/background2.png
new file mode 100644
index 0000000..ce7dcf7
--- /dev/null
+++ b/images/background2.png
diff --git a/images/boss.ase b/images/boss.ase
new file mode 100644
index 0000000..2cd8f96
--- /dev/null
+++ b/images/boss.ase
diff --git a/images/boss.png b/images/boss.png
new file mode 100644
index 0000000..17c2b22
--- /dev/null
+++ b/images/boss.png
diff --git a/images/enemies.ase b/images/enemies.ase
deleted file mode 100644
index 82c84ec..0000000
--- a/images/enemies.ase
+++ /dev/null
diff --git a/images/enemies.png b/images/enemies.png
deleted file mode 100644
index ab4161d..0000000
--- a/images/enemies.png
+++ /dev/null
diff --git a/images/enemy-bullets.png b/images/enemy-bullets.png
index c50da59..fec7c42 100644
--- a/images/enemy-bullets.png
+++ b/images/enemy-bullets.png
diff --git a/images/flyer0.ase b/images/flyer0.ase
new file mode 100644
index 0000000..f7e7ce8
--- /dev/null
+++ b/images/flyer0.ase
diff --git a/images/flyer0.png b/images/flyer0.png
new file mode 100644
index 0000000..2566428
--- /dev/null
+++ b/images/flyer0.png
diff --git a/images/flyer1.ase b/images/flyer1.ase
new file mode 100644
index 0000000..d64c89a
--- /dev/null
+++ b/images/flyer1.ase
diff --git a/images/flyer1.png b/images/flyer1.png
new file mode 100644
index 0000000..4292f5b
--- /dev/null
+++ b/images/flyer1.png
diff --git a/images/player.ase b/images/player.ase
index 53dfcae..51878b1 100644
--- a/images/player.ase
+++ b/images/player.ase
diff --git a/images/popcorn.ase b/images/popcorn.ase
new file mode 100644
index 0000000..a9da08c
--- /dev/null
+++ b/images/popcorn.ase
diff --git a/images/popcorn.png b/images/popcorn.png
new file mode 100644
index 0000000..ad843e9
--- /dev/null
+++ b/images/popcorn.png
diff --git a/images/turret.ase b/images/turret.ase
new file mode 100644
index 0000000..0cfe325
--- /dev/null
+++ b/images/turret.ase
diff --git a/images/turret.png b/images/turret.png
new file mode 100644
index 0000000..1e068f8
--- /dev/null
+++ b/images/turret.png
diff --git a/js-runtime/reflect.wasm b/js-runtime/reflect.wasm
index 64d1156..d3c857f 100644
--- a/js-runtime/reflect.wasm
+++ b/js-runtime/reflect.wasm
diff --git a/manifest.scm b/manifest.scm
index e5c2491..f98031e 100644
--- a/manifest.scm
+++ b/manifest.scm
@@ -12,21 +12,6 @@
              (gnu packages pkg-config)
              (gnu packages texinfo))
 
-(define guile-next-next
-  (let ((commit "79e836b8cc601a1259c934000a953a8d739ddd6f")
-        (revision "1"))
-    (package
-     (inherit guile-next)
-     (version (git-version "3.0.9" revision commit))
-     (source (origin
-              (method git-fetch)
-              (uri (git-reference
-                    (url "https://git.savannah.gnu.org/git/guile.git")
-                    (commit commit)))
-              (file-name (git-file-name "guile" version))
-              (sha256
-               (base32 "0s90khsdbvrkykp58izkvyxf8jciggdapm29dc3lzk3s1shajlgm")))))))
-
 (define guile-hoot
   (let ((commit "89b936e198b158fc4a43b43977d783f4f798f45c")
         (revision "1"))
@@ -48,11 +33,11 @@
      (native-inputs
       (list autoconf automake pkg-config texinfo))
      (inputs
-      (list guile-next-next))
+      (list guile-next))
      (synopsis "WASM compiler for Guile Scheme")
      (description "Guile-hoot is an ahead-of-time WebAssembly compiler for GNU Guile.")
      (home-page "https://gitlab.com/spritely/guile-hoot")
      (license (list license:asl2.0 license:lgpl3+)))))
 
-(packages->manifest (list ;; guile-next-next guile-hoot
+(packages->manifest (list guile-next ;; guile-hoot
                           gnu-make zip))
diff --git a/todo.org b/todo.org
new file mode 100644
index 0000000..ba29d81
--- /dev/null
+++ b/todo.org
@@ -0,0 +1,36 @@
+#+TITLE jam todo list
+
+* DONE tiled map compilation
+* DONE pause state
+* TODO intro state
+* DONE win state
+* DONE focus fire
+* DONE per bullet hitbox
+* TODO parallax tile object backgrounds
+* TODO player animation
+* DONE enemy animation
+* TODO turret enemy
+* TODO popcorn enemy
+* TODO flying enemy 1
+* TODO flying enemy 2 (maybe)
+* TODO boss
+* DONE scoring
+* TODO design map
+** phases
+- open, popcorn enemies
+  - easy, player gets used to controls
+- wall on one side, turrets + popcorn
+  - focus fire helps take down turrets faster
+- wide tunnel, flying enemies + popcorn
+- narrow tunnel, turrets shooting sideways
+  - need to move up/down screen to avoid
+- open, flying enemies + popcorn
+- scroll speed increases
+- narrow tunnel + popcorn
+  - quick left/right movement to avoid crashing
+- scrolling stops, top mounted turrets + flying enemies
+- scrolling resumes, popcorn
+- boss
+* TODO music track
+* DONE particles
+* TODO juice!