Enemy bullets and level scrolling.

4 files changed, 171 insertions, 92 deletions

diff --git a/game.scm b/game.scm
index 131cb65..8f1eb99 100644
--- a/game.scm
+++ b/game.scm
@@ -140,6 +140,11 @@
                                                 (ref.cast $bignum (local.get $x)))))))))
      x))
 
+  (define s32-ref bytevector-s32-native-ref)
+  (define s32-set! bytevector-s32-native-set!)
+  (define f64-ref bytevector-ieee-double-native-ref)
+  (define f64-set! bytevector-ieee-double-native-set!)
+
   (define pi (* 4.0 (atan 1.0)))
   (define pi/2 (/ pi 2.0))
   (define tau (* pi 2.0))
@@ -155,13 +160,13 @@
       (set-vec2-y! v y)
       v))
   (define (vec2-x v)
-    (bytevector-ieee-double-native-ref v 0))
+    (f64-ref v 0))
   (define (vec2-y v)
-    (bytevector-ieee-double-native-ref v 8))
+    (f64-ref v 8))
   (define (set-vec2-x! v x)
-    (bytevector-ieee-double-native-set! v 0 x))
+    (f64-set! v 0 x))
   (define (set-vec2-y! v y)
-    (bytevector-ieee-double-native-set! v 8 y))
+    (f64-set! v 8 y))
   (define (vec2-add! v w)
     (set-vec2-x! v (+ (vec2-x v) (vec2-x w)))
     (set-vec2-y! v (+ (vec2-y v) (vec2-y w))))
