diff options
Diffstat (limited to 'lisparuga')
| -rw-r--r-- | lisparuga/enemy.scm | 10 | ||||
| -rw-r--r-- | lisparuga/game.scm | 281 | ||||
| -rw-r--r-- | lisparuga/node-2d.scm | 26 | ||||
| -rw-r--r-- | lisparuga/player.scm | 51 |
4 files changed, 304 insertions, 64 deletions
diff --git a/lisparuga/enemy.scm b/lisparuga/enemy.scm index 0589d16..aa5335e 100644 --- a/lisparuga/enemy.scm +++ b/lisparuga/enemy.scm @@ -21,6 +21,7 @@ ;;; Code: (define-module (lisparuga enemy) + #:use-module (chickadee audio) #:use-module (chickadee math) #:use-module (chickadee math rect) #:use-module (chickadee math vector) @@ -46,6 +47,9 @@ ;;; ;;; Base Enemy ;;; + +(define-asset explosion-sound (load-audio (scope-asset "sounds/explosion.wav"))) + (define-class <enemy> (<actor>) (health #:accessor health #:init-keyword #:health) (points #:getter points #:init-keyword #:points) @@ -56,7 +60,11 @@ #t) (define-method (damage (enemy <enemy>) x) - (set! (health enemy) (max (- (health enemy) x) 0))) + (let ((new-health (max (- (health enemy) x) 0))) + (set! (health enemy) new-health) + (when (zero? new-health) + (audio-play (asset-ref explosion-sound) + #:volume 0.5)))) (define-method (dead? (enemy <enemy>)) (zero? (health enemy))) diff --git a/lisparuga/game.scm b/lisparuga/game.scm index 5b14edd..9e79898 100644 --- a/lisparuga/game.scm +++ b/lisparuga/game.scm @@ -22,9 +22,11 @@ ;;; Code: (define-module (lisparuga game) + #:use-module (chickadee) #:use-module (chickadee math rect) #:use-module (chickadee math vector) #:use-module (chickadee render color) + #:use-module (chickadee render particles) #:use-module (chickadee render texture) #:use-module (chickadee scripting) #:use-module (ice-9 format) @@ -42,17 +44,36 @@ start-player-shooting stop-player-shooting toggle-player-polarity - fire-player-homing-missiles)) + fire-player-homing-missiles + spawn-enemies + start-stage + game-over? + complete?)) (define-asset clouds (load-image (scope-asset "images/clouds.png"))) (define-asset player-bullet-atlas (load-tile-atlas (scope-asset "images/player-bullets.png") 16 16)) (define-asset enemy-bullet-atlas (load-tile-atlas (scope-asset "images/enemy-bullets.png") 24 24)) +(define-asset explosion-texture + (load-image (scope-asset "images/explosion.png"))) ;; nodes needed: ;; scrolling background -(define-class <game> (<node-2d>)) +(define-class <game> (<canvas>) + (player-control? #:accessor player-control? #:init-value #f) + (complete? #:accessor complete? #:init-value #f)) + +(define-method (initialize (game <game>) initargs) + (next-method) + (set! (views game) + ;; Game happens on a 160x240 pixel screen. + (list (make <view-2d> + #:camera (make <camera-2d> + #:width 160 + #:height 240) + #:area (make-rect 80 0 160 240) + #:clear-color (make-color 0.0 0.0 0.0 1.0))))) (define-method (on-boot (game <game>)) (let* ((player-bullets (make <bullet-field> @@ -60,58 +81,79 @@ #:rank 2 #:capacity 500 #:texture-atlas player-bullet-atlas)) - (player (make-player player-bullets)) (enemy-bullets (make <bullet-field> #:name 'enemy-bullets - #:rank 4 + #:rank 5 #:capacity 1000 #:texture-atlas enemy-bullet-atlas)) + (explosions (make <particles> + #:name 'explosions + #:rank 3 + #:particles + (make-particles 1000 + #:texture (asset-ref explosion-texture) + #:end-color (make-color 1.0 1.0 1.0 0.0) + #:speed-range (vec2 0.5 5.0) + #:lifetime 12))) (ui (make <node-2d> #:name 'ui #:rank 999))) - (set! (rank player) 1) (attach-to game (make <sprite> #:name 'clouds #:rank 0 #:texture clouds) - player player-bullets (make <node-2d> #:name 'enemies - #:rank 3) + #:rank 4) + explosions enemy-bullets ui) ;; Setup UI elements + ;; TODO: Move this out of here. (attach-to ui (make <label> #:name 'score - #:position (vec2 2.0 226.0)) + #:position (vec2 2.0 242.0) + #:vertical-align 'top) (make <label> #:name 'chain - #:position (vec2 2.0 210.0)) + #:position (vec2 158.0 242.0) + #:align 'right + #:vertical-align 'top) (make <label> #:name 'energy - #:position (vec2 2.0 18.0)) + #:position (vec2 158.0 2.0) + #:align 'right) (make <label> #:name 'lives #:position (vec2 2.0 2.0))) + (start-stage game))) + +(define-method (start-stage (game <game>)) + (let ((player (make-player (& game player-bullets)))) + (set! (rank player) 1) + (attach-to game player) (update-ui game) - ;; Test enemy - (spawn-enemy game (make-utatsugumi 'white 10.0 180.0)) - (spawn-enemy game (make-utatsugumi 'white 30.0 180.0)) - (spawn-enemy game (make-utatsugumi 'white 50.0 180.0)) - (spawn-enemy game (make-utatsugumi 'black 70.0 180.0)) - (spawn-enemy game (make-utatsugumi 'black 90.0 180.0)) - (spawn-enemy game (make-utatsugumi 'black 110.0 180.0)) - (spawn-enemy game (make-utatsugumi 'white 130.0 180.0)) - (spawn-enemy game (make-utatsugumi 'white 150.0 180.0)))) - -(define (update-ui game) + (play-stage-1 game))) + +(define-method (spawn-enemies (game <game>)) + ;; Test enemies + (spawn-enemy game (make-utatsugumi 'white 10.0 180.0)) + (spawn-enemy game (make-utatsugumi 'white 30.0 180.0)) + (spawn-enemy game (make-utatsugumi 'white 50.0 180.0)) + (spawn-enemy game (make-utatsugumi 'black 70.0 180.0)) + (spawn-enemy game (make-utatsugumi 'black 90.0 180.0)) + (spawn-enemy game (make-utatsugumi 'black 110.0 180.0)) + (spawn-enemy game (make-utatsugumi 'white 130.0 180.0)) + (spawn-enemy game (make-utatsugumi 'white 150.0 180.0))) + +(define-method (update-ui (game <game>)) (set! (text (& game ui score)) - (format #f "~9,'0d" (score (& game player)))) + (format #f "~7,'0d" (score (& game player)))) (set! (text (& game ui chain)) - (format #f "CHAIN ~a: ~a" + (format #f "~a CHAIN (~a)" (let ((n (chain (& game player)))) (if (< n 9) (number->string n) "MAX")) (list->string @@ -121,48 +163,189 @@ #\B)) (chain-progress (& game player)))))) (set! (text (& game ui energy)) - (format #f "E~d" (quotient (energy (& game player)) 10))) + (format #f "ENERGY ~d" (quotient (energy (& game player)) 10))) (set! (text (& game ui lives)) - (format #f "x~d" (max (- (lives (& game player)) 1) 0)))) + (format #f "SHIP x~d" (max (- (lives (& game player)) 1) 0)))) + +(define-method (explode (game <game>) (actor <actor>)) + (let* ((p (position actor)) + (emitter (make-particle-emitter (make-rect (- (vec2-x p) 8.0) + (- (vec2-y p) 8.0) + 16.0 16.0) + 8 5))) + (add-particle-emitter (particles (& game explosions)) emitter))) (define-method (update (game <game>) dt) (let ((refresh-ui? #f) (player (& game player))) - ;; enemy -> player bullet collision - ;; enemy -> player collision - (for-each (lambda (enemy) - (cond - ((and (collide (& game player-bullets) enemy) - (dead? enemy)) - (on-kill player enemy) - (fire-parting-shots-maybe enemy player) - (detach enemy) - (set! refresh-ui? #t)) - ((collide player enemy) - (set! refresh-ui? #t)))) - (children (& game enemies))) - ;; player -> enemy bullet collision - (when (collide (& game enemy-bullets) (& game player)) - (set! refresh-ui? #t)) - (when refresh-ui? - (update-ui game)))) + (when player + ;; enemy -> player bullet collision + ;; enemy -> player collision + (for-each (lambda (enemy) + (cond + ((and (collide (& game player-bullets) enemy) + (dead? enemy)) + (on-kill player enemy) + (fire-parting-shots-maybe enemy player) + (explode game enemy) + (detach enemy) + (set! refresh-ui? #t)) + ((collide player enemy) + (set! refresh-ui? #t)))) + (children (& game enemies))) + ;; player -> enemy bullet collision + (when (collide (& game enemy-bullets) (& game player)) + (set! refresh-ui? #t)) + (when refresh-ui? + (update-ui game))) + (next-method))) (define-method (spawn-enemy (game <game>) enemy) (set! (bullet-field enemy) (& game enemy-bullets)) (attach-to (& game enemies) enemy)) (define-method (steer-player (game <game>) up? down? left? right?) - (steer (& game player) up? down? left? right?)) + (when (player-control? game) + (steer (& game player) up? down? left? right?))) (define-method (start-player-shooting (game <game>)) - (start-shooting (& game player))) + (when (player-control? game) + (start-shooting (& game player)))) (define-method (stop-player-shooting (game <game>)) - (stop-shooting (& game player))) + (when (player-control? game) + (stop-shooting (& game player)))) (define-method (toggle-player-polarity (game <game>)) - (toggle-polarity (& game player))) + (when (player-control? game) + (toggle-polarity (& game player)))) (define-method (fire-player-homing-missiles (game <game>)) - (fire-homing-missiles (& game player) (children (& game enemies))) - (update-ui game)) + (when (player-control? game) + (fire-homing-missiles (& game player) (children (& game enemies))) + (update-ui game))) + +(define-method (game-over? (game <game>)) + (let ((player (& game player))) + (and player (dead? player)))) + +(define-method (play-stage-1 game) + (run-script game + (do-intro game) + (do-tutorial game) + (do-phase-1 game) + (do-win game))) + +(define-method (do-intro (game <game>)) + (hide (& game ui)) + (teleport (& game player) 80.0 -24.0) + (move-to (& game player) 80.0 32.0 50) + (steer (& game player) #f #f #f #f) + (set! (player-control? game) #t) + (show (& game ui))) + +(define *skip-tutorial?* #t) + +(define-method (do-tutorial (game <game>)) + (define* (instruct text continue? #:optional (post-delay 60)) + (let ((instructions (make <label> + #:text text + #:align 'center + #:vertical-align 'center + #:position (vec2 80.0 120.0)))) + (attach-to (& game ui) instructions) + (while (not (continue?)) + (sleep 10)) + (sleep post-delay) + (detach instructions) + (sleep 60))) + (unless *skip-tutorial?* + (sleep 30) + (instruct "use arrow keys to move" + (let ((v (velocity (& game player)))) + (lambda () + (not (and (= (vec2-x v) 0.0) + (= (vec2-y v) 0.0)))))) + (instruct "press Z to shoot" + (lambda () + (shooting? (& game player)))) + (instruct "press X to change color" + (let ((starting-polarity (polarity (& game player)))) + (lambda () + (not (eq? (polarity (& game player)) starting-polarity))))) + (instruct "avoid opposite energy" (const #t) 120) + (instruct "absorb same energy" (const #t) 120) + (add-energy (& game player) 120) + (update-ui game) + (instruct "press C to release energy" + (lambda () + (zero? (energy (& game player))))) + (instruct "get ready!" (const #t) 120))) + +(define-method (do-phase-1 (game <game>)) + (define (utatsugumi-sweep x polarity) + (let loop ((i 0)) + (when (< i 6) + (let ((utatsugumi (make-utatsugumi polarity x 260.0))) + (spawn-enemy game utatsugumi) + (set-vec2! (velocity utatsugumi) 0.0 -3.0) + (script + (sleep (* 10 60)) + (detach utatsugumi)) + (sleep 10)) + (loop (+ i 1))))) + (utatsugumi-sweep 140.0 'white) + (sleep 60) + (utatsugumi-sweep 20.0 'black) + (sleep 60) + (utatsugumi-sweep 140.0 'white) + (sleep 60) + (utatsugumi-sweep 20.0 'black) + (sleep (* 3 60))) + +(define-method (do-win (game <game>)) + (set! (player-control? game) #f) + (steer (& game player) #f #f #f #f) + (stop-shooting (& game player)) + (hide (& game ui)) + (let ((battle-report (make <node-2d> + #:name 'battle-report + #:rank 999))) + (define (add-row y name value) + (attach-to battle-report + (make <label> + #:rank 999 + #:text name + #:align 'left + #:position (vec2 16.0 y)) + (make <label> + #:rank 999 + #:text value + #:align 'left + #:position (vec2 96.0 y)))) + (let ((backdrop (make <filled-rect> + #:region (make-rect 0.0 0.0 160.0 240.0)))) + (attach-to battle-report backdrop) + (attach-to game battle-report) + (tween 45 (make-color 0.0 0.0 0.0 0.0) (make-color 0.0 0.0 0.0 0.8) + (lambda (c) + (set! (color backdrop) c)) + #:interpolate color-lerp)) + (attach-to battle-report + (make <label> + #:rank 999 + #:text "BATTLE REPORT" + #:align 'center + #:position (vec2 80.0 180.0))) + (sleep 30) + (add-row 140.0 "SCORE" (number->string (score (& game player)))) + (sleep 30) + (add-row 110.0 "MAX CHAIN" (number->string (max-chain (& game player)))) + (sleep 30) + (attach-to battle-report + (make <label> + #:rank 999 + #:text "press ENTER to play again" + #:position (vec2 80.0 60.0) + #:align 'center)) + (set! (complete? game) #t))) diff --git a/lisparuga/node-2d.scm b/lisparuga/node-2d.scm index 0baef54..b6753ef 100644 --- a/lisparuga/node-2d.scm +++ b/lisparuga/node-2d.scm @@ -605,7 +605,31 @@ (define-class <label> (<node-2d>) (font #:accessor font #:init-keyword #:font #:init-thunk default-font) - (text #:accessor text #:init-form "" #:init-keyword #:text)) + (text #:accessor text #:init-form "" #:init-keyword #:text) + (align #:accessor align #:init-value 'left #:init-keyword #:align) + (vertical-align #:accessor vertical-align #:init-value 'bottom + #:init-keyword #:vertical-align)) + +(define-method (initialize (label <label>) initargs) + (next-method) + (realign label)) + +(define-method ((setter text) (label <label>) s) + (slot-set! label 'text s) + (realign label)) + +(define-method (realign (label <label>)) + (let ((font (asset-ref (font label)))) + (set-vec2! (origin label) + (match (align label) + ('left 0.0) + ('right (font-line-width font (text label))) + ('center (/ (font-line-width font (text label)) 2.0))) + (match (vertical-align label) + ('bottom 0.0) + ('top (font-line-height font)) + ('center (/ (font-line-height font) 2.0))))) + (dirty! label)) (define-method (render (label <label>) alpha) (draw-text* (asset-ref (font label)) (text label) (world-matrix label))) diff --git a/lisparuga/player.scm b/lisparuga/player.scm index ca57891..1265756 100644 --- a/lisparuga/player.scm +++ b/lisparuga/player.scm @@ -21,6 +21,7 @@ ;;; Code: (define-module (lisparuga player) + #:use-module (chickadee audio) #:use-module (chickadee math) #:use-module (chickadee math rect) #:use-module (chickadee math vector) @@ -42,17 +43,23 @@ energy chain chain-progress + max-chain speed + invincible? + shooting? steer start-shooting stop-shooting toggle-polarity fire-homing-missiles kill-maybe - on-kill)) + on-kill + add-energy)) -(define-asset ship (load-image (scope-asset "images/player.png"))) (define-asset ship-atlas (load-tile-atlas (scope-asset "images/player.png") 24 24)) +(define-asset shoot-sound (load-audio (scope-asset "sounds/player-shoot.wav"))) +(define-asset missile-sound (load-audio (scope-asset "sounds/player-missile.wav"))) +(define-asset death-sound (load-audio (scope-asset "sounds/player-death.wav"))) (define kill-hitbox (make-hitbox 'kill (make-rect -2.0 -2.0 4.0 4.0))) (define graze-hitbox (make-hitbox 'graze (make-rect -12.0 -12.0 24.0 24.0))) @@ -63,16 +70,20 @@ (energy #:accessor energy #:init-value 0) (chain #:accessor chain #:init-value 0) (chain-progress #:accessor chain-progress #:init-form '()) + (max-chain #:accessor max-chain #:init-value 0) (speed #:accessor speed #:init-value 2.5) (invincible? #:accessor invincible? #:init-value #f) (shooting? #:accessor shooting? #:init-value #f) (shoot-time #:accessor shoot-time #:init-value 0)) +(define-method (dead? (player <player>)) + (zero? (lives player))) + (define (make-player bullet-field) (make <player> #:name 'player #:hitboxes (list graze-hitbox kill-hitbox) - #:position (vec2 80.0 24.0) + #:position (vec2 80.0 -24.0) #:bullet-field bullet-field #:polarity 'white)) @@ -121,11 +132,13 @@ (cond ;; single shot ((zero? t) + (audio-play (asset-ref shoot-sound)) (shoot player 0.0)) ;; double shot. give a buffer of 4 frames so players can ;; reliably fire just a single shot. ((> t 4) - (shoot player 5.0) + (audio-play (asset-ref shoot-sound)) + (shoot player 6.0) (shoot player -5.0)))) (set! (shoot-time player) (+ t 1)))) (next-method)) @@ -188,9 +201,10 @@ (if enemy (let* ((ep (position enemy))) (define (aim-at-enemy bp bv) - (let ((dir (atan (- (vec2-y ep) (vec2-y bp)) - (- (vec2-x ep) (vec2-x bp))))) - (set-vec2! bv (* (cos dir) speed) (* (sin dir) speed)))) + (unless (dead? enemy) + (let ((dir (atan (- (vec2-y ep) (vec2-y bp)) + (- (vec2-x ep) (vec2-x bp))))) + (set-vec2! bv (* (cos dir) speed) (* (sin dir) speed))))) (run-script player (let loop ((i 0)) (when (< i n) @@ -206,6 +220,9 @@ (vec2-x p) (vec2-y p) (* (cos theta) speed) (* (sin theta) speed)) (loop (+ i 1)))))))) + (when (> e 10) + (audio-play (asset-ref missile-sound) + #:volume 0.5)) ;; Distribute missiles amongst closest enemies (let loop ((enemies enemies) (missiles-remaining (quotient e 10)) @@ -229,15 +246,22 @@ (loop enemies 0 (+ missiles-used missiles-remaining))))))) #t)) -(define-method (increment-energy (player <player>)) - (set! (energy player) (min (+ (energy player) 1) 120))) +(define-method (add-energy (player <player>) n) + (set! (energy player) (min (+ (energy player) n) 120))) (define-method (kill-maybe (player <player>)) (unless (invincible? player) - (let ((new-lives (- (lives player) 1))) + (audio-play (asset-ref death-sound)) + (let ((new-lives (max (- (lives player) 1) 0))) (set! (lives player) new-lives) + (set! (energy player) 0) (if (zero? new-lives) - (hide player) + (begin + ;; to stop the death events from happening over and over + ;; after game over condition is reached. + (set! (invincible? player) #t) + (set-vec2! (velocity player) 0.0 0.0) + (hide player)) ;; Give player invincibility for a bit while they recover. (run-script player (set! (invincible? player) #t) @@ -258,7 +282,7 @@ ;; Absorb bullets of the same polarity. ((and (eq? hitbox graze-hitbox) (eq? bullet-polarity (polarity player))) - (increment-energy player) + (add-energy player 1) ;; From what I can tell by watching youtube replays at .25 speed, ;; each bullet absorbed is worth 100 points. (set! (score player) (+ (score player) 100)) @@ -270,13 +294,14 @@ #t) (else #f))) -(define (add-to-chain player polarity) +(define-method (add-to-chain (player <player>) polarity) (let ((current-chain (cons polarity (chain-progress player)))) (match current-chain ;; complete chain. ((or ('white 'white 'white) ('black 'black 'black)) (let ((new-chain (+ (chain player) 1))) + (set! (max-chain player) (max (max-chain player) new-chain)) (set! (chain player) new-chain) (set! (chain-progress player) '()) (set! (score player) |