Fix scheduler, add player lives, update player sprite.

3 files changed, 73 insertions, 32 deletions

diff --git a/game.scm b/game.scm
index 8f1eb99..36f99d6 100644
--- a/game.scm
+++ b/game.scm
@@ -241,32 +241,42 @@
          (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 (run-thunks thunks)
+      (for-each (lambda (thunk) (thunk)) thunks))
+    (run-thunks
+     (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)
+                  to-run))))))))
   (define *scheduler* (make-scheduler 100))
-
-  (define %script-tag (make-prompt-tag 'script))
+  (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))
+      (when delay
+        (scheduler-add! *scheduler* (lambda () (run k)) delay)))
+    (run
+     (lambda ()
+       (thunk)
+       ;; Nasty hack: For some reason, falling through the prompt
+       ;; 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))))
   (define (wait delay)
     (abort-to-prompt %script-tag delay))
 
@@ -398,7 +408,7 @@
     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 \ _ _ _ _ _ _ _ / X X X)
   (define (level-offset x y)
     (* (+ (* level-width y) x) %tile-size))
   (define (point-collides-with-level? level x y)
@@ -550,6 +560,12 @@
   (define player-height 24.0)
   (define *player-fire-counter* 0)
   (define player-fire-interval 3)
+  (define player-hitbox-width 2.0)
+  (define player-hitbox-height 2.0)
+  (define %default-lives 3)
+  (define *player-lives* %default-lives)
+  (define *player-visible?* #t)
+  (define *player-invincible?* #f)
   ;; left, right, down, up, fire
   (define key-state (vector #f #f #f #f #f))
   (define (update-player-velocity!)
@@ -582,6 +598,22 @@
         (set! *player-fire-counter* 0))))
   (define (firing?)
     (vector-ref key-state 4))
+  (define (player-die!)
+    (set! *player-lives* (max (- *player-lives* 1) 0))
+    (run-script
+     (lambda ()
+       (set! *player-invincible?* #t)
+       (let ((t 5))
+         (let loop ((i 0))
+           (when (< i 10)
+             (set! *player-visible?* #f)
+             (wait t)
+             (set! *player-visible?* #t)
+             (wait t)
+             (loop (+ i 1)))))
+       (set! *player-invincible?* #f))))
+  (define (game-over?)
+    (= *player-lives* 0))
 
   (define (clear-screen)
     (clear-rect context 0.0 0.0 canvas-width canvas-height))
@@ -594,7 +626,8 @@
 
   (define (draw-player)
     (draw-image context image:player
-                0.0 0.0 player-width player-height
+                (if *player-visible?* 0.0 player-width) 0.0
+                player-width player-height
                 (- (vec2-x player-position)
                    (/ player-width 2.0))
                 (- (vec2-y player-position)
@@ -674,6 +707,15 @@
     (update-scroll!)
     (vec2-add! player-position player-velocity)
     (vec2-clamp! player-position 0.0 0.0 game-width game-height)
+    (when (and (not *player-invincible?*)
+               (rect-collides-with-level? level
+                                          (- (vec2-x player-position)
+                                             (/ player-hitbox-width 2.0))
+                                          (- (vec2-y player-position)
+                                             (/ player-hitbox-height 2.0))
+                                          player-hitbox-width
+                                          player-hitbox-height))
+      (player-die!))
     (bullet-pool-update! player-bullets player-bullet-collide)
     (bullet-pool-update! enemy-bullets enemy-bullet-collide)
     (enemy-pool-update! enemies enemy-collide)
@@ -681,15 +723,14 @@
       (set! *player-fire-counter*
             (modulo (+ *player-fire-counter* 1) player-fire-interval))
       (when (= *player-fire-counter* 0)
-        (let ((xoff 4.0))
-          (bullet-pool-add! player-bullets 0
-                            (- (vec2-x player-position) xoff)
-                            (vec2-y player-position)
-                            0.0 (- player-bullet-speed))
-          (bullet-pool-add! player-bullets 0
-                            (+ (vec2-x player-position) xoff)
-                            (vec2-y player-position)
-                            0.0 (- player-bullet-speed)))
+        (bullet-pool-add! player-bullets 0
+                          (- (vec2-x player-position) 6.0)
+                          (vec2-y player-position)
+                          0.0 (- player-bullet-speed))
+        (bullet-pool-add! player-bullets 0
+                          (+ (vec2-x player-position) 8.0)
+                          (vec2-y player-position)
+                          0.0 (- player-bullet-speed))
         (set! *player-fire-counter* 0)))
     (timeout update dt))
 
diff --git a/images/player.ase b/images/player.ase
index 2c90a8f..53dfcae 100644
--- a/images/player.ase
+++ b/images/player.ase
diff --git a/images/player.png b/images/player.png
index 145655b..f4ac194 100644
--- a/images/player.png
+++ b/images/player.png