@@ -181,19 +186,19 @@
 
   (define (make-rect x y w h)
     (let ((r (make-bytevector (* 8 4))))
-      (bytevector-ieee-double-native-set! r 0 x)
-      (bytevector-ieee-double-native-set! r 8 y)
-      (bytevector-ieee-double-native-set! r 16 w)
-      (bytevector-ieee-double-native-set! r 24 h)
+      (f64-set! r 0 x)
+      (f64-set! r 8 y)
+      (f64-set! r 16 w)
+      (f64-set! r 24 h)
       r))
   (define (rect-x r)
-    (bytevector-ieee-double-native-ref r 0))
+    (f64-ref r 0))
   (define (rect-y r)
-    (bytevector-ieee-double-native-ref r 8))
+    (f64-ref r 8))
   (define (rect-w r)
-    (bytevector-ieee-double-native-ref r 16))
+    (f64-ref r 16))
   (define (rect-h r)
-    (bytevector-ieee-double-native-ref r 24))
+    (f64-ref r 24))
 
   (define (within? x y rx ry rw rh)
     (and (>= x rx)
@@ -222,9 +227,50 @@
   (define context (get-context canvas "2d"))
   (define image:player (get-element-by-id "image-player"))
   (define image:player-bullet (get-element-by-id "image-player-bullet"))
+  (define image:enemy-bullets (get-element-by-id "image-enemy-bullets"))
   (define image:map (get-element-by-id "image-map"))
   (define image:enemies (get-element-by-id "image-enemies"))
 
+  ;; Scripting
+  (define (make-scheduler max-tasks)
+    (vector 0 0 max-tasks (make-vector max-tasks)))
+  (define (scheduler-add! scheduler thunk delay)
+    (match scheduler
+      (#(ticks num-tasks max-tasks tasks)
+       (unless (= num-tasks max-tasks)
+         (vector-set! tasks num-tasks (cons (+ ticks delay) thunk))
+         (vector-set! scheduler 1 (+ num-tasks 1))))))
+  (define (scheduler-tick! scheduler)
+    (match scheduler
+      (#(ticks num-tasks max-tasks tasks)
+       (let ((t (+ ticks 1)))
+         (let loop ((i 0) (k num-tasks) (to-run '()))
+           (if (< i k)
+               (match (vector-ref tasks i)
+                 ((t* . thunk)
+                  (if (<= t* t)
+                      (let ((k* (- k 1)))
+                        (vector-set! tasks i (vector-ref tasks k*))
+                        (vector-set! tasks k* #f)
+                        (loop i k* (cons thunk to-run)))
+                      (loop (+ i 1) k to-run))))
+               (begin
+                 (vector-set! scheduler 0 t)
+                 (vector-set! scheduler 1 k)
+                 (for-each (lambda (thunk) (thunk)) to-run))))))))
+  (define *scheduler* (make-scheduler 100))
+
+  (define %script-tag (make-prompt-tag 'script))
+  (define (run-script thunk)
+    (define (run thunk)
+      (call-with-prompt %script-tag thunk handler))
+    (define (handler k delay)
+      (scheduler-add! *scheduler* (lambda () (run k)) delay))
+    (run thunk))
+  (define (wait delay)
+    (abort-to-prompt %script-tag delay))
+
+  ;; Bullets:
   ;; per bullet: type, x, y, dx, dy
   (define %bullet-size (+ 4 8 8 8 8))
   (define (make-bullet-pool capacity)
@@ -236,11 +282,11 @@
     (match pool
       (#(length capacity bullets)
        (let ((offset (bullet-pool-offset length)))
-         (bytevector-s32-native-set! bullets offset type)
-         (bytevector-ieee-double-native-set! bullets (+ offset 4) x)
-         (bytevector-ieee-double-native-set! bullets (+ offset 12) y)
-         (bytevector-ieee-double-native-set! bullets (+ offset 20) dx)
-         (bytevector-ieee-double-native-set! bullets (+ offset 28) dy)
+         (s32-set! bullets offset type)
+         (f64-set! bullets (+ offset 4) x)
+         (f64-set! bullets (+ offset 12) y)
+         (f64-set! bullets (+ offset 20) dx)
+         (f64-set! bullets (+ offset 28) dy)
          (vector-set! pool 0 (+ length 1))))))
   (define (bullet-pool-remove! pool i)
     (match pool
@@ -256,10 +302,10 @@
        (let loop ((i 0) (k length))
          (when (< i k)
            (let* ((offset (bullet-pool-offset i))
-                  (x (bytevector-ieee-double-native-ref bullets (+ offset 4)))
-                  (y (bytevector-ieee-double-native-ref bullets (+ offset 12)))
-                  (dx (bytevector-ieee-double-native-ref bullets (+ offset 20)))
-                  (dy (bytevector-ieee-double-native-ref bullets (+ offset 28)))
+                  (x (f64-ref bullets (+ offset 4)))
+                  (y (f64-ref bullets (+ offset 12)))
+                  (dx (f64-ref bullets (+ offset 20)))
+                  (dy (f64-ref bullets (+ offset 28)))
                   (x* (+ x dx))
                   (y* (+ y dy)))
              (cond
@@ -268,8 +314,8 @@
                (bullet-pool-remove! pool i)
                (loop i (- k 1)))
               (else
-               (bytevector-ieee-double-native-set! bullets (+ offset 4) x*)
-               (bytevector-ieee-double-native-set! bullets (+ offset 12) y*)
+               (f64-set! bullets (+ offset 4) x*)
+               (f64-set! bullets (+ offset 12) y*)
                (loop (+ i 1) k)))))))))
   (define (draw-bullets pool image w h)
     (match pool
@@ -277,25 +323,28 @@
        (do ((i 0 (+ i 1)))
            ((= i length))
          (let* ((offset (bullet-pool-offset i))
-                (type (bytevector-s32-native-ref bullets offset))
-                (x (bytevector-ieee-double-native-ref bullets (+ offset 4)))
-                (y (bytevector-ieee-double-native-ref bullets (+ offset 12))))
+                (type (s32-ref bullets offset))
+                (x (f64-ref bullets (+ offset 4)))
+                (y (f64-ref bullets (+ offset 12))))
            (draw-image context image (* type w) (* type h) w h
                        (- x (/ w 2.0)) (- y (/ w 2.0)) w h))))))
 
-  (define player-bullets (make-bullet-pool 100))
-  (define enemy-bullets (make-bullet-pool 200))
-
-  (define *scroll* game-width)
+  (define player-bullets (make-bullet-pool 200))
+  (define enemy-bullets (make-bullet-pool 400))
 
-  ;; Map:
+  ;; Scrolling level:
+  (define *scroll* 0.0)
+  (define *scroll-speed* 1.0)
+  (define (update-scroll!)
+    (set! *scroll* (+ *scroll* *scroll-speed*)))
   ;; sprite sheet offset, x, y
   (define %tile-size (+ 8 8 8))
   (define tile-width 16.0)
   (define tile-height 16.0)
+  (define level-width 15)
   (define (make-level tiles)
     (let ((k (length tiles)))
-      (unless (= (modulo k 15) 0)
+      (unless (= (modulo k level-width) 0)
         (error "incomplete level data"))
       (let ((bv (make-bytevector (* k %tile-size))))
         (let y-loop ((tiles tiles) (y 0))
@@ -304,7 +353,7 @@
             (tiles
              (y-loop
               (let x-loop ((tiles tiles) (x 0))
-                (if (< x 15)
+                (if (< x level-width)
                     (match tiles
                       ((t . rest)
                        (let ((n (match t
@@ -312,20 +361,25 @@
                                   ('X 0.0)
                                   ('\ 1.0)
                                   ('/ 2.0)))
-                             (offset (* (+ x (* y 15)) %tile-size)))
-                         (bytevector-ieee-double-native-set! bv offset n)
-                         (bytevector-ieee-double-native-set! bv (+ offset 8)
-                                                             (* (inexact x) tile-width))
-                         (bytevector-ieee-double-native-set! bv (+ offset 16)
-                                                             (* (inexact y) tile-height)))
+                             (offset (* (+ x (* y level-width)) %tile-size)))
+                         (f64-set! bv offset n)
+                         (f64-set! bv (+ offset 8)
+                                   (* (inexact x) tile-width))
+                         (f64-set! bv (+ offset 16)
+                                   (* (inexact y) tile-height)))
                        (x-loop rest (+ x 1))))
                     tiles))
               (+ y 1)))))
-        (list 15 (/ k 15) bv))))
+        (vector (/ k level-width) bv))))
   (define-syntax-rule (define-level name tile ...)
     (define name (make-level '(tile ...))))
   (define-level level
     X _ _ _ _ _ _ _ _ _ _ _ _ _ X
+    X X _ _ _ _ _ _ _ _ _ _ _ X X
+    X X X _ _ _ _ _ _ _ _ _ X X X
+    X X _ _ _ _ _ _ _ _ _ _ _ X X
+    X _ _ _ _ _ _ _ _ _ _ _ _ _ X
+    X _ _ _ _ _ _ _ _ _ _ _ _ _ X
     X _ _ _ _ _ _ _ _ _ _ _ _ _ X
     X _ _ _ _ _ _ _ _ _ _ _ _ _ X
     X _ _ _ _ _ _ _ _ _ _ _ _ _ X
@@ -346,48 +400,51 @@
     X X \ _ _ _ _ _ _ _ _ _ / X X
     X X X X X X X X X X X X X X X)
   (define (level-offset x y)
-    (* (+ (* 15 y) x) %tile-size))
+    (* (+ (* level-width y) x) %tile-size))
   (define (point-collides-with-level? level x y)
     (match level
-      ((width height tiles)
+      (#(height tiles)
        (let ((tx (trunc (/ x tile-width)))
              (ty (trunc (/ y tile-height))))
-         (and (>= tx 0) (< tx 15)
+         (and (>= tx 0) (< tx level-width)
               (>= ty 0) (< tx height)
-              (>= (bytevector-ieee-double-native-ref tiles (level-offset tx ty)) 0))))))
+              (>= (f64-ref tiles (level-offset tx ty)) 0))))))
   (define (rect-collides-with-level? level x y w h)
     (match level
-      ((width height tiles)
-       (let ((tx0 (trunc (/ x tile-width)))
-             (ty0 (trunc (/ y tile-height)))
-             (tx1 (trunc (/ (+ x w) tile-width)))
-             (ty1 (trunc (/ (+ y h) tile-height))))
+      (#(height tiles)
+       (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))))
          (define (occupied? x y)
-           (and (>= x 0) (< x 15)
+           (and (>= x 0) (< x level-width)
                 (>= y 0) (< x height)
-                (>= (bytevector-ieee-double-native-ref tiles (level-offset x y)) 0)))
+                (>= (f64-ref tiles (level-offset x y)) 0.0)))
          (or (occupied? tx0 ty0)
              (occupied? tx1 ty0)
              (occupied? tx1 ty1)
              (occupied? tx0 ty1))))))
   (define (draw-tiles level)
     (match level
-      ((width height tiles)
+      (#(height tiles)
        (let* ((tw tile-width)
               (th tile-height)
-              (y-end height)
-              (y-start (- y-end 20)))
-         (do ((y 0 (+ y 1)))
-             ((= y 20))
+              (pixel-y-offset (- (* height th) *scroll* game-height))
+              (scroll-y-offset (- height (trunc (/ *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)))
+             ((= y y-end))
            (do ((x 0 (+ x 1)))
-               ((= x 15))
-             (let* ((offset (* (+ (* 15 y) x) %tile-size))
-                    (t (bytevector-ieee-double-native-ref tiles offset))
-                    (tx (bytevector-ieee-double-native-ref tiles (+ offset 8)))
-                    (ty (bytevector-ieee-double-native-ref tiles (+ offset 16))))
+               ((= x level-width))
+             (let* ((offset (* (+ (* level-width y) x) %tile-size))
+                    (t (f64-ref tiles offset))
+                    (tx (f64-ref tiles (+ offset 8)))
+                    (ty (f64-ref tiles (+ offset 16))))
                (draw-image context image:map
                            (* t tw) 0.0 tw th
-                           tx ty tw th))))))))
+                           tx (- ty pixel-y-offset) tw th))))))))
 
   ;; Enemies:
   ;; length, capacity, pool
