diff options
| -rw-r--r-- | game.scm | 786 | ||||
| -rw-r--r-- | lisparuga/bullets.scm | 37 | ||||
| -rw-r--r-- | lisparuga/enemies.scm | 44 | ||||
| -rw-r--r-- | lisparuga/explosions.scm | 6 | ||||
| -rw-r--r-- | lisparuga/player.scm | 82 | ||||
| -rw-r--r-- | lisparuga/stats.scm | 45 | ||||
| -rw-r--r-- | lisparuga/utils.scm | 5 | ||||
| -rw-r--r-- | lisparuga/world.scm | 606 |
8 files changed, 815 insertions, 796 deletions
@@ -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)) |