From e457ce03fc57cc9c2d3979b8bbc747ae6c2b97b7 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Mon, 9 May 2016 23:08:00 -0400
Subject: Finish game! (for now?)

---
 game.scm | 405 +++++++++++++++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 359 insertions(+), 46 deletions(-)

(limited to 'game.scm')

diff --git a/game.scm b/game.scm
index d48a62e..32d896a 100644
--- a/game.scm
+++ b/game.scm
@@ -18,6 +18,7 @@
 (use-modules (ice-9 match)
              (sly)
              (sly actor)
+             (sly audio)
              (sly fps)
              (sly live-reload)
              ((sly math vector) #:select (magnitude) #:prefix v:)
@@ -78,7 +79,7 @@
   ;; field to figure things out, but it's more work so forget it.
   (type enemy-type 'pincer-dark)
   (polarity enemy-polarity 'light)
-  (hitbox enemy-hitbox (make-rect -3 -3 6 6))
+  (hitbox enemy-hitbox (make-rect -5 -5 10 10))
   (last-hit-time enemy-last-hit-time #f)
   (health enemy-health 0))
 
@@ -219,6 +220,10 @@
                        (make-player-bullet player (vector2 -2 1))
                        (make-player-bullet player (vector2 4 1)))))
 
+(define (place-enemy enemy position)
+  (make-enemy #:inherit enemy
+              #:position position))
+
 (define (move-enemy enemy offset)
   (make-enemy #:inherit enemy
               #:position (v+ (enemy-position enemy) offset)))
@@ -311,7 +316,8 @@
      ((not (eq? enemy-polarity chain-polarity))
       (make-stats #:inherit stats
                   #:chain-type #f
-                  #:chain-progress 0))
+                  #:chain-progress 0
+                  #:chain 0))
      ((= progress 1)
       (make-stats #:inherit stats
                   #:chain-progress 2))
@@ -592,11 +598,11 @@
                   (game-won? world)
                   (game-intro? world)))
          (make-world #:inherit %default-world
-                     #:waves (list (list %default-enemy)
-                                   (list %default-enemy)))
+                     #:waves %waves)
          world))))
 
 (define player-shoot* (action-effect-lift player-shoot))
+(define place-enemy* (action-lift place-enemy))
 (define move-enemy* (action-lift move-enemy))
 (define aim-enemy* (action-lift aim-enemy))
 (define enemy-shoot* (action-effect-lift enemy-shoot))
@@ -608,41 +614,276 @@
                (both (repeat 3 (player-forward player-speed))
                      (whena player-shooting? (player-shoot*))))))
 