@@ -403,14 +460,14 @@
       (#(length capacity enemies)
        (unless (= length capacity)
          (let ((offset (enemy-pool-offset length)))
-           (bytevector-s32-native-set! enemies offset type)
-           (bytevector-s32-native-set! enemies (+ offset 4) hp)
-           (bytevector-ieee-double-native-set! enemies (+ offset 8) x)
-           (bytevector-ieee-double-native-set! enemies (+ offset 16) y)
-           (bytevector-ieee-double-native-set! enemies (+ offset 24) w)
-           (bytevector-ieee-double-native-set! enemies (+ offset 32) h)
-           (bytevector-ieee-double-native-set! enemies (+ offset 40) dx)
-           (bytevector-ieee-double-native-set! enemies (+ offset 48) dy)
+           (s32-set! enemies offset type)
+           (s32-set! enemies (+ offset 4) hp)
+           (f64-set! enemies (+ offset 8) x)
+           (f64-set! enemies (+ offset 16) y)
+           (f64-set! enemies (+ offset 24) w)
+           (f64-set! enemies (+ offset 32) h)
+           (f64-set! enemies (+ offset 40) dx)
+           (f64-set! enemies (+ offset 48) dy)
            (vector-set! pool 0 (+ length 1)))))))
   (define (enemy-pool-remove! pool i)
     (match pool
@@ -427,13 +484,13 @@
          (let loop ((i 0) (k length))
            (unless (= i k)
              (let* ((offset (enemy-pool-offset i))
-                    (hp (bytevector-s32-native-ref enemies (+ offset 4)))
-                    (x (bytevector-ieee-double-native-ref enemies (+ offset 8)))
-                    (y (bytevector-ieee-double-native-ref enemies (+ offset 16)))
-                    (w (bytevector-ieee-double-native-ref enemies (+ offset 24)))
-                    (h (bytevector-ieee-double-native-ref enemies (+ offset 32)))
-                    (dx (bytevector-ieee-double-native-ref enemies (+ offset 40)))
-                    (dy (bytevector-ieee-double-native-ref enemies (+ offset 48)))
+                    (hp (s32-ref enemies (+ offset 4)))
+                    (x (f64-ref enemies (+ offset 8)))
+                    (y (f64-ref enemies (+ offset 16)))
+                    (w (f64-ref enemies (+ offset 24)))
+                    (h (f64-ref enemies (+ offset 32)))
+                    (dx (f64-ref enemies (+ offset 40)))
+                    (dy (f64-ref enemies (+ offset 48)))
                     (x* (+ x dx))
                     (y* (+ y dy)))
                (let ((new-hp (collide x y w h hp)))
@@ -443,9 +500,9 @@
                    (enemy-pool-remove! pool i)
                    (loop i (- k 1)))
                   (else
-                   (bytevector-s32-native-set! enemies (+ offset 4) new-hp)
-                   (bytevector-ieee-double-native-set! enemies (+ offset 8) x*)
-                   (bytevector-ieee-double-native-set! enemies (+ offset 16) y*)
+                   (s32-set! enemies (+ offset 4) new-hp)
+                   (f64-set! enemies (+ offset 8) x*)
+                   (f64-set! enemies (+ offset 16) y*)
                    (loop (+ i 1) k)))))))))))
   (define (draw-enemies pool)
     (match pool
@@ -453,9 +510,9 @@
        (do ((i 0 (+ i 1)))
            ((= i length))
          (let* ((offset (enemy-pool-offset i))
-                (t (bytevector-s32-native-ref enemies offset))
-                (x (bytevector-ieee-double-native-ref enemies (+ offset 8)))
-                (y (bytevector-ieee-double-native-ref enemies (+ offset 16)))
+                (t (s32-ref enemies offset))
+                (x (f64-ref enemies (+ offset 8)))
+                (y (f64-ref enemies (+ offset 16)))
                 (w 64.0)
                 (h 64.0))
            (draw-image context image:enemies (* t w) (* t h) w h
@@ -466,10 +523,10 @@
        (let loop ((i 0))
          (and (< i length)
               (let* ((offset (enemy-pool-offset i))
-                     (x* (bytevector-ieee-double-native-ref enemies (+ offset 8)))
-                     (y* (bytevector-ieee-double-native-ref enemies (+ offset 16)))
-                     (w* (bytevector-ieee-double-native-ref enemies (+ offset 24)))
-                     (h* (bytevector-ieee-double-native-ref enemies (+ offset 32))))
+                     (x* (f64-ref enemies (+ offset 8)))
+                     (y* (f64-ref enemies (+ offset 16)))
+                     (w* (f64-ref enemies (+ offset 24)))
+                     (h* (f64-ref enemies (+ offset 32))))
                 (if (rect-within? x y w h x* y* w* h*)
                     i
                     (loop (+ i 1)))))))))
@@ -478,9 +535,8 @@
       (#(length capacity enemies)
        (when (and (>= i 0) (< i length))
          (let* ((offset (enemy-pool-offset i))
-                (hp (bytevector-s32-native-ref enemies (+ offset 4))))
-           (bytevector-s32-native-set! enemies (+ offset 4)
-                                               (- hp damage)))))))
+                (hp (s32-ref enemies (+ offset 4))))
+           (s32-set! enemies (+ offset 4) (- hp damage)))))))
 
   (define enemies (make-enemy-pool 64))
   (enemy-pool-add! enemies 0 20 70.0 100.0 16.0 16.0 0.0 0.0)
