diff options
| -rw-r--r-- | game.scm | 373 |
1 files changed, 339 insertions, 34 deletions
@@ -39,45 +39,79 @@ (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) (define origin2 (vector2 0 0)) + +;;; +;;; Data types +;;; + (define-record-type* <bullet> %make-bullet make-bullet bullet? (type bullet-type 'generic) + (polarity bullet-polarity 'light) (live? bullet-live? #t) (position bullet-position origin2) - (direction bullet-direction 0)) + (direction bullet-direction 0) + (hitbox bullet-hitbox (make-rect -1 -1 1 1))) (define-record-type* <player> %make-player make-player player? + (polarity player-polarity 'light) (position player-position (vector2 (/ (vx resolution) 2) 4)) (direction player-direction (vector2 0 0)) (shooting? player-shooting? #f) - (hitbox player-hitbox (make-rect -1 1 2 2)) - (lives player-lives 3) - (score player-score 0)) + (hitbox player-hitbox (make-rect -1 1 2 4)) + (last-death-time player-last-death-time #f)) (define-record-type* <enemy> %make-enemy make-enemy enemy? (position enemy-position origin2) - (type enemy-type 'generic) + (aim enemy-aim 0) ; angle for firing bullets + ;; TODO: We could leave out the '-light' part and use the polarity + ;; field to figure things out, but it's more work so forget it. + (type enemy-type 'popcorn-light) + (polarity enemy-polarity 'light) (hitbox enemy-hitbox (make-rect -3 -3 6 6)) + (last-hit-time enemy-last-hit-time #f) (health enemy-health 0)) +(define-record-type* <stats> + %make-stats make-stats + stats? + (score stats-score 0) + (lives stats-lives 3) + (chain stats-chain 0) + (chain-type stats-chain-type #f) + (chain-progress stats-chain-progress 0)) + +(define-record-type* <explosion> + %make-explosion make-explosion + explosion? + (type explosion-type 'regular) + (position explosion-position origin2) + (time explosion-time 0)) + (define-record-type* <world> %make-world make-world world? + (level world-level #f) + (stats world-stats (make-stats)) (player world-player (make-actor (make-player) idle)) (player-bullets world-player-bullets '()) (enemies world-enemies '()) - (enemy-bullets world-enemy-bullets '())) + (enemy-bullets world-enemy-bullets '()) + (explosions world-explosions '())) -(define (player-dead? player) - (zero? (player-lives player))) + +;;; +;;; Enemies +;;; (define (enemy-dead? enemy) (zero? (enemy-health enemy))) @@ -85,6 +119,45 @@ (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)) @@ -128,6 +201,9 @@ (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)) @@ -179,6 +255,163 @@ (simple-enemy-bullet position (- direction (/ pi 16)) speed)))) (add-enemy-bullets world bullets))) +(define (explosion-active? explosion current-time) + (> (- current-time (explosion-time explosion)) 120)) + + +;;; +;;; 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 stats enemy) + ;; 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))))) + + +;;; +;;; Collision detection +;;; + +(define (player-world-hitbox player) + (rect-move (player-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-collision? player bullet) + (rect-intersects? (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))))) + (values new-enemy + ;; Remove bullet. + (append (reverse prev-bullets) rest) + (if (enemy-alive? (actor-ref new-enemy)) + stats + ;; Enemy killed, add to player score. + (add-to-score stats (actor-ref new-enemy))) + (if (enemy-alive? (actor-ref new-enemy)) + explosions + ;; Add new explosion. + (cons (make-explosion #:type 'regular + #:position (enemy-position + (actor-ref 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) + (if (player/bullet-collision? (actor-ref player) (actor-ref bullet)) + (let* ((invincible? (player-invincible? (actor-ref player) time)) + (matched-polarity? (eq? (player-polarity (actor-ref player)) + (bullet-polarity (actor-ref bullet)))) + (hit? (not (or invincible? matched-polarity?))) + (new-player (if hit? + (call-with-actor player + (lambda (player) + (kill-player player time))) + player)) + (position (player-position (actor-ref player))) + (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 (keep-bullet? bullet) (and (bullet-live? bullet) (bullet-in-bounds? bullet))) @@ -204,7 +437,7 @@ (define (update-player effects world) (update-actor world effects (world-player world))) -(define (update-world world) +(define (update-world world time) ;; TODO: collision detection (let*-values (((effects new-player) (update-player '() world)) @@ -212,18 +445,37 @@ ((effects new-player-bullets) (update-bullets effects world (world-player-bullets world))) ((effects new-enemy-bullets) - (update-bullets effects world (world-enemy-bullets world)))) + (update-bullets effects world (world-enemy-bullets world))) + ((stats) (world-stats world)) + ((new-enemies new-player-bullets new-stats explosions1) + (collide-enemies-and-bullets new-enemies new-player-bullets + stats time)) + ((new-player new-enemy-bullets new-stats explosions3) + (collide-player-and-bullets new-player new-enemy-bullets + new-stats time)) + ((new-player new-stats explosions2) + (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)))) + #:enemy-bullets new-enemy-bullets + #:stats new-stats + #:explosions new-explosions)))) (define (world-eval exp world) (match exp (('null) world) (('tick time) - (update-world world)) + (update-world world time)) (('player-direction direction) (make-world #:inherit world #:player (call-with-actor (world-player world) @@ -233,7 +485,14 @@ (make-world #:inherit world #:player (call-with-actor (world-player world) (lambda (player) - (set-player-shooting player shooting?))))))) + (set-player-shooting player shooting?))))) + (('player-toggle-polarity) + (make-world #:inherit world + #:player (call-with-actor (world-player world) + toggle-polarity))))) + +(define (game-over? world) + (zero? (stats-lives (world-stats world)))) (define player-shoot* (action-effect-lift player-shoot)) (define move-enemy* (action-lift move-enemy)) @@ -281,7 +540,12 @@ (signal-let ((direction key-arrows)) `(player-direction ,direction)) (signal-let ((shoot? (signal-drop-repeats (key-down? 'z)))) - `(player-shoot ,shoot?))))) + `(player-shoot ,shoot?)) + (signal-let ((toggle? + (signal-filter identity #f + (signal-drop-repeats + (key-down? 'x))))) + `(player-toggle-polarity))))) (define (key-toggle key) "Create a signal that is initially #f and toggles between #t and #f @@ -333,37 +597,46 @@ each time KEY is pressed." (if font (move (vector2 (vx resolution) 0) (render-sprite - (make-label font (format #f "~d fps" fps) + (make-label font + (format #f "~d fps" fps) #:blended? #f #:anchor 'bottom-right))) render-nothing))) (define-signal score-text - (signal-let ((font font)) + (signal-let ((font font) + (world world)) (if font (move resolution (render-sprite - (make-label font "123456789" + (make-label font + (number->string (stats-score (world-stats world))) #:blended? #f #:anchor 'top-right))) render-nothing))) (define-signal lives-text - (signal-let ((font font)) + (signal-let ((font font) + (world world)) (if font - (move origin2 + (move (vector2 (/ (vx resolution) 2) (vy resolution)) (render-sprite - (make-label font "3 ship" + (make-label font + (format #f "~d ship" + (stats-lives (world-stats world))) #:blended? #f - #:anchor 'bottom-left))) + #:anchor 'top-center))) render-nothing))) (define-signal chain-text - (signal-let ((font font)) + (signal-let ((font font) + (world world)) (if font - (move (vector2 0 (vy resolution)) + (move (vector2 1 (vy resolution)) (render-sprite - (make-label font "0 chain" + (make-label font + (format #f "~d chain" + (stats-chain (world-stats world))) #:blended? #f #:anchor 'top-left))) render-nothing))) @@ -389,8 +662,20 @@ each time KEY is pressed." (load-tileset/live "assets/images/enemies.png" 16 16)) (define-signal player-sprite - (signal-map-maybe (lambda (tileset) - (make-sprite (tileset-ref tileset 12))) + (signal-map-maybe (lambda (world tileset) + (make-sprite + (let* ((player (actor-ref (world-player world))) + (dx (vx (player-direction player))) + (offset (cond + ((zero? dx) 0) + ((positive? dx) 1) + ((negative? dx) 2)))) + (tileset-ref tileset + (+ (match (player-polarity player) + ('light 12) + ('dark 8)) + offset))))) + world player-tileset)) (define (make-scrolling-background background time speed) @@ -434,22 +719,41 @@ each time KEY is pressed." (tex (tileset-ref tileset (match (bullet-type bullet) ('generic 12) - ('enemy-basic 13))))) + ('enemy-basic 9) + ('player-light 12) + ('player-dark 13) + ('large-light 9) + ('dark-light 8) + ('small-light 11) + ('small-dark 10))))) (sprite-batch-add! batch context tex rect))) bullets)))) -(define (render-enemies enemies tileset batch) +(define (render-enemies enemies tileset batch time) (lambda (context) (with-sprite-batch batch context (for-each (lambda (actor) (let* ((enemy (actor-ref actor)) + (hit-time (enemy-last-hit-time enemy)) + (hit? (and hit-time (zero? (- time hit-time)))) (rect (rect-move enemy-rect (enemy-position enemy))) (tex (tileset-ref tileset - (match (enemy-type enemy) - ('generic 12))))) + (+ (match (enemy-type enemy) + ('popcorn-dark 0) + ('popcorn-light 4) + ('pincer-dark 8) + ('pincer-light 12)) + (if hit? 2 0))))) (sprite-batch-add! batch context tex rect))) enemies)))) +(define (render-player player sprite time) + (if (and (player-invincible? player time) + (odd? (round (/ time 3)))) + render-nothing + (move (player-position player) + (render-sprite sprite)))) + (define-signal scene (signal-let ((fps-text fps-text) (score-text score-text) @@ -463,7 +767,8 @@ each time KEY is pressed." (bullet-tileset bullet-tileset) (enemy-tileset enemy-tileset) (batch batch) - (world world)) + (world world) + (time timer)) (if (and framebuffer framebuffer-sprite batch bullet-tileset enemy-tileset player-sprite) (let ((player (actor-ref (world-player world)))) @@ -475,14 +780,14 @@ each time KEY is pressed." (render-bullets (world-player-bullets world) bullet-tileset batch) - (move (player-position player) - (render-sprite player-sprite)) + (render-player player player-sprite time) (render-bullets (world-enemy-bullets world) bullet-tileset batch) (render-enemies (world-enemies world) enemy-tileset - batch) + batch + time) (with-color font-color (render-begin (if display-fps? |