More animations, splash screen, decent continue/clear screens!

10 files changed, 236 insertions, 70 deletions

diff --git a/game.scm b/game.scm
index b0daad0..7a6b2b8 100644
--- a/game.scm
+++ b/game.scm
@@ -227,6 +227,10 @@
          (#f #f)
          ((_ . val) val)))
 
+     (define %jps (inexact (jiffies-per-second)))
+     (define (current-time)
+       (/ (inexact (current-jiffy)) %jps))
+
      (define-type vec2
        make-vec2
        vec2?
@@ -310,8 +314,8 @@
             (audio-play audio)
             (vector-set! sound 0 (modulo (+ i 1) (vector-length vec)))))))
 
-     ;; intro, play, paused, game-over, game-win
-     (define *game-state* 'play)
+     ;; splash, play, pause, game-over, game-clear
+     (define *game-state* 'splash)
 
      ;; Screen size stuff
      (define game-width 240.0)
@@ -320,6 +324,7 @@
      ;; Elements
      (define canvas (get-element-by-id "canvas"))
      (define context (get-context canvas "2d"))
+     (define image:cover (load-image "images/cover.png"))
      (define image:starfield-bg (load-image "images/starfield-bg.png"))
      (define image:starfield-fg (load-image "images/starfield-fg.png"))
      (define image:player (load-image "images/player.png"))
@@ -379,16 +384,18 @@
               ((= i num-tasks))
             (vector-set! tasks i #f)))))
      (define *scheduler* (make-scheduler 100))
+     (define current-scheduler (make-parameter *scheduler*))
      (define current-script (make-parameter #f))
      (define %script-tag (make-prompt-tag "script"))
      (define-type script
        %make-script
        script?
+       (scheduler script-scheduler set-script-scheduler!)
        (state script-state set-script-state!)
        (cont script-cont set-script-cont!)
        (children script-children set-script-children!))
      (define (make-script thunk)
-       (%make-script 'pending thunk '()))
+       (%make-script (current-scheduler) 'pending thunk '()))
      (define (script-pending? script)
        (eq? (script-state script) 'pending))
      (define (script-running? script)
@@ -399,16 +406,18 @@
        (set-script-state! script 'cancelled)
        (for-each script-cancel! (script-children script)))
      (define (script-run! script)
+       (define scheduler (script-scheduler script))
        (define (run thunk)
          (unless (script-cancelled? script)
            (call-with-prompt %script-tag
              (lambda ()
-               (parameterize ((current-script script))
+               (parameterize ((current-script script)
+                              (current-scheduler scheduler))
                  (thunk)))
              handler)))
        (define (handler k delay)
          (when delay
-           (scheduler-add! *scheduler* (lambda () (run k)) delay)))
+           (scheduler-add! scheduler (lambda () (run k)) delay)))
        (when (script-pending? script)
          (let ((parent (current-script)))
            (when parent
@@ -772,7 +781,7 @@
      (define (make-enemy type health position size velocity
                          script points animation image image-size)
        (%make-enemy type health position size velocity script
-                    points (inexact (current-jiffy)) animation image
+                    points (current-time) animation image
                     image-size))
      (define (enemy-x enemy)
        (vec2-x (enemy-position enemy)))
@@ -825,14 +834,14 @@
             (set-vec2-y! position (+ (vec2-y position)
                                      (+ (vec2-y velocity) scroll-dy)))))))
      (define (draw-enemy enemy time)
-       (let ((frame-duration 250.0))
+       (let ((frame-duration 0.25))
          (match enemy
            (#('enemy type _ position size _ _ _ spawn-time animation
                      image image-size)
             (let* ((tx (vector-ref animation
                                    (modulo (truncate
-                                            (fmod (- time spawn-time)
-                                                  frame-duration))
+                                            (/ (- time spawn-time)
+                                               frame-duration))
                                            (vector-length animation))))
                    (x (vec2-x position))
                    (y (vec2-y position))
@@ -901,7 +910,7 @@
                       (run-script
                        (lambda ()
                          (wait 60)
-                         (set! *game-state* 'game-win))))
+                         (do-game-clear))))
                     (enemy-pool-remove! pool i)
                     (loop i (- k 1)))
                    (else
@@ -927,33 +936,33 @@
      (define (spawn-enemy enemy)
        (enemy-pool-add! enemies enemy))
 
-     (define (spawn-turret* x y script)
-       (spawn-enemy
-        (make-enemy 'turret 10 (vec2 x y) (vec2 12.0 12.0)
-                    (vec2 0.0 0.0) script 100
-                    #(0.0 16.0 32.0 48.0) image:turret (vec2 16.0 16.0))))
-
      (define (spawn-popcorn* x y script)
        (spawn-enemy
         (make-enemy 'popcorn 1 (vec2 x y) (vec2 12.0 12.0)
                     (vec2 0.0 0.0) script 100
-                    #(0.0 0.0 0.0 0.0) image:popcorn (vec2 32.0 32.0))))
+                    #(0.0 16.0 32.0 48.0) image:popcorn (vec2 16.0 16.0))))
+
+     (define (spawn-turret* x y script)
+       (spawn-enemy
+        (make-enemy 'turret 10 (vec2 x y) (vec2 12.0 12.0)
+                    (vec2 0.0 0.0) script 200
+                    #(0.0 16.0 32.0 48.0) image:turret (vec2 16.0 16.0))))
 
      (define (spawn-flyer0* x y script)
        (spawn-enemy
         (make-enemy 'flyer0 20 (vec2 x y) (vec2 12.0 12.0)
-                    (vec2 0.0 0.0) script 100
-                    #(0.0 0.0 0.0 0.0) image:flyer0 (vec2 32.0 32.0))))
+                    (vec2 0.0 0.0) script 500
+                    #(0.0 16.0 32.0 48.0) image:flyer0 (vec2 16.0 16.0))))
 
      (define (spawn-flyer1* x y script)
        (spawn-enemy
         (make-enemy 'flyer1 10 (vec2 x y) (vec2 16.0 16.0)
-                    (vec2 0.0 0.0) script 100
-                    #(0.0 0.0 0.0 0.0) image:flyer1 (vec2 32.0 32.0))))
+                    (vec2 0.0 0.0) script 1000
+                    #(0.0 24.0 48.0 72.0) image:flyer1 (vec2 24.0 24.0))))
 
      (define (spawn-turret x y)
        (define (script enemy)
-         (let ((speed 2.0))
+         (let ((speed 3.0))
            (define (current-dir)
              (direction-to-player (enemy-position enemy)))
            (define (shoot dir)
@@ -967,9 +976,9 @@
             (wait 60)
             (let ((dir (current-dir)))
               (shoot dir)
-              (wait 10)
+              (wait 5)
               (shoot dir)
-              (wait 10)
+              (wait 5)
               (shoot dir)))))
        (spawn-turret* x y script))
 
@@ -1028,6 +1037,7 @@
      (define *player-visible?* #t)
      (define *player-invincible?* #f)
      (define *player-score* 0)
+     (define *player-1cc?* #t)
      ;; left, right, down, up, fire, focus
      (define key-state (vector #f #f #f #f #f #f))
      (define (update-player-velocity!)
@@ -1080,23 +1090,25 @@
      (define (player-position-reset!)
        (set-vec2-x! player-position (/ game-width 2.0))
        (set-vec2-y! player-position (- game-height 12.0)))
+     (define (do-player-invincible)
+       (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 (player-die!)
        (unless *player-invincible?*
          (sound-effect-play sound:player-death 0.5)
          (set! *player-lives* (max (- *player-lives* 1) 0))
          (player-position-reset!)
-         (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)))))
+         (do-player-invincible)))
      (define (game-over?)
        (= *player-lives* 0))
      (define (player-update!)
@@ -1183,6 +1195,62 @@
          (vec2-normalize! v*)
          v*))
 
+     ;; Game over screen state
+     (define *countdown* "")
+     (define *countdown-scheduler* (make-scheduler 5))
+     (define (do-countdown)
+       (parameterize ((current-scheduler *countdown-scheduler*))
+         (run-script
+          (lambda ()
+            (let loop ((i 9))
+              (set! *countdown* (number->string i))
+              (wait 60)
+              (unless (= i 0)
+                (loop (- i 1))))
+            (set! *game-state* 'splash)))))
+     (define (do-game-over)
+       (scheduler-reset! *countdown-scheduler*)
+       (set! *game-state* 'game-over)
+       (do-countdown))
+     (define (do-continue)
+       (player-position-reset!)
+       (set! *player-lives* 3)
+       (set! *player-1cc?* #f)
+       (set! *game-state* 'play)
+       (do-player-invincible))
+
+     ;; Clear screen state
+     (define *clear-show-1cc-bonus?* #f)
+     (define *clear-show-life-bonus?* #f)
+     (define *clear-show-total-score?* #f)
+     (define *clear-1cc-bonus* "")
+     (define *clear-life-bonus* "")
+     (define *clear-total-score* "")
+     (define (do-game-clear)
+       (scheduler-reset! *scheduler*)
+       (set! *game-state* 'game-clear)
+       (set! *clear-show-1cc-bonus?* #f)
+       (set! *clear-show-life-bonus?* #f)
+       (set! *clear-show-total-score?* #f)
+       (if *player-1cc?*
+           (let ((1cc-bonus 1000000)
+                 (life-bonus (* *player-lives* 250000)))
+             (set! *player-score* (+ *player-score* 1cc-bonus life-bonus))
+             (set! *clear-1cc-bonus* (number->string 1cc-bonus))
+             (set! *clear-life-bonus* (number->string life-bonus)))
+           (begin
+             (set! *clear-1cc-bonus* "0")
+             (set! *clear-life-bonus* "0")))
+       (set! *clear-total-score* (number->string *player-score*))
+       (run-script
+        (lambda ()
+          (wait 60)
+          (set! *clear-show-1cc-bonus?* #t)
+          (wait 60)
+          (set! *clear-show-life-bonus?* #t)
+          (wait 60)
+          (set! *clear-show-total-score?* #t))))
+
      ;; Canvas sizing/scaling.
      (define *canvas-scale* 0.0)
      (define *canvas-width* 0)
@@ -1235,12 +1303,29 @@
          (set-text-align! context "left")
          (fill-text context (number->string *player-score*) 4.0 y)))
 
-     (define (draw time)
-       (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 "#140c1c")
-       (fill-rect context 0.0 0.0 game-width game-height)
+     (define (draw-splash time)
+       (draw-image context image:cover
+                   0.0 0.0 game-width game-height
+                   0.0 0.0 game-width game-height)
+       (let ((x (/ game-width 2.0))
+             (y (+ (- game-height 40.0) (* (sin (* time 2.0)) 4.0))))
+         (set-fill-color! context "#ffffff")
+         (set-font! context "bold 18px monogram")
+         (set-text-align! context "center")
+         (fill-text context "Press ENTER to start" x y)))
+
+     (define (draw-play time)
+       (draw-background image:starfield-bg 0.3)
+       (draw-background image:starfield-fg 0.5)
+       (draw-level-foreground level)
+       (draw-particles particles)
+       (draw-player-bullets)
+       (draw-enemies enemies time)
+       (draw-player)
+       (draw-enemy-bullets)
+       (draw-hud))
+
+     (define (draw-pause time)
        (draw-background image:starfield-bg 0.3)
        (draw-background image:starfield-fg 0.5)
        (draw-level-foreground level)
@@ -1250,24 +1335,81 @@
        (draw-player)
        (draw-enemy-bullets)
        (draw-hud)
-       (match *game-state*
-         ('game-over
-          (set-fill-color! context "#ffffff")
-          (set-font! context "bold 36px monogram")
-          (set-text-align! context "center")
-          (fill-text context "GAME OVER" (/ game-width 2.0) (/ game-height 2.0)))
-         ('game-win
-          (set-fill-color! context "#ffffff")
-          (set-font! context "bold 36px monogram")
-          (set-text-align! context "center")
-          (fill-text context "WELL DONE" (/ game-width 2.0) (/ game-height 2.0)))
-         ('paused
-          (set-fill-color! context "#ffffff")
-          (set-font! context "bold 36px monogram")
-          (set-text-align! context "center")
-          (fill-text context "PAUSED" (/ game-width 2.0) (/ game-height 2.0)))
-         (_ #t))
-       (request-animation-frame draw))
+       (set-fill-color! context "#ffffff")
+       (set-font! context "bold 36px monogram")
+       (set-text-align! context "center")
+       (fill-text context "PAUSED" (/ game-width 2.0) (/ game-height 2.0)))
+
+     (define (draw-game-over time)
+       (draw-background image:starfield-bg 0.3)
+       (draw-background image:starfield-fg 0.5)
+       (draw-level-foreground level)
+       (draw-particles particles)
+       (draw-enemies enemies time)
+       (draw-enemy-bullets)
+       (draw-hud)
+       (set-fill-color! context "#ffffff")
+       (set-font! context "bold 36px monogram")
+       (set-text-align! context "center")
+       (fill-text context "CONTINUE?"
+                  (/ game-width 2.0) (/ game-height 3.0))
+       (set-font! context "bold 72px monogram")
+       (fill-text context *countdown*
+                  (/ game-width 2.0) (+ (/ game-height 3.0) 60.0)))
+
+     (define (draw-game-clear time)
+       (draw-background image:starfield-bg 0.3)
+       (draw-background image:starfield-fg 0.5)
+       (draw-level-foreground level)
+       (draw-particles particles)
+       (draw-player)
+       (set-fill-color! context "#ffffff")
+       (set-font! context "bold 36px monogram")
+       (set-text-align! context "center")
+       (fill-text context "CLEAR" (/ game-width 2.0) (/ game-height 3.0))
+       (set-font! context "bold 24px monogram")
+       (set-text-align! context "left")
+       (when *clear-show-1cc-bonus?*
+         (fill-text context "1CC BONUS"
+                    16.0
+                    (+ (/ game-height 3.0) 40)))
+       (when *clear-show-life-bonus?*
+         (fill-text context "LIFE BONUS"
+                    16.0
+                    (+ (/ game-height 3.0) 80)))
+       (when *clear-show-total-score?*
+         (fill-text context "TOTAL SCORE"
+                    16.0
+                    (+ (/ game-height 3.0) 120)))
+       (set-text-align! context "right")
+       (when *clear-show-1cc-bonus?*
+         (fill-text context *clear-1cc-bonus*
+                    (- game-width 16.0)
+                    (+ (/ game-height 3.0) 40)))
+       (when *clear-show-life-bonus?*
+         (fill-text context *clear-life-bonus*
+                    (- game-width 16.0)
+                    (+ (/ game-height 3.0) 80)))
+       (when *clear-show-total-score?*
+         (fill-text context *clear-total-score*
+                    (- game-width 16.0)
+                    (+ (/ game-height 3.0) 120))))
+
+     (define (draw _prev-time)
+       (let ((time (current-time)))
+         (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 "#140c1c")
+         (fill-rect context 0.0 0.0 game-width game-height)
+         (let ((draw* (match *game-state*
+                        ('splash draw-splash)
+                        ('play draw-play)
+                        ('pause draw-pause)
+                        ('game-over draw-game-over)
+                        ('game-clear draw-game-clear))))
+           (draw* time))
+         (request-animation-frame draw)))
 
      (define (reset!)
        (set! *game-state* 'play)
@@ -1288,7 +1430,8 @@
        (set! *player-invincible?* #f)
        (set! *player-visible?* #t)
        (set! *player-fire-counter* 0)
-       (set! *player-score* 0))
+       (set! *player-score* 0)
+       (set! *player-1cc?* #t))
 
      (define (on-key-down event)
        (let ((code (keyboard-event-code event)))
@@ -1335,10 +1478,14 @@
            (prevent-default! event))
           (else
            (match *game-state*
+             ('splash
+              (when (string-=? code "Enter")
+                (reset!)
+                (set! *game-state* 'play)))
              ('play
               (cond
                ((string-=? code "Enter")
-                (set! *game-state* 'paused)
+                (set! *game-state* 'pause)
                 (prevent-default! event))
                ((string-=? code "KeyD")
                 (set! *debug?* (not *debug?*))
@@ -1347,17 +1494,25 @@
                 (reset!)
                 (prevent-default! event))
                ((string-=? code "KeyW")
-                (set! *game-state* 'game-win)
+                (do-game-clear)
+                (prevent-default! event))
+               ((string-=? code "KeyO")
+                (do-game-over)
                 (prevent-default! event))))
-             ('paused
+             ('pause
               (cond
                ((string-=? code "Enter")
                 (set! *game-state* 'play)
                 (prevent-default! event))))
-             ((or 'game-over 'game-win)
+             ('game-clear
               (cond
                ((string-=? code "Enter")
-                (reset!)
+                (set! *game-state* 'splash)
+                (prevent-default! event))))
+             ('game-over
+              (cond
+               ((string-=? code "Enter")
+                (do-continue)
                 (prevent-default! event))))
              (_ #t))))))
 
@@ -1401,9 +1556,9 @@
 
      (define dt (/ 1000.0 60.0))
      (define (update)
+       (scheduler-tick! *scheduler*)
        (match *game-state*
          ('play
-          (scheduler-tick! *scheduler*)
           (level-update! level)
           (player-update!)
           (bullet-pool-update! player-bullets player-bullet-collide)
@@ -1411,7 +1566,18 @@
           (enemy-pool-update! enemies)
           (particle-pool-update! particles)
           (when (game-over?)
-            (set! *game-state* 'game-over)))
+            (do-game-over)))
+         ('game-over
+          (set! *scroll* *last-scroll*)
+          (scheduler-tick! *countdown-scheduler*)
+          (bullet-pool-update! player-bullets player-bullet-collide)
+          (bullet-pool-update! enemy-bullets enemy-bullet-collide)
+          (particle-pool-update! particles)
+          (enemy-pool-update! enemies))
+         ('game-clear
+          (bullet-pool-update! player-bullets player-bullet-collide)
+          (bullet-pool-update! enemy-bullets enemy-bullet-collide)
+          (particle-pool-update! particles))
          (_ #t))
        (timeout update dt))
 
@@ -1419,7 +1585,6 @@
      (add-event-listener! (current-document) "keydown" on-key-down)
      (add-event-listener! (current-document) "keyup" on-key-up)
      (resize-canvas)
-     (reset!)
      (request-animation-frame draw)
      (timeout update dt)))
 
diff --git a/images/flyer0.ase b/images/flyer0.ase
index 17329cb..619b3b5 100644
--- a/images/flyer0.ase
+++ b/images/flyer0.ase
diff --git a/images/flyer0.png b/images/flyer0.png
index 6505b1d..1f8ce69 100644
--- a/images/flyer0.png
+++ b/images/flyer0.png
diff --git a/images/flyer1.ase b/images/flyer1.ase
index 42fbe42..31f62e0 100644
--- a/images/flyer1.ase
+++ b/images/flyer1.ase
diff --git a/images/flyer1.png b/images/flyer1.png
index 5298bcd..480bef0 100644
--- a/images/flyer1.png
+++ b/images/flyer1.png
diff --git a/images/popcorn.ase b/images/popcorn.ase
index 1168e17..f5022b9 100644
--- a/images/popcorn.ase
+++ b/images/popcorn.ase
diff --git a/images/popcorn.png b/images/popcorn.png
index 25e8f0f..76f7fd3 100644
--- a/images/popcorn.png
+++ b/images/popcorn.png
diff --git a/images/turret.ase b/images/turret.ase
index dd1fe3d..be39fac 100644
--- a/images/turret.ase
+++ b/images/turret.ase
diff --git a/images/turret.png b/images/turret.png
index d20852f..841651f 100644
--- a/images/turret.png
+++ b/images/turret.png
diff --git a/level.tmx b/level.tmx
index 68a4798..41091ac 100644
--- a/level.tmx
+++ b/level.tmx
@@ -1,5 +1,5 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<map version="1.8" tiledversion="1.8.6" orientation="orthogonal" renderorder="right-down" width="15" height="500" tilewidth="16" tileheight="16" infinite="0" nextlayerid="8" nextobjectid="256">
+<map version="1.8" tiledversion="1.8.6" orientation="orthogonal" renderorder="right-down" width="15" height="500" tilewidth="16" tileheight="16" infinite="0" nextlayerid="8" nextobjectid="257">
  <tileset firstgid="1" source="tiles.tsx"/>
  <tileset firstgid="7" source="background.tsx"/>
  <objectgroup id="7" name="background" visible="0" parallaxy="0.75">
@@ -1226,5 +1226,6 @@
   <object id="224" type="popcorn" x="48" y="2128" width="16" height="16"/>
   <object id="225" type="popcorn" x="48" y="2160" width="16" height="16"/>
   <object id="226" type="popcorn" x="48" y="2064" width="16" height="16"/>
+  <object id="256" type="turret" x="96" y="7712" width="16" height="16"/>
  </objectgroup>
 </map>