@@ -534,8 +590,7 @@
     (draw-bullets player-bullets image:player-bullet 8.0 8.0))
 
   (define (draw-enemy-bullets)
-    ;;(draw-bullets enemy-bullets image:enemy-bullets 8.0 8.0)
-    #t)
+    (draw-bullets enemy-bullets image:enemy-bullets 16.0 16.0))
 
   (define (draw-player)
     (draw-image context image:player
@@ -553,6 +608,7 @@
     (set-fill-color! context demichrome0)
     (fill-rect context 0.0 0.0 game-width game-height)
     (draw-tiles level)
+    ;; (draw-tiles level 0.0)
     (draw-player-bullets)
     (draw-enemies enemies)
     (draw-player)
@@ -603,14 +659,23 @@
                    (damage-enemy! enemies enemy-id 1)
                    #t))))))
 
+  (define (enemy-bullet-collide x y w h)
+    (let ((x* (- x (/ w 2.0)))
+          (y* (- y(/ h 2.0))))
+      (or (out-of-bounds? x* y* w h)
+          (rect-collides-with-level? level x* y* w h))))
+
   (define (enemy-collide x y w h hp)
     hp)
 
   (define dt (/ 1000.0 60.0))
   (define (update)
+    (scheduler-tick! *scheduler*)
+    (update-scroll!)
     (vec2-add! player-position player-velocity)
     (vec2-clamp! player-position 0.0 0.0 game-width game-height)
     (bullet-pool-update! player-bullets player-bullet-collide)
+    (bullet-pool-update! enemy-bullets enemy-bullet-collide)
     (enemy-pool-update! enemies enemy-collide)
     (when (firing?)
       (set! *player-fire-counter*
@@ -628,6 +693,19 @@
         (set! *player-fire-counter* 0)))
     (timeout update dt))
 
+  ;; Temp hacky scripts
+  (run-script
+   (lambda ()
+     (let ((ox 70.0)
+           (oy 100.0)
+           (speed 2.0))
+       (let loop ((theta 0.0))
+         (let ((dx (* (cos theta) speed))
+               (dy (* (sin theta) speed)))
+           (bullet-pool-add! enemy-bullets 0 ox oy dx dy))
+         (wait 2)
+         (loop (+ theta 0.2))))))
+
   (set-element-width! canvas (trunc canvas-width))
   (set-element-height! canvas (trunc canvas-height))
   (add-event-listener! (current-document) "keydown" on-key-down)
diff --git a/images/enemy-bullets.ase b/images/enemy-bullets.ase
new file mode 100644
index 0000000..d020498
--- /dev/null
+++ b/images/enemy-bullets.ase
diff --git a/images/enemy-bullets.png b/images/enemy-bullets.png
new file mode 100644
index 0000000..c50da59
--- /dev/null
+++ b/images/enemy-bullets.png
diff --git a/index.html b/index.html
index 0258f9d..499bf49 100644
--- a/index.html
+++ b/index.html
@@ -9,6 +9,7 @@
     <div style="display:none;">
       <img id="image-player" src="images/player.png" />
       <img id="image-player-bullet" src="images/player-bullet.png" />
+      <img id="image-enemy-bullets" src="images/enemy-bullets.png" />
       <img id="image-map" src="images/map.png" />
       <img id="image-enemies" src="images/enemies.png" />
     </div>