diff options
Diffstat (limited to 'game.scm')
| -rw-r--r-- | game.scm | 116 |
1 files changed, 84 insertions, 32 deletions
@@ -71,6 +71,10 @@ "element" "removeEventListener" (ref extern) (ref string) (ref eq) -> none) + (define-foreign clone-element + "element" "clone" + (ref extern) -> (ref extern)) + (define-foreign keyboard-event-code "event" "keyboardCode" (ref extern) -> (ref string)) @@ -107,6 +111,22 @@ "canvas" "setImageSmoothingEnabled" (ref extern) i32 -> none) + (define-foreign load-audio + "audio" "new" + (ref string) -> (ref extern)) + + (define-foreign audio-play + "audio" "play" + (ref extern) -> none) + + (define-foreign audio-volume + "audio" "volume" + (ref extern) -> f64) + + (define-foreign set-audio-volume! + "audio" "setVolume" + (ref extern) f64 -> none) + ;; Hoot's exact and inexact aren't working right. These next two ;; procedures are alternatives for now. (define (trunc x) @@ -213,16 +233,36 @@ (within? ax* ay* bx by bw bh) (within? ax ay* bx by bw bh)))) + ;; So we can play many overlapping audio samples at once. + (define (load-sound-effect src) + (let* ((k 32) + (audio (load-audio src)) + (vec (make-vector k))) + (do ((i 0 (+ i 1))) + ((= i k)) + (vector-set! vec i (clone-element audio))) + (vector 0 vec))) + (define* (sound-effect-play sound #:optional (volume 1.0)) + (match sound + (#(i vec) + (let ((audio (vector-ref vec i))) + (set-audio-volume! audio volume) + (audio-play audio) + (vector-set! sound 0 (modulo (+ i 1) (vector-length vec))))))) + (define demichrome0 "#211e20") (define demichrome1 "#555568") (define demichrome2 "#a0a08b") (define demichrome3 "#e9efec") + ;; Screen size stuff (define game-width 240.0) (define game-height 320.0) (define canvas-scale 2.0) (define canvas-width (* game-width canvas-scale)) (define canvas-height (* game-height canvas-scale)) + + ;; Elements (define canvas (get-element-by-id "canvas")) (define context (get-context canvas "2d")) (define image:player (get-element-by-id "image-player")) @@ -230,6 +270,11 @@ (define image:enemy-bullets (get-element-by-id "image-enemy-bullets")) (define image:map (get-element-by-id "image-map")) (define image:enemies (get-element-by-id "image-enemies")) + (define sound:explosion (load-sound-effect "audio/explosion.wav")) + (define sound:player-shoot (load-sound-effect "audio/player-shoot.wav")) + (define sound:player-death (load-sound-effect "audio/player-death.wav")) + (define sound:enemy-shoot (load-sound-effect "audio/enemy-shoot.wav")) + (define sound:bullet-hit (load-sound-effect "audio/bullet-hit.wav")) ;; Scripting (define (make-scheduler max-tasks) @@ -507,6 +552,7 @@ (cond ((or (<= hp 0) (out-of-bounds? x* y* w h)) + (sound-effect-play sound:explosion) (enemy-pool-remove! pool i) (loop i (- k 1))) (else @@ -529,7 +575,7 @@ (h 64.0)) (draw-image context image:enemies (* t w) (* t h) w h (- x (/ w 2.0)) (- y (/ h 2.0)) w h) - (set-fill-color! context "#ff00ff") + (set-fill-color! context "#ff00ff80") (fill-rect context (- x (/ hbw 2.0)) (- y (/ hbh 2.0)) @@ -609,19 +655,21 @@ (define (firing?) (vector-ref key-state 4)) (define (player-die!) - (set! *player-lives* (max (- *player-lives* 1) 0)) - (run-script - (lambda () - (set! *player-invincible?* #t) - (let ((t 5)) - (let loop ((i 0)) - (when (< i 10) - (set! *player-visible?* #f) - (wait t) - (set! *player-visible?* #t) - (wait t) - (loop (+ i 1))))) - (set! *player-invincible?* #f)))) + (unless *player-invincible?* + ;; (sound-effect-play sound:player-death) + (set! *player-lives* (max (- *player-lives* 1) 0)) + (run-script + (lambda () + (set! *player-invincible?* #t) + (let ((t 5)) + (let loop ((i 0)) + (when (< i 10) + (set! *player-visible?* #f) + (wait t) + (set! *player-visible?* #t) + (wait t) + (loop (+ i 1))))) + (set! *player-invincible?* #f))))) (define (game-over?) (= *player-lives* 0)) (define (player-update!) @@ -633,14 +681,27 @@ (set-vec2-y! player-hitbox-position (- (vec2-y player-position) (/ player-hitbox-height 2.0))) - (when (and (not *player-invincible?*) - (let ((x (vec2-x player-hitbox-position)) + (when (and (let ((x (vec2-x player-hitbox-position)) (y (vec2-y player-hitbox-position)) (w player-hitbox-width) (h player-hitbox-height)) (or (rect-collides-with-level? level x y w h) (find-enemy enemies x y w h)))) - (player-die!))) + (player-die!)) + (when (firing?) + (set! *player-fire-counter* + (modulo (+ *player-fire-counter* 1) player-fire-interval)) + (when (= *player-fire-counter* 0) + (sound-effect-play sound:player-shoot) + (bullet-pool-add! player-bullets 0 + (- (vec2-x player-position) 6.0) + (vec2-y player-position) + 0.0 (- player-bullet-speed)) + (bullet-pool-add! player-bullets 0 + (+ (vec2-x player-position) 8.0) + (vec2-y player-position) + 0.0 (- player-bullet-speed)) + (set! *player-fire-counter* 0)))) (define (draw-player) (draw-image context image:player (if *player-visible?* 0.0 player-width) 0.0 @@ -650,7 +711,7 @@ (- (vec2-y player-position) (/ player-height 2.0)) player-width player-height) - (set-fill-color! context "#ff00ff") + (set-fill-color! context "#ff00ff80") (fill-rect context (vec2-x player-hitbox-position) (vec2-y player-hitbox-position) @@ -728,7 +789,11 @@ (let ((x* (- x (/ w 2.0))) (y* (- y(/ h 2.0)))) (or (out-of-bounds? x* y* w h) - (rect-collides-with-level? level x* y* w h) + (if (rect-collides-with-level? level x* y* w h) + (begin + (sound-effect-play sound:bullet-hit 0.1) + #t) + #f) (if (rect-within? x y w h (vec2-x player-hitbox-position) (vec2-y player-hitbox-position) @@ -750,19 +815,6 @@ (bullet-pool-update! player-bullets player-bullet-collide) (bullet-pool-update! enemy-bullets enemy-bullet-collide) (enemy-pool-update! enemies enemy-collide) - (when (firing?) - (set! *player-fire-counter* - (modulo (+ *player-fire-counter* 1) player-fire-interval)) - (when (= *player-fire-counter* 0) - (bullet-pool-add! player-bullets 0 - (- (vec2-x player-position) 6.0) - (vec2-y player-position) - 0.0 (- player-bullet-speed)) - (bullet-pool-add! player-bullets 0 - (+ (vec2-x player-position) 8.0) - (vec2-y player-position) - 0.0 (- player-bullet-speed)) - (set! *player-fire-counter* 0))) (timeout update dt)) ;; Temp hacky scripts |