summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--assets/images/explosion.pngbin0 -> 410 bytes
-rw-r--r--assets/images/explosion.xcfbin0 -> 1199 bytes
-rw-r--r--assets/images/player-bullets.pngbin620 -> 620 bytes
-rw-r--r--assets/sounds/explosion.wavbin0 -> 33510 bytes
-rw-r--r--assets/sounds/player-death.wavbin0 -> 66010 bytes
-rw-r--r--assets/sounds/player-missile.wavbin0 -> 65490 bytes
-rw-r--r--assets/sounds/player-shoot.wavbin0 -> 806 bytes
-rw-r--r--guix.scm4
-rw-r--r--lisparuga.scm88
-rw-r--r--lisparuga/enemy.scm10
-rw-r--r--lisparuga/game.scm281
-rw-r--r--lisparuga/node-2d.scm26
-rw-r--r--lisparuga/player.scm51
13 files changed, 355 insertions, 105 deletions
diff --git a/assets/images/explosion.png b/assets/images/explosion.png
new file mode 100644
index 0000000..2146226
--- /dev/null
+++ b/assets/images/explosion.png
Binary files differ
diff --git a/assets/images/explosion.xcf b/assets/images/explosion.xcf
new file mode 100644
index 0000000..3b3f077
--- /dev/null
+++ b/assets/images/explosion.xcf
Binary files differ
diff --git a/assets/images/player-bullets.png b/assets/images/player-bullets.png
index eb9c4cb..5aecd50 100644
--- a/assets/images/player-bullets.png
+++ b/assets/images/player-bullets.png
Binary files differ
diff --git a/assets/sounds/explosion.wav b/assets/sounds/explosion.wav
new file mode 100644
index 0000000..bcc4865
--- /dev/null
+++ b/assets/sounds/explosion.wav
Binary files differ
diff --git a/assets/sounds/player-death.wav b/assets/sounds/player-death.wav
new file mode 100644
index 0000000..c0d3bd6
--- /dev/null
+++ b/assets/sounds/player-death.wav
Binary files differ
diff --git a/assets/sounds/player-missile.wav b/assets/sounds/player-missile.wav
new file mode 100644
index 0000000..50ef045
--- /dev/null
+++ b/assets/sounds/player-missile.wav
Binary files differ
diff --git a/assets/sounds/player-shoot.wav b/assets/sounds/player-shoot.wav
new file mode 100644
index 0000000..ec3bb6b
--- /dev/null
+++ b/assets/sounds/player-shoot.wav
Binary files differ
diff --git a/guix.scm b/guix.scm
index 215e71e..ac35a49 100644
--- a/guix.scm
+++ b/guix.scm
@@ -125,7 +125,7 @@ SDL2 C shared library via the foreign function interface.")
(license lgpl3+))))
(define chickadee
- (let ((commit "f2721b20704a0e5a4960d490d0ba465feccdf192"))
+ (let ((commit "b15a8b5be99df32e86af8bfb6f5dbdaacceda776"))
(package
(name "chickadee")
(version (string-append "0.5.0-1." (string-take commit 7)))
@@ -136,7 +136,7 @@ SDL2 C shared library via the foreign function interface.")
(commit commit)))
(sha256
(base32
- "0cs838mr7r92kyihvvya2nbywd0g6rfb7qgcxaqivyh3qyss4zi8"))))
+ "17hba2mrvrdz91lgw92lf7qv4i6i2f5ypwrlr45fy4nljh52870c"))))
(build-system gnu-build-system)
(arguments
'(#:make-flags '("GUILE_AUTO_COMPILE=0")
diff --git a/lisparuga.scm b/lisparuga.scm
index b552a7a..dc611cd 100644
--- a/lisparuga.scm
+++ b/lisparuga.scm
@@ -44,10 +44,13 @@
(define-asset background (load-image (scope-asset "images/background.png")))
(define-class <lisparuga> (<scene-2d>)
- (state #:accessor state #:init-value 'play))
+ (state #:accessor state #:init-value 'init))
-(define (game-over? lisparuga)
- (zero? (lives (& lisparuga actor-canvas game player))))
+(define-method (game-over? (lisparuga <lisparuga>))
+ (game-over? (& lisparuga game)))
+
+(define-method (complete? (lisparuga <lisparuga>))
+ (complete? (& lisparuga game)))
(define-method (on-boot (lisparuga <lisparuga>))
;; Scale a small framebuffer up to the window size.
@@ -58,34 +61,27 @@
#:height %framebuffer-height)
#:area (let ((wc (window-config (current-kernel))))
(make-rect 0 0 (window-width wc) (window-height wc))))))
- ;; This 160x240 canvas is where the actual game actors will get
- ;; rendered.
- (let ((actor-canvas (make <canvas>
- #:name 'actor-canvas
- #:rank 1
- #:views (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))))))
- (attach-to lisparuga
- (make <sprite>
- #:name 'background
- #:rank 0
- #:texture background)
- actor-canvas)
- (new-game-transition lisparuga)))
+ (attach-to lisparuga
+ (make <sprite>
+ #:name 'background
+ #:rank 0
+ #:texture background))
+ (new-game-transition lisparuga))
(define (new-game-transition lisparuga)
(set! (state lisparuga) 'play)
(let ((game-over (& lisparuga game-over)))
(and game-over (detach game-over)))
- (let ((old-game (& lisparuga actor-canvas game)))
+ (let ((old-game (& lisparuga game)))
(and old-game (detach old-game)))
- (attach-to (& lisparuga actor-canvas) (make <game> #:name 'game)))
+ (attach-to lisparuga
+ (make <game>
+ #:name 'game
+ #:rank 1
+ #:position (vec2 80.0 0.0)))
+ (set! (state lisparuga) 'play))
-(define (game-over-transition lisparuga)
+(define-method (game-over-transition (lisparuga <lisparuga>))
(set! (state lisparuga) 'game-over)
(let ((game-over (make <node-2d>
#:name 'game-over
@@ -94,21 +90,33 @@
(make <label>
#:name 'game-over
#:text "GAME OVER"
- #:position (vec2 (- 160.0 (/ (* 9.0 8.0) 2.0))
- 116.0)
- #:rank 999))
+ #:position (vec2 160.0 120.0)
+ #:align 'center
+ #:vertical-align 'center)
+ (make <label>
+ #:name 'instructions
+ #:text "press ENTER to play again"
+ #:position (vec2 160.0 90.0)
+ #:align 'center))
(attach-to lisparuga game-over)))
+(define-method (win-transition (lisparuga <lisparuga>))
+ (set! (state lisparuga) 'win))
+
(define-method (update (lisparuga <lisparuga>) dt)
(match (state lisparuga)
('play
- (if (game-over? lisparuga)
- (game-over-transition lisparuga)
- (steer-player (& lisparuga actor-canvas game)
- (key-pressed? 'up)
- (key-pressed? 'down)
- (key-pressed? 'left)
- (key-pressed? 'right))))
+ (cond
+ ((game-over? lisparuga)
+ (game-over-transition lisparuga))
+ ((complete? lisparuga)
+ (win-transition lisparuga))
+ (else
+ (steer-player (& lisparuga game)
+ (key-pressed? 'up)
+ (key-pressed? 'down)
+ (key-pressed? 'left)
+ (key-pressed? 'right)))))
(_ #f)))
(define-method (on-key-press (lisparuga <lisparuga>) key scancode modifiers repeat?)
@@ -116,11 +124,13 @@
('play
(unless repeat?
(match key
- ('z (start-player-shooting (& lisparuga actor-canvas game)))
- ('x (toggle-player-polarity (& lisparuga actor-canvas game)))
- ('c (fire-player-homing-missiles (& lisparuga actor-canvas game)))
+ ('z (start-player-shooting (& lisparuga game)))
+ ('x (toggle-player-polarity (& lisparuga game)))
+ ('c (fire-player-homing-missiles (& lisparuga game)))
+ ('r (spawn-enemies (& lisparuga game)))
+ ('e (set! (energy (& lisparuga game player)) 120))
(_ #t))))
- ('game-over
+ ((or 'win 'game-over)
(match key
('return (new-game-transition lisparuga))
(_ #f)))
@@ -130,7 +140,7 @@
(match (state lisparuga)
('play
(match key
- ('z (stop-player-shooting (& lisparuga actor-canvas game)))
+ ('z (stop-player-shooting (& lisparuga game)))
(_ #t)))
(_ #f)))
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)