Factor out all game model code into the relevant modules.

8 files changed, 815 insertions, 796 deletions

diff --git a/game.scm b/game.scm
index 2c9f257..d4df021 100644
--- a/game.scm
+++ b/game.scm
@@ -39,792 +39,6 @@
 
 
 ;;;
-;;; Model
-;;;
-
-(define bounds (make-rect (vector2 0 0) resolution))
-(define player-bounds (rect-inflate bounds -6 -8))
-(define bullet-bounds (rect-inflate bounds 32 32))
-(define player-speed 1.1)
-(define player-attack 1)
-
-
-;;;
-;;; Enemies
-;;;
-
-(define (enemy-dead? enemy)
-  (zero? (enemy-health enemy)))
-
-(define (enemy-alive? enemy)
-  (> (enemy-health enemy) 0))
-
-(define (damage-enemy enemy bullet time)
-  (make-enemy #:inherit enemy
-              #:last-hit-time time
-              #:health (max 0
-                            (- (enemy-health enemy)
-                               (if (eq? (enemy-polarity enemy)
-                                        (bullet-polarity bullet))
-                                   player-attack
-                                   ;; Bullets of opposite polarity
-                                   ;; deal double damage.
-                                   (* player-attack 2))))))
-
-
-;;;
-;;; Player
-;;;
-
-(define (kill-player player time)
-  (make-player #:inherit player #:last-death-time time))
-
-(define player-invincible-time (* 4 60))
-
-(define (player-invincible? player time)
-  (let ((last-death (player-last-death-time player)))
-    (and last-death
-         (negative?
-          (- time (+ last-death player-invincible-time))))))
-
-(define (toggle-polarity player)
-  (make-player #:inherit player
-               #:polarity (if (eq? (player-polarity player) 'light)
-                              'dark
-                              'light)))
-
-
-;;;
-;;; Bullets
-;;;
-
-(define (kill-bullet bullet)
-  (make-bullet #:inherit bullet #:live? #f))
-
-(define (move-bullet bullet offset)
-  (make-bullet #:inherit bullet
-               #:position (v+ (bullet-position bullet) offset)))
-
-(define (move-bullet-to bullet position)
-  (make-bullet #:inherit bullet #:position position))
-
-(define (bullet-in-bounds? bullet)
-  (rect-contains? bullet-bounds (bullet-position bullet)))
-
-(define (forward speed)
-  (lambda (world effects bullet)
-    (values #f
-            effects
-            (move-bullet bullet (polar2 speed (bullet-direction bullet))))))
-
-(define (direct-player player direction)
-  (make-player #:inherit player #:direction direction))
-
-(define (move-player player offset)
-  (make-player #:inherit player
-               #:position (rect-clamp player-bounds
-                                      (v+ (player-position player) offset))))
-
-(define (set-player-shooting player shooting?)
-  (make-player #:inherit player #:shooting? shooting?))
-
-(define (player-forward speed)
-  (lambda (world effects player)
-    (values #f
-            effects
-            (move-player player (v* speed (player-direction player))))))
-
-(define player-bullet-script
-  (forever (forward 5)))
-
-(define player-bullet-direction (/ pi 2))
-
-(define (make-player-bullet player offset)
-  (make-actor (make-bullet #:position (v+ (player-position player) offset)
-                           #:type (match (player-polarity player)
-                                    ('light 'player-light)
-                                    ('dark 'player-dark))
-                           #:direction player-bullet-direction)
-              player-bullet-script))
-
-(define (add-player-bullets world bullets)
-  (make-world #:inherit world
-              #:player-bullets
-              (append bullets (world-player-bullets world))))
-
-(define (player-shoot world player)
-  (add-player-bullets world
-                      (list
-                       (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)))
-
-(define (aim-enemy enemy offset)
-  (make-enemy #:inherit enemy
-              #:aim (+ (enemy-aim enemy) offset)))
-
-(define (add-enemy-bullets world bullets)
-  (make-world #:inherit world
-              #:enemy-bullets
-              (append bullets (world-enemy-bullets world))))
-
-(define (add-enemy-bullet world bullet)
-  (make-world #:inherit world
-              #:enemy-bullets
-              (cons bullet (world-enemy-bullets world))))
-
-(define (simple-enemy-bullet position direction speed)
-  (make-actor (make-bullet #:type 'small-light
-                           #:position position
-                           #:direction direction)
-              (forever (forward speed))))
-
-(define (enemy-shoot world enemy type speed aim-offset)
-  (let* ((position (enemy-position enemy))
-         (bullet (make-actor (make-bullet #:type type
-                                          #:polarity (match type
-                                                       ((or 'small-light
-                                                            'large-light)
-                                                        'light)
-                                                       ((or 'small-dark
-                                                            'large-dark)
-                                                        'dark))
-                                          #:position position
-                                          #:direction (+ (enemy-aim enemy)
-                                                         aim-offset))
-                             (forever (forward speed)))))
-    (add-enemy-bullet world bullet)))
-
-(define (enemy-shoot-at-player world enemy speed)
-  (let* ((v (normalize
-             (v- (enemy-position enemy)
-                 (player-position
-                  (actor-ref
-                   (world-player world))))))
-         (direction (+ pi (atan (vy v) (vx v))))
-         (position (enemy-position enemy))
-         (bullets
-          (list (simple-enemy-bullet position (+ direction (/ pi 16)) speed)
-                (simple-enemy-bullet position (+ direction (/ pi 8)) speed)
-                (simple-enemy-bullet position direction speed)
-                (simple-enemy-bullet position (- direction (/ pi 8)) speed)
-                (simple-enemy-bullet position (- direction (/ pi 16)) speed))))
-    (add-enemy-bullets world bullets)))
-
-(define (explosion-active? explosion current-time)
-  (< (- current-time (explosion-time explosion)) 15))
-
-
-;;;
-;;; Stats
-;;;
-
-(define (decrement-life stats)
-  (make-stats #:inherit stats
-              #:lives (max 0 (1- (stats-lives stats)))))
-
-(define max-chain-multiplier 10)
-
-(define (add-to-score enemy stats)
-  ;; TODO: Award different points for different types of enemies.
-  (make-stats #:inherit stats
-              #:score (+ (stats-score stats)
-                         1000          ; base kill points
-                         ;; Chain multiplier.
-                         (* 255
-                            (min (stats-chain stats)
-                                 max-chain-multiplier)))))
-
-(define (add-to-chain enemy stats)
-  (let* ((enemy-polarity (enemy-polarity enemy))
-         (chain-polarity (stats-chain-type stats))
-         (progress (stats-chain-progress stats)))
-    (cond
-     ((or (zero? progress) (= progress 3))
-      (make-stats #:inherit stats
-                  #:chain-type enemy-polarity
-                  #:chain-progress 1))
-     ((not (eq? enemy-polarity chain-polarity))
-      (make-stats #:inherit stats
-                  #:chain-type #f
-                  #:chain-progress 0
-                  #:chain 0))
-     ((= progress 1)
-      (make-stats #:inherit stats
-                  #:chain-progress 2))
-     ((= progress 2)
-      (make-stats #:inherit stats
-                  #:chain-progress 3
-                  #:chain (1+ (stats-chain stats)))))))
-
-
-;;;
-;;; Collision detection
-;;;
-
-(define (player-world-hitbox player)
-  (rect-move (player-hitbox player) (player-position player)))
-
-(define (player-world-absorb-hitbox player)
-  (rect-move (player-absorb-hitbox player) (player-position player)))
-
-(define (enemy-world-hitbox enemy)
-  (rect-move (enemy-hitbox enemy) (enemy-position enemy)))
-
-(define (bullet-world-hitbox bullet)
-  (rect-move (bullet-hitbox bullet) (bullet-position bullet)))
-
-(define (enemy/player-collision? enemy player)
-  (rect-intersects? (enemy-world-hitbox enemy)
-                    (player-world-hitbox player)))
-
-(define (enemy/bullet-collision? enemy bullet)
-  (rect-intersects? (enemy-world-hitbox enemy)
-                    (bullet-world-hitbox bullet)))
-
-(define (player/bullet-polarity-eq? player bullet)
-  (eq? (player-polarity player) (bullet-polarity bullet)))
-
-(define (player/bullet-collision? player bullet)
-  (rect-intersects? (if (player/bullet-polarity-eq? player bullet)
-                        (player-world-absorb-hitbox player)
-                        (player-world-hitbox player))
-                    (bullet-world-hitbox bullet)))
-
-(define (collide-enemies-and-bullets enemies player-bullets stats time)
-  (define (collide enemy bullets stats explosions)
-    (let loop ((bullets bullets)
-               (prev-bullets '())
-               (stats stats))
-      (match bullets
-        (()
-         (values enemy (reverse prev-bullets) stats explosions))
-        ((bullet . rest)
-         (if (enemy/bullet-collision? (actor-ref enemy) (actor-ref bullet))
-             (let* ((new-enemy (call-with-actor enemy
-                                (lambda (enemy)
-                                  (damage-enemy enemy
-                                                (actor-ref bullet)
-                                                time))))
-                    (new-enemy* (actor-ref new-enemy)))
-               (values new-enemy
-                       ;; Remove bullet.
-                       (append (reverse prev-bullets) rest)
-                       (if (enemy-alive? new-enemy*)
-                           stats
-                           ;; Enemy killed, add to player score and
-                           (add-to-chain new-enemy*
-                                         (add-to-score new-enemy* stats)))
-                       (if (enemy-alive? new-enemy*)
-                           explosions
-                           ;; Add new explosion.
-                           (cons (make-explosion #:type 'regular
-                                                 #:position (enemy-position
-                                                             new-enemy*)
-                                                 #:time time)
-                                 explosions))))
-             (loop rest (cons bullet prev-bullets) stats))))))
-
-  (let loop ((enemies enemies)
-             (new-enemies '())
-             (bullets player-bullets)
-             (explosions '())
-             (stats stats))
-    (match enemies
-      (()
-       (values (reverse new-enemies) bullets stats explosions))
-      ((enemy . rest)
-       (let-values (((new-enemy bullets stats explosions)
-                     (collide enemy bullets stats explosions)))
-         (loop rest
-               (if (enemy-alive? (actor-ref new-enemy))
-                   (cons new-enemy new-enemies)
-                   new-enemies)
-               bullets
-               explosions
-               stats))))))
-
-(define (collide-player-and-enemies player enemies stats time)
-  (let loop ((enemies enemies))
-    (match enemies
-      (()
-       (values player stats '()))
-      ((enemy . rest)
-       (if (enemy/player-collision? (actor-ref enemy) (actor-ref player))
-           (let* ((invincible? (player-invincible? (actor-ref player) time))
-                  (new-player (if invincible?
-                                  player
-                                  (call-with-actor player
-                                    (lambda (player)
-                                      (kill-player player time)))))
-                  (position (player-position (actor-ref player)))
-                  (explosion (make-explosion #:type 'player
-                                             #:position position
-                                             #:time time)))
-             (values new-player
-                     (if invincible?
-                         stats
-                         (decrement-life stats))
-                     (list explosion)))
-           (loop rest))))))
-
-(define (collide-player-and-bullets player enemy-bullets stats time)
-  (let loop ((bullets enemy-bullets)
-             (new-bullets '()))
-    (match bullets
-      (()
-       (values player (reverse new-bullets) stats '()))
-      ((bullet . rest)
-       (let* ((b (actor-ref bullet))
-              (p (actor-ref player)))
-         (if (player/bullet-collision? p b)
-             (let* ((hit? (not (or (player-invincible? p time)
-                                   (player/bullet-polarity-eq? p b))))
-                    (new-player (if hit?
-                                    (call-with-actor player
-                                      (lambda (player)
-                                        (kill-player player time)))
-                                    player))
-                    (position (player-position p))
-                    (explosion (make-explosion #:type 'player
-                                               #:position position
-                                               #:time time)))
-               (values new-player
-                       (append (reverse new-bullets) rest)
-                       (if hit? (decrement-life stats) stats)
-                       (if hit? (list explosion) '())))
-             (loop rest (cons bullet new-bullets))))))))
-
-
-;;;
-;;; Game world simulation
-;;;
-
-(define (final-wave? world)
-  (= (length (world-waves world)) 1))
-
-(define (game-over? world)
-  (zero? (stats-lives (world-stats world))))
-
-(define (game-won? world)
-  (and (null? (world-waves world))
-       (null? (world-enemies world))
-       (not (game-over? world))))
-
-(define (game-intro? world)
-  (not (world-waves world)))
-
-(define (keep-bullet? bullet)
-  (and (bullet-live? bullet)
-       (bullet-in-bounds? bullet)))
-
-(define (update-bullets effects world bullets)
-  ;; TODO: Gather effects
-  (values effects
-          (filter-map (lambda (actor)
-                        (let-values (((effects new-actor)
-                                      (update-actor world '() actor)))
-                          (let ((bullet (actor-ref new-actor)))
-                            (and (bullet-live? bullet)
-                                 (bullet-in-bounds? bullet)
-                                 new-actor))))
-                      bullets)))
-
-(define (update-enemies effects world)
-  ;; TODO: gather effects
-  (let-values (((new-effects new-enemies)
-                (actor-filter-update enemy-alive? world (world-enemies world))))
-    (values (append new-effects effects) new-enemies)))
-
-(define (update-player effects world)
-  (update-actor world effects (world-player world)))
-
-(define (update-world world time)
-  (let*-values
-      (((game-over?) (game-over? world))
-       ((game-won?) (game-won? world))
-       ((effects new-player)
-        (if game-over?
-            (values '() (world-player world))
-            (update-player '() world)))
-       ((effects new-enemies) (update-enemies effects world))
-       ((effects new-player-bullets)
-        (if game-over?
-            (values effects '())
-            (update-bullets effects world (world-player-bullets world))))
-       ((effects new-enemy-bullets)
-        (update-bullets effects world (world-enemy-bullets world)))
-       ((stats) (world-stats world))
-       ((new-enemies new-player-bullets new-stats explosions1)
-        ;; Don't allow enemies to be killed after the game has been
-        ;; lost because that would lead to strange things.
-        (if game-over?
-            (values new-enemies new-player-bullets stats '())
-            (collide-enemies-and-bullets new-enemies new-player-bullets
-                                         stats time)))
-       ;; Move to the next wave, if needed.
-       ((new-enemies new-waves)
-        (let ((waves (world-waves world)))
-          (cond
-           ((not waves)
-            (values new-enemies #f))
-           ((null? waves)
-            (values new-enemies '()))
-           ((null? new-enemies)
-            (values (car waves) (cdr waves)))
-           (else
-            (values new-enemies waves)))))
-       ((new-player new-enemy-bullets new-stats explosions2)
-        ;; Don't collide when the game has been won or lost.
-        (if (or game-over? game-won?)
-            (values new-player new-enemy-bullets new-stats '())
-            (collide-player-and-bullets new-player new-enemy-bullets
-                                        new-stats time)))
-       ((new-player new-stats explosions3)
-        ;; Don't collide when the game has been lost.  By definition
-        ;; their are no enemies when the game is won, so we don't have
-        ;; to worry about that case.
-        (if game-over?
-            (values new-player new-stats '())
-            (collide-player-and-enemies new-player new-enemies
-                                        new-stats time)))
-       ((new-explosions)
-        (filter (lambda (explosion)
-                  (explosion-active? explosion time))
-                (append explosions1
-                        explosions2
-                        explosions3
-                        (world-explosions world)))))
-    (apply-effects effects
-                   (make-world #:player new-player
-                               #:player-bullets new-player-bullets
-                               #:enemies new-enemies
-                               #:enemy-bullets new-enemy-bullets
-                               #:waves new-waves
-                               #:stats new-stats
-                               #:explosions new-explosions))))
-
-(define (world-eval exp world)
-  (match exp
-    (('null) world)
-    (('tick time)
-     (update-world world time))
-    (('player-direction direction)
-     (make-world #:inherit world
-                 #:player (call-with-actor (world-player world)
-                            (lambda (player)
-                              (direct-player player direction)))))
-    (('player-shoot shooting?)
-     (make-world #:inherit world
-                 #:player (call-with-actor (world-player world)
-                            (lambda (player)
-                              (set-player-shooting player shooting?)))))
-    (('player-toggle-polarity)
-     (make-world #:inherit world
-                 #:player (call-with-actor (world-player world)
-                            toggle-polarity)))
-    (('restart restart?)
-     (if (and restart?
-              (or (game-over? world)
-                  (game-won? world)
-                  (game-intro? world)))
-         (make-world #:inherit %default-world
-                     #: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))
-(define enemy-shoot-at-player* (action-effect-lift enemy-shoot-at-player))
-
-(define %default-player
-  (make-actor (make-player)
-              (forever
-               (both (repeat 3 (player-forward player-speed))
-                     (whena player-shooting? (player-shoot*))))))
-
-(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
-                   (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))
-
-
-;;;
 ;;; Controller
 ;;;
 
diff --git a/lisparuga/bullets.scm b/lisparuga/bullets.scm
index 17322f6..c16df8b 100644
--- a/lisparuga/bullets.scm
+++ b/lisparuga/bullets.scm
@@ -17,15 +17,25 @@
 (define-module (lisparuga bullets)
   #:use-module (sly records)
   #:use-module (sly math rect)
+  #:use-module (sly math vector)
   #:use-module (lisparuga utils)
-  #:export (make-bullet
+  #:export (%bullet-bounds
+            make-bullet
             bullet?
             bullet-type
             bullet-polarity
             bullet-live?
             bullet-position
             bullet-direction
-            bullet-hitbox))
+            bullet-hitbox
+            kill-bullet
+            move-bullet
+            move-bullet-to
+            bullet-in-bounds?
+            forward
+            bullet-world-hitbox))
+
+(define %bullet-bounds (rect-inflate bounds 32 32))
 
 (define-record-type* <bullet>
   %make-bullet make-bullet
@@ -36,3 +46,26 @@
   (position bullet-position origin2)
   (direction bullet-direction 0)
   (hitbox bullet-hitbox (make-rect -1 -1 1 1)))
+
+(define (kill-bullet bullet)
+  (make-bullet #:inherit bullet #:live? #f))
+
+(define (move-bullet bullet offset)
+  (make-bullet #:inherit bullet
+               #:position (v+ (bullet-position bullet) offset)))
+
+(define (move-bullet-to bullet position)
+  (make-bullet #:inherit bullet #:position position))
+
+(define (bullet-in-bounds? bullet)
+  (rect-contains? %bullet-bounds (bullet-position bullet)))
+
+(define (forward speed)
+  (lambda (world effects bullet)
+    (values #f
+            effects
+            (move-bullet bullet
+                         (polar2 speed (bullet-direction bullet))))))
+
+(define (bullet-world-hitbox bullet)
+  (rect-move (bullet-hitbox bullet) (bullet-position bullet)))
diff --git a/lisparuga/enemies.scm b/lisparuga/enemies.scm
index 06b2036..7160191 100644
--- a/lisparuga/enemies.scm
+++ b/lisparuga/enemies.scm
@@ -18,6 +18,8 @@
   #:use-module (sly records)
   #:use-module (sly math rect)
   #:use-module (sly math vector)
+  #:use-module (lisparuga bullets)
+  #:use-module (lisparuga player)
   #:use-module (lisparuga utils)
   #:export (make-enemy
             enemy?
@@ -27,7 +29,14 @@
             enemy-polarity
             enemy-hitbox
             enemy-last-hit-time
-            enemy-health))
+            enemy-health
+            enemy-dead?
+            enemy-alive?
+            damage-enemy
+            place-enemy
+            move-enemy
+            aim-enemy
+            enemy-world-hitbox))
 
 (define-record-type* <enemy>
   %make-enemy make-enemy
@@ -41,3 +50,36 @@
   (hitbox enemy-hitbox (make-rect -5 -5 10 10))
   (last-hit-time enemy-last-hit-time #f)
   (health enemy-health 0))
+
+(define (enemy-dead? enemy)
+  (zero? (enemy-health enemy)))
+
+(define (enemy-alive? enemy)
+  (> (enemy-health enemy) 0))
+
+(define (damage-enemy enemy bullet time)
+  (make-enemy #:inherit enemy
+              #:last-hit-time time
+              #:health (max 0
+                            (- (enemy-health enemy)
+                               (if (eq? (enemy-polarity enemy)
+                                        (bullet-polarity bullet))
+                                   %player-attack
+                                   ;; Bullets of opposite polarity
+                                   ;; deal double damage.
+                                   (* %player-attack 2))))))
+
+(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)))
+
+(define (aim-enemy enemy offset)
+  (make-enemy #:inherit enemy
+              #:aim (+ (enemy-aim enemy) offset)))
+
+(define (enemy-world-hitbox enemy)
+  (rect-move (enemy-hitbox enemy) (enemy-position enemy)))
diff --git a/lisparuga/explosions.scm b/lisparuga/explosions.scm
index 48bf536..5485b04 100644
--- a/lisparuga/explosions.scm
+++ b/lisparuga/explosions.scm
@@ -22,7 +22,8 @@
             explosion?
             explosion-type
             explosion-position
-            explosion-time))
+            explosion-time
+            explosion-active?))
 
 (define-record-type* <explosion>
   %make-explosion make-explosion
@@ -30,3 +31,6 @@
   (type explosion-type 'regular)
   (position explosion-position origin2)
   (time explosion-time 0))
+
+(define (explosion-active? explosion current-time)
+  (< (- current-time (explosion-time explosion)) 15))
diff --git a/lisparuga/player.scm b/lisparuga/player.scm
index ca6f491..1646f15 100644
--- a/lisparuga/player.scm
+++ b/lisparuga/player.scm
@@ -15,11 +15,19 @@
 ;;; along with Lisparuga.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (lisparuga player)
-  #:use-module (sly records)
+  #:use-module (ice-9 match)
+  #:use-module (sly actor)
+  #:use-module (sly math)
   #:use-module (sly math rect)
   #:use-module (sly math vector)
+  #:use-module (sly records)
+  #:use-module (lisparuga bullets)
   #:use-module (lisparuga utils)
-  #:export (make-player
+  #:export (%player-bounds
+            %player-speed
+            %player-attack
+            %player-invincible-time
+            make-player
             player?
             player-polarity
             player-position
@@ -27,7 +35,23 @@
             player-shooting?
             player-hitbox
             player-absorb-hitbox
-            player-last-death-time))
+            player-last-death-time
+            kill-player
+            player-invincible?
+            toggle-polarity
+            direct-player
+            move-player
+            set-player-shooting
+            player-forward
+            player-bullet-script
+            make-player-bullet
+            player-world-hitbox
+            player-world-absorb-hitbox))
+
+(define %player-bounds (rect-inflate bounds -6 -8))
+(define %player-speed 1.1)
+(define %player-attack 1)
+(define %player-invincible-time (* 4 60))
 
 (define-record-type* <player>
   %make-player make-player
@@ -39,3 +63,55 @@
   (hitbox player-hitbox (make-rect -1 1 2 4))
   (absorb-hitbox player-absorb-hitbox (make-rect -9 -2 16 6))
   (last-death-time player-last-death-time #f))
+
+(define (kill-player player time)
+  (make-player #:inherit player #:last-death-time time))
+
+(define (player-invincible? player time)
+  (let ((last-death (player-last-death-time player)))
+    (and last-death
+         (negative?
+          (- time (+ last-death %player-invincible-time))))))
+
+(define (toggle-polarity player)
+  (make-player #:inherit player
+               #:polarity (if (eq? (player-polarity player) 'light)
+                              'dark
+                              'light)))
+
+(define (direct-player player direction)
+  (make-player #:inherit player #:direction direction))
+
+(define (move-player player offset)
+  (make-player #:inherit player
+               #:position (rect-clamp %player-bounds
+                                      (v+ (player-position player)
+                                          offset))))
+
+(define (set-player-shooting player shooting?)
+  (make-player #:inherit player #:shooting? shooting?))
+
+(define (player-forward speed)
+  (lambda (world effects player)
+    (values #f
+            effects
+            (move-player player (v* speed (player-direction player))))))
+
+(define player-bullet-script
+  (forever (forward 5)))
+
+(define player-bullet-direction (/ pi 2))
+
+(define (make-player-bullet player offset)
+  (make-actor (make-bullet #:position (v+ (player-position player) offset)
+                           #:type (match (player-polarity player)
+                                    ('light 'player-light)
+                                    ('dark 'player-dark))
+                           #:direction player-bullet-direction)
+              player-bullet-script))
+
+(define (player-world-hitbox player)
+  (rect-move (player-hitbox player) (player-position player)))
+
+(define (player-world-absorb-hitbox player)
+  (rect-move (player-absorb-hitbox player) (player-position player)))
diff --git a/lisparuga/stats.scm b/lisparuga/stats.scm
index 3abcdef..8d159ec 100644
--- a/lisparuga/stats.scm
+++ b/lisparuga/stats.scm
@@ -16,6 +16,8 @@
 
 (define-module (lisparuga stats)
   #:use-module (sly records)
+  #:use-module (lisparuga enemies)
+  #:use-module (lisparuga player)
   #:use-module (lisparuga utils)
   #:export (make-stats
             stats?
@@ -23,7 +25,10 @@
             stats-lives
             stats-chain
             stats-chain-type
-            stats-chain-progress))
+            stats-chain-progress
+            decrement-life
+            add-to-score
+            add-to-chain))
 
 (define-record-type* <stats>
   %make-stats make-stats
@@ -33,3 +38,41 @@
   (chain stats-chain 0)
   (chain-type stats-chain-type #f)
   (chain-progress stats-chain-progress 0))
+
+(define (decrement-life stats)
+  (make-stats #:inherit stats
+              #:lives (max 0 (1- (stats-lives stats)))))
+
+(define max-chain-multiplier 10)
+
+(define (add-to-score enemy stats)
+  ;; TODO: Award different points for different types of enemies.
+  (make-stats #:inherit stats
+              #:score (+ (stats-score stats)
+                         1000          ; base kill points
+                         ;; Chain multiplier.
+                         (* 255
+                            (min (stats-chain stats)
+                                 max-chain-multiplier)))))
+
+(define (add-to-chain enemy stats)
+  (let* ((enemy-polarity (enemy-polarity enemy))
+         (chain-polarity (stats-chain-type stats))
+         (progress (stats-chain-progress stats)))
+    (cond
+     ((or (zero? progress) (= progress 3))
+      (make-stats #:inherit stats
+                  #:chain-type enemy-polarity
+                  #:chain-progress 1))
+     ((not (eq? enemy-polarity chain-polarity))
+      (make-stats #:inherit stats
+                  #:chain-type #f
+                  #:chain-progress 0
+                  #:chain 0))
+     ((= progress 1)
+      (make-stats #:inherit stats
+                  #:chain-progress 2))
+     ((= progress 2)
+      (make-stats #:inherit stats
+                  #:chain-progress 3
+                  #:chain (1+ (stats-chain stats)))))))
diff --git a/lisparuga/utils.scm b/lisparuga/utils.scm
index f5f02b1..0c67504 100644
--- a/lisparuga/utils.scm
+++ b/lisparuga/utils.scm
@@ -15,9 +15,12 @@
 ;;; along with Lisparuga.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (lisparuga utils)
+  #:use-module (sly math rect)
   #:use-module (sly math vector)
   #:export (resolution
-            origin2))
+            origin2
+            bounds))
 
 (define resolution (vector2 120 160))
 (define origin2 (vector2 0 0))
+(define bounds (make-rect (vector2 0 0) resolution))
diff --git a/lisparuga/world.scm b/lisparuga/world.scm
index 6c7b431..6a65630 100644
--- a/lisparuga/world.scm
+++ b/lisparuga/world.scm
@@ -15,8 +15,17 @@
 ;;; along with Lisparuga.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (lisparuga world)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
   #:use-module (sly actor)
+  #:use-module (sly math)
+  #:use-module (sly math rect)
+  #:use-module (sly math vector)
   #:use-module (sly records)
+  #:use-module (lisparuga bullets)
+  #:use-module (lisparuga enemies)
+  #:use-module (lisparuga explosions)
   #:use-module (lisparuga player)
   #:use-module (lisparuga stats)
   #:use-module (lisparuga utils)
@@ -28,7 +37,19 @@
             world-player-bullets
             world-enemies
             world-enemy-bullets
-            world-explosions))
+            world-explosions
+            add-player-bullets
+            player-shoot
+            add-enemy-bullets
+            add-enemy-bullet
+            enemy-shoot
+            final-wave?
+            game-over?
+            game-won?
+            game-intro?
+            update-world
+            world-eval
+            %default-world))
 
 (define-record-type* <world>
   %make-world make-world
@@ -40,3 +61,586 @@
   (enemies world-enemies '())
   (enemy-bullets world-enemy-bullets '())
   (explosions world-explosions '()))
+
+(define (add-player-bullets world bullets)
+  (make-world #:inherit world
+              #:player-bullets
+              (append bullets (world-player-bullets world))))
+
+(define (player-shoot world player)
+  (add-player-bullets world
+                      (list
+                       (make-player-bullet player (vector2 -2 1))
+                       (make-player-bullet player (vector2 4 1)))))
+
+(define (add-enemy-bullets world bullets)
+  (make-world #:inherit world
+              #:enemy-bullets
+              (append bullets (world-enemy-bullets world))))
+
+(define (add-enemy-bullet world bullet)
+  (make-world #:inherit world
+              #:enemy-bullets
+              (cons bullet (world-enemy-bullets world))))
+
+(define (enemy-shoot world enemy type speed aim-offset)
+  (let* ((position (enemy-position enemy))
+         (bullet (make-actor (make-bullet #:type type
+                                          #:polarity (match type
+                                                       ((or 'small-light
+                                                            'large-light)
+                                                        'light)
+                                                       ((or 'small-dark
+                                                            'large-dark)
+                                                        'dark))
+                                          #:position position
+                                          #:direction (+ (enemy-aim enemy)
+                                                         aim-offset))
+                             (forever (forward speed)))))
+    (add-enemy-bullet world bullet)))
+
+
+;;;
+;;; Collision detection
+;;;
+
+(define (keep-bullet? bullet)
+  (and (bullet-live? bullet)
+       (bullet-in-bounds? bullet)))
+
+(define (enemy/player-collision? enemy player)
+  (rect-intersects? (enemy-world-hitbox enemy)
+                    (player-world-hitbox player)))
+
+(define (enemy/bullet-collision? enemy bullet)
+  (rect-intersects? (enemy-world-hitbox enemy)
+                    (bullet-world-hitbox bullet)))
+
+(define (player/bullet-polarity-eq? player bullet)
+  (eq? (player-polarity player) (bullet-polarity bullet)))
+
+(define (player/bullet-collision? player bullet)
+  (rect-intersects? (if (player/bullet-polarity-eq? player bullet)
+                        (player-world-absorb-hitbox player)
+                        (player-world-hitbox player))
+                    (bullet-world-hitbox bullet)))
+
+(define (collide-enemies-and-bullets enemies player-bullets stats time)
+  (define (collide enemy bullets stats explosions)
+    (let loop ((bullets bullets)
+               (prev-bullets '())
+               (stats stats))
+      (match bullets
+        (()
+         (values enemy (reverse prev-bullets) stats explosions))
+        ((bullet . rest)
+         (if (enemy/bullet-collision? (actor-ref enemy) (actor-ref bullet))
+             (let* ((new-enemy (call-with-actor enemy
+                                (lambda (enemy)
+                                  (damage-enemy enemy
+                                                (actor-ref bullet)
+                                                time))))
+                    (new-enemy* (actor-ref new-enemy)))
+               (values new-enemy
+                       ;; Remove bullet.
+                       (append (reverse prev-bullets) rest)
+                       (if (enemy-alive? new-enemy*)
+                           stats
+                           ;; Enemy killed, add to player score and
+                           (add-to-chain new-enemy*
+                                         (add-to-score new-enemy* stats)))
+                       (if (enemy-alive? new-enemy*)
+                           explosions
+                           ;; Add new explosion.
+                           (cons (make-explosion #:type 'regular
+                                                 #:position (enemy-position
+                                                             new-enemy*)
+                                                 #:time time)
+                                 explosions))))
+             (loop rest (cons bullet prev-bullets) stats))))))
+
+  (let loop ((enemies enemies)
+             (new-enemies '())
+             (bullets player-bullets)
+             (explosions '())
+             (stats stats))
+    (match enemies
+      (()
+       (values (reverse new-enemies) bullets stats explosions))
+      ((enemy . rest)
+       (let-values (((new-enemy bullets stats explosions)
+                     (collide enemy bullets stats explosions)))
+         (loop rest
+               (if (enemy-alive? (actor-ref new-enemy))
+                   (cons new-enemy new-enemies)
+                   new-enemies)
+               bullets
+               explosions
+               stats))))))
+
+(define (collide-player-and-enemies player enemies stats time)
+  (let loop ((enemies enemies))
+    (match enemies
+      (()
+       (values player stats '()))
+      ((enemy . rest)
+       (if (enemy/player-collision? (actor-ref enemy) (actor-ref player))
+           (let* ((invincible? (player-invincible? (actor-ref player) time))
+                  (new-player (if invincible?
+                                  player
+                                  (call-with-actor player
+                                    (lambda (player)
+                                      (kill-player player time)))))
+                  (position (player-position (actor-ref player)))
+                  (explosion (make-explosion #:type 'player
+                                             #:position position
+                                             #:time time)))
+             (values new-player
+                     (if invincible?
+                         stats
+                         (decrement-life stats))
+                     (list explosion)))
+           (loop rest))))))
+
+(define (collide-player-and-bullets player enemy-bullets stats time)
+  (let loop ((bullets enemy-bullets)
+             (new-bullets '()))
+    (match bullets
+      (()
+       (values player (reverse new-bullets) stats '()))
+      ((bullet . rest)
+       (let* ((b (actor-ref bullet))
+              (p (actor-ref player)))
+         (if (player/bullet-collision? p b)
+             (let* ((hit? (not (or (player-invincible? p time)
+                                   (player/bullet-polarity-eq? p b))))
+                    (new-player (if hit?
+                                    (call-with-actor player
+                                      (lambda (player)
+                                        (kill-player player time)))
+                                    player))
+                    (position (player-position p))
+                    (explosion (make-explosion #:type 'player
+                                               #:position position
+                                               #:time time)))
+               (values new-player
+                       (append (reverse new-bullets) rest)
+                       (if hit? (decrement-life stats) stats)
+                       (if hit? (list explosion) '())))
+             (loop rest (cons bullet new-bullets))))))))
+
+
+;;;
+;;; Game world simulation
+;;;
+
+(define (final-wave? world)
+  (= (length (world-waves world)) 1))
+
+(define (game-over? world)
+  (zero? (stats-lives (world-stats world))))
+
+(define (game-won? world)
+  (and (null? (world-waves world))
+       (null? (world-enemies world))
+       (not (game-over? world))))
+
+(define (game-intro? world)
+  (not (world-waves world)))
+
+(define (update-bullets effects world bullets)
+  ;; TODO: Gather effects
+  (values effects
+          (filter-map (lambda (actor)
+                        (let-values (((effects new-actor)
+                                      (update-actor world '() actor)))
+                          (let ((bullet (actor-ref new-actor)))
+                            (and (bullet-live? bullet)
+                                 (bullet-in-bounds? bullet)
+                                 new-actor))))
+                      bullets)))
+
+(define (update-enemies effects world)
+  ;; TODO: gather effects
+  (let-values (((new-effects new-enemies)
+                (actor-filter-update enemy-alive? world (world-enemies world))))
+    (values (append new-effects effects) new-enemies)))
+
+(define (update-player effects world)
+  (update-actor world effects (world-player world)))
+
+(define (update-world world time)
+  (let*-values
+      (((game-over?) (game-over? world))
+       ((game-won?) (game-won? world))
+       ((effects new-player)
+        (if game-over?
+            (values '() (world-player world))
+            (update-player '() world)))
+       ((effects new-enemies) (update-enemies effects world))
+       ((effects new-player-bullets)
+        (if game-over?
+            (values effects '())
+            (update-bullets effects world (world-player-bullets world))))
+       ((effects new-enemy-bullets)
+        (update-bullets effects world (world-enemy-bullets world)))
+       ((stats) (world-stats world))
+       ((new-enemies new-player-bullets new-stats explosions1)
+        ;; Don't allow enemies to be killed after the game has been
+        ;; lost because that would lead to strange things.
+        (if game-over?
+            (values new-enemies new-player-bullets stats '())
+            (collide-enemies-and-bullets new-enemies new-player-bullets
+                                         stats time)))
+       ;; Move to the next wave, if needed.
+       ((new-enemies new-waves)
+        (let ((waves (world-waves world)))
+          (cond
+           ((not waves)
+            (values new-enemies #f))
+           ((null? waves)
+            (values new-enemies '()))
+           ((null? new-enemies)
+            (values (car waves) (cdr waves)))
+           (else
+            (values new-enemies waves)))))
+       ((new-player new-enemy-bullets new-stats explosions2)
+        ;; Don't collide when the game has been won or lost.
+        (if (or game-over? game-won?)
+            (values new-player new-enemy-bullets new-stats '())
+            (collide-player-and-bullets new-player new-enemy-bullets
+                                        new-stats time)))
+       ((new-player new-stats explosions3)
+        ;; Don't collide when the game has been lost.  By definition
+        ;; their are no enemies when the game is won, so we don't have
+        ;; to worry about that case.
+        (if game-over?
+            (values new-player new-stats '())
+            (collide-player-and-enemies new-player new-enemies
+                                        new-stats time)))
+       ((new-explosions)
+        (filter (lambda (explosion)
+                  (explosion-active? explosion time))
+                (append explosions1
+                        explosions2
+                        explosions3
+                        (world-explosions world)))))
+    (apply-effects effects
+                   (make-world #:player new-player
+                               #:player-bullets new-player-bullets
+                               #:enemies new-enemies
+                               #:enemy-bullets new-enemy-bullets
+                               #:waves new-waves
+                               #:stats new-stats
+                               #:explosions new-explosions))))
+
+(define (world-eval exp world)
+  (match exp
+    (('null) world)
+    (('tick time)
+     (update-world world time))
+    (('player-direction direction)
+     (make-world #:inherit world
+                 #:player (call-with-actor (world-player world)
+                            (lambda (player)
+                              (direct-player player direction)))))
+    (('player-shoot shooting?)
+     (make-world #:inherit world
+                 #:player (call-with-actor (world-player world)
+                            (lambda (player)
+                              (set-player-shooting player shooting?)))))
+    (('player-toggle-polarity)
+     (make-world #:inherit world
+                 #:player (call-with-actor (world-player world)
+                            toggle-polarity)))
+    (('restart restart?)
+     (if (and restart?
+              (or (game-over? world)
+                  (game-won? world)
+                  (game-intro? world)))
+         (make-world #:inherit %default-world
+                     #: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))
+
+(define %default-player
+  (make-actor (make-player)
+              (forever
+               (both (repeat 3 (player-forward %player-speed))
+                     (whena player-shooting? (player-shoot*))))))
+
+(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
+                   (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))