summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--game.scm786
-rw-r--r--lisparuga/bullets.scm37
-rw-r--r--lisparuga/enemies.scm44
-rw-r--r--lisparuga/explosions.scm6
-rw-r--r--lisparuga/player.scm82
-rw-r--r--lisparuga/stats.scm45
-rw-r--r--lisparuga/utils.scm5
-rw-r--r--lisparuga/world.scm606
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))