-(define %default-enemy
-  (make-actor (make-enemy #:position (vector2 60 120)
-                          #:health 10
-                          #:type 'pincer-light)
-              (let* ((v (vector2 .8 0))
-                     (bullet-speed 0.6)
-                     (interval 15)
-                     (shoot (together
-                              (aim-enemy* (/ pi 32))
-                              (enemy-shoot* 'large-light bullet-speed 0)
-                              (enemy-shoot* 'large-dark (/ bullet-speed 2) pi))))
-                (forever
+(define (make-pincer polarity position action)
+  (make-actor (make-enemy #:position position
+                          #:health 40
+                          #:polarity polarity
+                          #:type (match polarity
+                                   ('light 'pincer-light)
+                                   ('dark 'pincer-dark)))
+              action))
+
+(define (make-popcorn polarity position action)
+  (make-actor (make-enemy #:position position
+                          #:health 1
+                          #:polarity polarity
+                          #:type (match polarity
+                                   ('light 'popcorn-light)
+                                   ('dark 'popcorn-dark)))
+              action))
+
+(define %hard-spiral
+  (let* ((v (vector2 .8 0))
+         (bullet-speed 0.6)
+         (interval 15)
+         (shoot (together
+                 (wait 2)
+                 (aim-enemy* (/ pi 32))
+                 (enemy-shoot* 'large-light bullet-speed 0)
+                 (enemy-shoot* 'large-dark (/ bullet-speed 2) pi))))
+    (forever
+     (sequence
+       (repeat interval (together (move-enemy* v) shoot))
+       (repeat interval (together (move-enemy* (v- v)) shoot))
+       (repeat interval (together (move-enemy* (v- v)) shoot))
+       (repeat interval (together (move-enemy* v) shoot))))))
+
+(define (move-linear offset duration)
+  (repeat duration
+          (move-enemy*
+           (v* offset (/ 1.0 duration)))))
+
+(define hard-pincer
+  (let ((start (vector2 -60 120)))
+    (make-pincer 'light start
+                 (sequence (move-linear (v- (vector2 30 120) start) 90)
+                           %hard-spiral))))
+
+(define (make-medium-wave polarity)
+  (list (let ((start (vector2 -60 120)))
+          (make-pincer polarity start
+                       (sequence (move-linear (v- (vector2 30 120) start) 90)
+                                 %hard-spiral)))
+        (let ((start (vector2 180 120)))
+          (make-pincer polarity start
+                       (sequence (move-linear (v- (vector2 90 120) start) 90)
+                                 %hard-spiral)))
+        (let ((start (vector2 -30 140)))
+          (make-pincer polarity start
+                       (sequence (move-linear (v- (vector2 60 140) start) 90)
+                                 %hard-spiral)))))
+
+(define (polarity-not polarity)
+  (if (eq? polarity 'light)
+      'dark
+      'light))
+
+(define (make-easy-wave polarity bullet-speed)
+  (define (bullet-type* polarity)
+    (match polarity
+      ('light 'small-light)
+      ('dark 'small-dark)))
+
+  (define sweep-size 16)
+  (define theta (/ pi/2 sweep-size))
+
+  (define (action polarity)
+    (define bullet-speed*
+      (if (eq? polarity 'dark)
+          bullet-speed
+          (* bullet-speed 1.5)))
+
+    (sequence
+      (wait (if (eq? polarity 'dark) 60 0))
+      (aim-enemy* (if (eq? polarity 'dark)
+                      (* 5/4 pi)
+                      (* 7/4 pi)))
+      (forever
+       (sequence
+         (repeat sweep-size
+                 (sequence
+                   (wait 10)
+                   (enemy-shoot* (bullet-type* polarity) bullet-speed* 0)
+                   (aim-enemy* (if (eq? polarity 'dark) theta (- theta)))))
+         (move-linear (vector2 10 10) 10)
+         (wait 60)
+         (repeat sweep-size
+                 (sequence
+                   (wait 10)
+                   (enemy-shoot* (bullet-type* polarity) bullet-speed* 0)
+                   (aim-enemy* (if (eq? polarity 'dark) (- theta) theta))))
+         (move-linear (vector2 -10 -10) 10)
+         (wait 60)))))
+
+  (define (enemy polarity start)
+    (make-popcorn polarity start
+                  (sequence
+                    (wait (if (eq? polarity 'dark) 30 0))
+                    (move-linear (vector2 0 -120) 90)
+                    (action polarity))))
+
+  (list (enemy polarity (vector2 20 200))
+        (enemy polarity (vector2 20 220))
+        (enemy polarity (vector2 20 240))
+        (enemy (polarity-not polarity) (vector2 40 200))
+        (enemy (polarity-not polarity) (vector2 40 220))
+        (enemy (polarity-not polarity) (vector2 40 240))
+        (enemy polarity (vector2 60 200))
+        (enemy polarity (vector2 60 220))
+        (enemy polarity (vector2 60 240))
+        (enemy (polarity-not polarity) (vector2 80 200))
+        (enemy (polarity-not polarity) (vector2 80 220))
+        (enemy (polarity-not polarity) (vector2 80 240))
+        (enemy polarity (vector2 100 200))
+        (enemy polarity (vector2 100 220))
+        (enemy polarity (vector2 100 240))))
+
+(define (make-intro-wave make-enemy* polarity1 polarity2 polarity3 bullet-speed)
+  (define (bullet-type* polarity)
+    (match polarity
+      ('light 'small-light)
+      ('dark 'small-dark)))
+
+  (define (action polarity)
+    (let ((shoot (repeat 8
+                         (sequence
+                           (enemy-shoot* (bullet-type* polarity)
+                                         bullet-speed
+                                         (* 0.125 pi))
+                           (enemy-shoot* (bullet-type* polarity)
+                                         bullet-speed
+                                         0)
+                           (enemy-shoot* (bullet-type* polarity)
+                                         bullet-speed
+                                         (* -0.125 pi)))))
+          (theta (/ pi 16)))
+      (sequence
+        (aim-enemy* (* 1.5 pi))
+        (forever
+         (sequence
+           shoot
+           (aim-enemy* theta)
+           shoot
+           (aim-enemy* theta)
+           shoot
+           (aim-enemy* (- theta))
+           shoot
+           (aim-enemy* (- theta))
+           shoot
+           (aim-enemy* (- theta))
+           shoot
+           (aim-enemy* (- theta))
+           shoot
+           (aim-enemy* theta)
+           shoot
+           (aim-enemy* theta))))))
+
+  (define (enemy polarity start)
+    (make-enemy* polarity start
+                 (sequence
+                   (move-linear (vector2 0 -120) 90)
+                   (action polarity))))
+
+  (list (enemy polarity1 (vector2 20 250))
+        (enemy polarity2 (vector2 60 250))
+        (enemy polarity3 (vector2 100 250))))
+
+(define (make-final-wave)
+  (define popcorn-bullet-speed 1)
+
+  (define shoot-down-light
+    (sequence
+      (aim-enemy* (* 1.5 pi))
+      (forever
+       (sequence
+         (move-linear (vector2 5 0) 5)
+         (repeat 20
                  (sequence
-                   (repeat interval (together (move-enemy* v) shoot))
-                   (repeat interval (together (move-enemy* (v- v)) shoot))
-                   (repeat interval (together (move-enemy* (v- v)) shoot))
-                   (repeat interval (together (move-enemy* v) shoot)))))))
+                   (enemy-shoot* 'small-light popcorn-bullet-speed 0)
+                   (wait 3)))
+         (move-linear (vector2 -5 0) 5)
+         (wait 150)))))
+
+  (define shoot-down-dark
+    (sequence
+      (aim-enemy* (* 1.5 pi))
+      (forever
+       (sequence
+         (move-linear (vector2 -5 0) 5)
+         (repeat 20
+                 (sequence
+                   (enemy-shoot* 'small-dark popcorn-bullet-speed 0)
+                   (wait 3)))
+         (move-linear (vector2 5 0) 5)
+         (wait 150)))))
+
+  (define popcorn-start-height 225)
+
+  (define (make-popcorn* polarity n x)
+    (make-popcorn polarity
+                  (vector2 x (+ popcorn-start-height (* 16 n)))
+                  (sequence
+                    (move-linear (vector2 0 -120) 90)
+                    (wait (* 60 n))
+                    (if (eq? polarity 'light)
+                        shoot-down-light
+                        shoot-down-dark))))
+
+  (define (make-pincer* polarity x)
+    (define bullet-type*
+      (if (eq? polarity 'light)
+          'large-light
+          'large-dark))
+
+    (define speed (if (eq? polarity 'light) .6 .4))
+
+    (make-pincer polarity
+                 (vector2 x 200)
+                 (sequence
+                   (move-linear (vector2 0 -110) 80)
+                   (forever
+                    (sequence
+                      (enemy-shoot* 'large-light speed 0)
+                      (enemy-shoot* 'large-dark speed (* .25 pi))
+                      (enemy-shoot* 'large-light speed (* .5 pi))
+                      (enemy-shoot* 'large-dark speed (* .75 pi))
+                      (enemy-shoot* 'large-light speed pi)
+                      (enemy-shoot* 'large-dark speed  (* 1.25 pi))
+                      (enemy-shoot* 'large-light speed (* 1.5 pi))
+                      (enemy-shoot* 'large-dark speed (* 1.75 pi))
+                      (aim-enemy* (/ pi 32))
+                      (wait 6))))))
+
+  (append
+   (list (make-pincer* 'light 20)
+         (make-pincer* 'dark 60)
+         (make-pincer* 'light 100))
+   (concatenate
+    (list-tabulate 8
+                   (lambda (n)
+                     (let ((x (+ 8 (* 15 n)))
+                           (polarity (if (even? n) 'light 'dark)))
+                       (list (make-popcorn* polarity 0 x)
+                             (make-popcorn* (polarity-not polarity) 1 x)
+                             (make-popcorn* polarity 2 x))))))))
+
+(define %waves
+  (list (make-intro-wave make-popcorn 'light 'light 'light 1)
+        (make-intro-wave make-popcorn 'dark 'dark 'dark 1)
+        (make-intro-wave make-popcorn 'light 'light 'light 3)
+        (make-intro-wave make-popcorn 'dark 'dark 'dark 3)
+        (make-easy-wave 'light 1)
+        (make-easy-wave 'dark 1)
+        (make-easy-wave 'light 2)
+        (make-easy-wave 'dark 2)
+        (make-intro-wave make-pincer 'light 'dark 'light 1.2)
+        (make-intro-wave make-pincer 'dark 'light 'dark 1.2)
+        (make-medium-wave 'light)
+        (make-medium-wave 'dark)
+        (make-final-wave)))
 
 (define %default-world
-  (make-world #:player %default-player
-              ;; #:enemies
-              ;; (list %default-enemy
-              ;;       (call-with-actor %default-enemy
-              ;;         (lambda (enemy)
-              ;;           (make-enemy #:inherit enemy
-              ;;                       #:position (vector2 40 100))))
-              ;;       (call-with-actor %default-enemy
-              ;;         (lambda (enemy)
-              ;;           (make-enemy #:inherit enemy
-              ;;                       #:position (vector2 80 90))))
-              ;;       (call-with-actor %default-enemy
-              ;;         (lambda (enemy)
-              ;;           (make-enemy #:inherit enemy
-              ;;                       #:position (vector2 100 120)))))
-              ))
+  (make-world #:player %default-player))
 
 
 ;;;
@@ -682,6 +923,78 @@ each time KEY is pressed."
 
 (define-signal display-fps? (key-toggle 'f))
 
+
+;;;
+;;; Music and Sound
+;;;
+
+(define load-music*
+  (memoize
+   (lambda (file)
+     (load-music (string-append "assets/music/" file)))))
+
+(define-signal music
+  (signal-drop-repeats
+   (signal-let ((world world))
+     (load-music* (cond
+                   ((game-intro? world) "title-screen.ogg")
+                   ((game-over? world) "ending.ogg")
+                   ((game-won? world) "title-screen.ogg")
+                   (else "level-2.ogg"))))))
+
+(define (loop-music music)
+  (play-music music #:loop? #t))
+
+(define (load-sample* file)
+  (load-sample (string-append "assets/sounds/" file)))
+
+(define (enemy-hit-sound world time)
+  (and (any (lambda (enemy)
+              (let ((hit-time (enemy-last-hit-time (actor-ref enemy))))
+                (and hit-time (= time hit-time))))
+            (world-enemies world))
+       'enemy-hit))
+
+(define (player-shoot-sound world time)
+  (and (zero? (modulo time 5))
+       (player-shooting? (actor-ref (world-player world)))
+       'player-shoot))
+
+(define (player-death-sound world time)
+  (and (let ((death-time (player-last-death-time
+                          (actor-ref (world-player world)))))
+         (and death-time (= time death-time)))
+       'player-death))
+
+(define (explosion-sound world time)
+  (and (any (lambda (explosion)
+              (let ((explode-time (explosion-time explosion)))
+                (= time explode-time)))
+            (world-explosions world))
+       'explosion))
+
+(define (play-sound-effects sounds)
+  (for-each play-sample sounds))
+
+(define-signal sounds
+  (on-start
+   `((enemy-hit . ,(load-sample* "hit.wav"))
+     (explosion . ,(load-sample* "explosion.wav"))
+     (player-death . ,(load-sample* "player-death.wav"))
+     (player-shoot . ,(load-sample* "player-shoot.wav")))))
+
+(define-signal sound-effects
+  (signal-let ((world world)
+               (time timer)
+               (sounds sounds))
+    (filter-map (lambda (sound-proc)
+                  (let ((sound (sound-proc world time)))
+                    (and sound (assq-ref sounds sound))))
+                (list enemy-hit-sound
+                      player-shoot-sound
+                      player-death-sound
+                      explosion-sound))))
+
 
 ;;;
 ;;; View
@@ -1034,18 +1347,18 @@ each time KEY is pressed."
 ;;; Main
 ;;;
 
-(add-hook! key-press-hook (lambda (key)
-                            (when (eq? key 'escape)
-                              (stop-game-loop))))
-
-(add-hook! window-close-hook stop-game-loop)
-
-(start-sly-repl)
-
-(enable-fonts)
-
 (with-window (make-window #:title "binarium"
                           #:resolution scaled-resolution)
+  (enable-fonts)
+  (enable-audio)
+  (add-signal-hook! music loop-music)
+  (add-signal-hook! sound-effects play-sound-effects)
+  (add-hook! key-press-hook (lambda (key)
+                              (when (eq? key 'escape)
+                                (stop-game-loop))))
+
+  (add-hook! window-close-hook stop-game-loop)
+  (start-sly-repl)
   (run-game-loop scene))
 
 ;;; Local Variables:
-- 
cgit v1.2.3