Enemies with cancellable scripts.

1 files changed, 71 insertions, 55 deletions

diff --git a/game.scm b/game.scm
index 106e9cc..2f18584 100644
--- a/game.scm
+++ b/game.scm
@@ -1,8 +1,8 @@
 (let ()
+  ;; Host imports
   (define-foreign request-animation-frame
     "window" "requestAnimationFrame"
     (ref eq) -> none)
-
   (define-foreign timeout
     "window" "setTimeout"
     (ref eq) f64 -> i32)
@@ -10,19 +10,15 @@
   (define-foreign current-document
     "document" "get"
     -> (ref extern))
-
   (define-foreign document-body
     "document" "body"
     -> (ref extern))
-
   (define-foreign get-element-by-id
     "document" "getElementById"
     (ref string) -> (ref null extern))
-
   (define-foreign make-text-node
     "document" "createTextNode"
     (ref string) -> (ref extern))
-
   (define-foreign make-element
     "document" "createElement"
     (ref string) -> (ref extern))
@@ -30,47 +26,36 @@
   (define-foreign element-value
     "element" "value"
     (ref extern) -> (ref string))
-
   (define-foreign set-element-value!
     "element" "setValue"
     (ref extern) (ref string) -> none)
-
   (define-foreign set-element-width!
     "element" "setWidth"
     (ref extern) i32 -> none)
-
   (define-foreign set-element-height!
     "element" "setHeight"
     (ref extern) i32 -> none)
-
   (define-foreign append-child!
     "element" "appendChild"
     (ref extern) (ref extern) -> (ref extern))
-
   (define-foreign remove!
     "element" "remove"
     (ref extern) -> none)
-
   (define-foreign replace-with!
     "element" "replaceWith"
     (ref extern) (ref extern) -> none)
-
   (define-foreign set-attribute!
     "element" "setAttribute"
     (ref extern) (ref string) (ref string) -> none)
-
   (define-foreign remove-attribute!
     "element" "removeAttribute"
     (ref extern) (ref string) -> none)
-
   (define-foreign add-event-listener!
     "element" "addEventListener"
     (ref extern) (ref string) (ref eq) -> none)
-
   (define-foreign remove-event-listener!
     "element" "removeEventListener"
     (ref extern) (ref string) (ref eq) -> none)
-
   (define-foreign clone-element
     "element" "clone"
     (ref extern) -> (ref extern))
@@ -82,31 +67,24 @@
   (define-foreign get-context
     "canvas" "getContext"
     (ref extern) (ref string) -> (ref extern))
-
   (define-foreign set-fill-color!
     "canvas" "setFillColor"
     (ref extern) (ref string) -> none)
-
   (define-foreign clear-rect
     "canvas" "clearRect"
     (ref extern) f64 f64 f64 f64 -> none)
-
   (define-foreign fill-rect
     "canvas" "fillRect"
     (ref extern) f64 f64 f64 f64 -> none)
-
   (define-foreign draw-image
     "canvas" "drawImage"
     (ref extern) (ref extern) f64 f64 f64 f64 f64 f64 f64 f64 -> none)
-
   (define-foreign set-scale!
     "canvas" "setScale"
     (ref extern) f64 f64 -> none)
-
   (define-foreign set-transform!
     "canvas" "setTransform"
     (ref extern) f64 f64 f64 f64 f64 f64 -> none)
-
   (define-foreign set-image-smoothing-enabled!
     "canvas" "setImageSmoothingEnabled"
     (ref extern) i32 -> none)
@@ -114,15 +92,12 @@
   (define-foreign load-audio
     "audio" "new"
     (ref string) -> (ref extern))
-
   (define-foreign audio-play
     "audio" "play"
     (ref extern) -> none)
-
   (define-foreign audio-volume
     "audio" "volume"
     (ref extern) -> f64)
-
   (define-foreign set-audio-volume!
     "audio" "setVolume"
     (ref extern) f64 -> none)
@@ -309,8 +284,12 @@
   (define *scheduler* (make-scheduler 100))
   (define %script-tag (make-prompt-tag "script"))
   (define (run-script thunk)
+    (define script (vector #f))
+    (define (cancelled?)
+      (vector-ref script 0))
     (define (run thunk)
-      (call-with-prompt %script-tag thunk handler))
+      (unless (cancelled?)
+        (call-with-prompt %script-tag thunk handler)))
     (define (handler k delay)
       (when delay
         (scheduler-add! *scheduler* (lambda () (run k)) delay)))
@@ -321,7 +300,10 @@
        ;; thunk messes up the Scheme stack, resulting in an invalid
        ;; ref.cast somewhere.  So, we *never* fall through.  Instead,
        ;; we create a continuation that gets thrown away.
-       (abort-to-prompt %script-tag #f))))
+       (abort-to-prompt %script-tag #f)))
+    script)
+  (define (cancel! script)
+    (vector-set! script 0 #t))
   (define (wait delay)
     (abort-to-prompt %script-tag delay))
 
@@ -529,18 +511,18 @@
                            (* t tw) 0.0 tw th
                            tx (- ty pixel-y-offset) tw th))))))))
 
-  ;; Enemies:
-  ;; length, capacity, pool
+  ;; Enemy pool:
+  ;; length, capacity, enemies, scripts
   ;; enemy: type, health, x, y, w, h, dx, dy
   (define %enemy-size (+ 4 4 8 8 8 8 8 8))
   (define (make-enemy-pool capacity)
     (let ((enemies (make-bytevector (* capacity %enemy-size))))
-      (vector 0 capacity enemies)))
+      (vector 0 capacity enemies (make-vector capacity))))
   (define (enemy-pool-offset i)
     (* i %enemy-size))
-  (define (enemy-pool-add! pool type hp x y w h dx dy)
+  (define (enemy-pool-add! pool type hp x y w h dx dy script)
     (match pool
-      (#(length capacity enemies)
+      (#(length capacity enemies scripts)
        (unless (= length capacity)
          (let ((offset (enemy-pool-offset length)))
            (s32-set! enemies offset type)
@@ -551,18 +533,54 @@
            (f64-set! enemies (+ offset 32) h)
            (f64-set! enemies (+ offset 40) dx)
            (f64-set! enemies (+ offset 48) dy)
+           (vector-set! scripts length
+                        (and script
+                             (run-script
+                              (lambda ()
+                                (script length)))))
            (vector-set! pool 0 (+ length 1)))))))
   (define (enemy-pool-remove! pool i)
     (match pool
-      (#(length capacity enemies)
+      (#(length capacity enemies scripts)
        (when (and (>= i 0) (< i length))
-         (let ((at (enemy-pool-offset i))
-               (start (enemy-pool-offset (- length 1))))
+         (let* ((j (- length 1))
+                (at (enemy-pool-offset i))
+                (start (enemy-pool-offset j)))
            (bytevector-copy! enemies at enemies start (+ start %enemy-size))
-           (vector-set! pool 0 (- length 1)))))))
+           (let ((script (vector-ref scripts i)))
+             (and script (cancel! script)))
+           (vector-set! scripts i (vector-ref scripts j))
+           (vector-set! scripts j #f)
+           (vector-set! pool 0 j))))))
+  (define (enemy-x pool i)
+    (match pool
+      (#(length capacity enemies scripts)
+       (let ((offset (enemy-pool-offset i)))
+         (f64-ref enemies (+ offset 8))))))
+  (define (enemy-y pool i)
+    (match pool
+      (#(length capacity enemies scripts)
+       (let ((offset (enemy-pool-offset i)))
+         (f64-ref enemies (+ offset 16))))))
+  (define (enemy-dx pool i)
+    (match pool
+      (#(length capacity enemies scripts)
+       (let ((offset (enemy-pool-offset i)))
+         (f64-ref enemies (+ offset 40))))))
+  (define (enemy-dy pool i)
+    (match pool
+      (#(length capacity enemies scripts)
+       (let ((offset (enemy-pool-offset i)))
+         (f64-ref enemies (+ offset 48))))))
+  (define (set-enemy-velocity! pool i dx dy)
+    (match pool
+      (#(length capacity enemies scripts)
+       (let ((offset (enemy-pool-offset i)))
+         (f64-set! enemies (+ offset 40) dx)
+         (f64-set! enemies (+ offset 48) dy)))))
   (define (enemy-pool-update! pool collide)
     (match pool
-      (#(length capacity enemies)
+      (#(length capacity enemies scripts)
        (let ((padding 16.0))
          (let loop ((i 0) (k length))
            (unless (= i k)
@@ -590,7 +608,7 @@
                    (loop (+ i 1) k)))))))))))
   (define (draw-enemies pool)
     (match pool
-      (#(length capacity enemies)
+      (#(length capacity enemies scripts)
        (do ((i 0 (+ i 1)))
            ((= i length))
          (let* ((offset (enemy-pool-offset i))
@@ -610,7 +628,7 @@
                       hbw hbh))))))
   (define (find-enemy pool x y w h)
     (match pool
-      (#(length capacity enemies)
+      (#(length capacity enemies scripts)
        (let loop ((i 0))
          (and (< i length)
               (let* ((offset (enemy-pool-offset i))
@@ -625,14 +643,25 @@
                     (loop (+ i 1)))))))))
   (define (damage-enemy! pool i damage)
     (match pool
-      (#(length capacity enemies)
+      (#(length capacity enemies scripts)
        (when (and (>= i 0) (< i length))
          (let* ((offset (enemy-pool-offset i))
                 (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)
+  (enemy-pool-add! enemies 0 20 70.0 100.0 16.0 16.0 0.0 0.0
+                   (lambda (id)
+                     (let ((speed 2.0))
+                       (let loop ((theta 0.0))
+                         (let ((dx (* (cos theta) speed))
+                               (dy (* (sin theta) speed)))
+                           (bullet-pool-add! enemy-bullets 0
+                                             (enemy-x enemies id)
+                                             (enemy-y enemies id)
+                                             dx dy))
+                         (wait 2)
+                         (loop (+ theta 0.2))))))
 
   ;; Player state:
   (define player-position (vec2 (/ game-width 2.0) (- game-height 12.0)))
@@ -845,19 +874,6 @@
     (enemy-pool-update! enemies enemy-collide)
     (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)