diff options
Diffstat (limited to 'game.scm')
| -rw-r--r-- | game.scm | 303 |
1 files changed, 234 insertions, 69 deletions
@@ -227,6 +227,10 @@ (#f #f) ((_ . val) val))) + (define %jps (inexact (jiffies-per-second))) + (define (current-time) + (/ (inexact (current-jiffy)) %jps)) + (define-type vec2 make-vec2 vec2? @@ -310,8 +314,8 @@ (audio-play audio) (vector-set! sound 0 (modulo (+ i 1) (vector-length vec))))))) - ;; intro, play, paused, game-over, game-win - (define *game-state* 'play) + ;; splash, play, pause, game-over, game-clear + (define *game-state* 'splash) ;; Screen size stuff (define game-width 240.0) @@ -320,6 +324,7 @@ ;; Elements (define canvas (get-element-by-id "canvas")) (define context (get-context canvas "2d")) + (define image:cover (load-image "images/cover.png")) (define image:starfield-bg (load-image "images/starfield-bg.png")) (define image:starfield-fg (load-image "images/starfield-fg.png")) (define image:player (load-image "images/player.png")) @@ -379,16 +384,18 @@ ((= i num-tasks)) (vector-set! tasks i #f))))) (define *scheduler* (make-scheduler 100)) + (define current-scheduler (make-parameter *scheduler*)) (define current-script (make-parameter #f)) (define %script-tag (make-prompt-tag "script")) (define-type script %make-script script? + (scheduler script-scheduler set-script-scheduler!) (state script-state set-script-state!) (cont script-cont set-script-cont!) (children script-children set-script-children!)) (define (make-script thunk) - (%make-script 'pending thunk '())) + (%make-script (current-scheduler) 'pending thunk '())) (define (script-pending? script) (eq? (script-state script) 'pending)) (define (script-running? script) @@ -399,16 +406,18 @@ (set-script-state! script 'cancelled) (for-each script-cancel! (script-children script))) (define (script-run! script) + (define scheduler (script-scheduler script)) (define (run thunk) (unless (script-cancelled? script) (call-with-prompt %script-tag (lambda () - (parameterize ((current-script script)) + (parameterize ((current-script script) + (current-scheduler scheduler)) (thunk))) handler))) (define (handler k delay) (when delay - (scheduler-add! *scheduler* (lambda () (run k)) delay))) + (scheduler-add! scheduler (lambda () (run k)) delay))) (when (script-pending? script) (let ((parent (current-script))) (when parent @@ -772,7 +781,7 @@ (define (make-enemy type health position size velocity script points animation image image-size) (%make-enemy type health position size velocity script - points (inexact (current-jiffy)) animation image + points (current-time) animation image image-size)) (define (enemy-x enemy) (vec2-x (enemy-position enemy))) @@ -825,14 +834,14 @@ (set-vec2-y! position (+ (vec2-y position) (+ (vec2-y velocity) scroll-dy))))))) (define (draw-enemy enemy time) - (let ((frame-duration 250.0)) + (let ((frame-duration 0.25)) (match enemy (#('enemy type _ position size _ _ _ spawn-time animation image image-size) (let* ((tx (vector-ref animation (modulo (truncate - (fmod (- time spawn-time) - frame-duration)) + (/ (- time spawn-time) + frame-duration)) (vector-length animation)))) (x (vec2-x position)) (y (vec2-y position)) @@ -901,7 +910,7 @@ (run-script (lambda () (wait 60) - (set! *game-state* 'game-win)))) + (do-game-clear)))) (enemy-pool-remove! pool i) (loop i (- k 1))) (else @@ -927,33 +936,33 @@ (define (spawn-enemy enemy) (enemy-pool-add! enemies enemy)) - (define (spawn-turret* x y script) - (spawn-enemy - (make-enemy 'turret 10 (vec2 x y) (vec2 12.0 12.0) - (vec2 0.0 0.0) script 100 - #(0.0 16.0 32.0 48.0) image:turret (vec2 16.0 16.0)))) - (define (spawn-popcorn* x y script) (spawn-enemy (make-enemy 'popcorn 1 (vec2 x y) (vec2 12.0 12.0) (vec2 0.0 0.0) script 100 - #(0.0 0.0 0.0 0.0) image:popcorn (vec2 32.0 32.0)))) + #(0.0 16.0 32.0 48.0) image:popcorn (vec2 16.0 16.0)))) + + (define (spawn-turret* x y script) + (spawn-enemy + (make-enemy 'turret 10 (vec2 x y) (vec2 12.0 12.0) + (vec2 0.0 0.0) script 200 + #(0.0 16.0 32.0 48.0) image:turret (vec2 16.0 16.0)))) (define (spawn-flyer0* x y script) (spawn-enemy (make-enemy 'flyer0 20 (vec2 x y) (vec2 12.0 12.0) - (vec2 0.0 0.0) script 100 - #(0.0 0.0 0.0 0.0) image:flyer0 (vec2 32.0 32.0)))) + (vec2 0.0 0.0) script 500 + #(0.0 16.0 32.0 48.0) image:flyer0 (vec2 16.0 16.0)))) (define (spawn-flyer1* x y script) (spawn-enemy (make-enemy 'flyer1 10 (vec2 x y) (vec2 16.0 16.0) - (vec2 0.0 0.0) script 100 - #(0.0 0.0 0.0 0.0) image:flyer1 (vec2 32.0 32.0)))) + (vec2 0.0 0.0) script 1000 + #(0.0 24.0 48.0 72.0) image:flyer1 (vec2 24.0 24.0)))) (define (spawn-turret x y) (define (script enemy) - (let ((speed 2.0)) + (let ((speed 3.0)) (define (current-dir) (direction-to-player (enemy-position enemy))) (define (shoot dir) @@ -967,9 +976,9 @@ (wait 60) (let ((dir (current-dir))) (shoot dir) - (wait 10) + (wait 5) (shoot dir) - (wait 10) + (wait 5) (shoot dir))))) (spawn-turret* x y script)) @@ -1028,6 +1037,7 @@ (define *player-visible?* #t) (define *player-invincible?* #f) (define *player-score* 0) + (define *player-1cc?* #t) ;; left, right, down, up, fire, focus (define key-state (vector #f #f #f #f #f #f)) (define (update-player-velocity!) @@ -1080,23 +1090,25 @@ (define (player-position-reset!) (set-vec2-x! player-position (/ game-width 2.0)) (set-vec2-y! player-position (- game-height 12.0))) + (define (do-player-invincible) + (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 (player-die!) (unless *player-invincible?* (sound-effect-play sound:player-death 0.5) (set! *player-lives* (max (- *player-lives* 1) 0)) (player-position-reset!) - (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))))) + (do-player-invincible))) (define (game-over?) (= *player-lives* 0)) (define (player-update!) @@ -1183,6 +1195,62 @@ (vec2-normalize! v*) v*)) + ;; Game over screen state + (define *countdown* "") + (define *countdown-scheduler* (make-scheduler 5)) + (define (do-countdown) + (parameterize ((current-scheduler *countdown-scheduler*)) + (run-script + (lambda () + (let loop ((i 9)) + (set! *countdown* (number->string i)) + (wait 60) + (unless (= i 0) + (loop (- i 1)))) + (set! *game-state* 'splash))))) + (define (do-game-over) + (scheduler-reset! *countdown-scheduler*) + (set! *game-state* 'game-over) + (do-countdown)) + (define (do-continue) + (player-position-reset!) + (set! *player-lives* 3) + (set! *player-1cc?* #f) + (set! *game-state* 'play) + (do-player-invincible)) + + ;; Clear screen state + (define *clear-show-1cc-bonus?* #f) + (define *clear-show-life-bonus?* #f) + (define *clear-show-total-score?* #f) + (define *clear-1cc-bonus* "") + (define *clear-life-bonus* "") + (define *clear-total-score* "") + (define (do-game-clear) + (scheduler-reset! *scheduler*) + (set! *game-state* 'game-clear) + (set! *clear-show-1cc-bonus?* #f) + (set! *clear-show-life-bonus?* #f) + (set! *clear-show-total-score?* #f) + (if *player-1cc?* + (let ((1cc-bonus 1000000) + (life-bonus (* *player-lives* 250000))) + (set! *player-score* (+ *player-score* 1cc-bonus life-bonus)) + (set! *clear-1cc-bonus* (number->string 1cc-bonus)) + (set! *clear-life-bonus* (number->string life-bonus))) + (begin + (set! *clear-1cc-bonus* "0") + (set! *clear-life-bonus* "0"))) + (set! *clear-total-score* (number->string *player-score*)) + (run-script + (lambda () + (wait 60) + (set! *clear-show-1cc-bonus?* #t) + (wait 60) + (set! *clear-show-life-bonus?* #t) + (wait 60) + (set! *clear-show-total-score?* #t)))) + ;; Canvas sizing/scaling. (define *canvas-scale* 0.0) (define *canvas-width* 0) @@ -1235,12 +1303,29 @@ (set-text-align! context "left") (fill-text context (number->string *player-score*) 4.0 y))) - (define (draw time) - (clear-screen) - (set-transform! context 1.0 0.0 0.0 1.0 0.0 0.0) - (set-scale! context *canvas-scale* *canvas-scale*) - (set-fill-color! context "#140c1c") - (fill-rect context 0.0 0.0 game-width game-height) + (define (draw-splash time) + (draw-image context image:cover + 0.0 0.0 game-width game-height + 0.0 0.0 game-width game-height) + (let ((x (/ game-width 2.0)) + (y (+ (- game-height 40.0) (* (sin (* time 2.0)) 4.0)))) + (set-fill-color! context "#ffffff") + (set-font! context "bold 18px monogram") + (set-text-align! context "center") + (fill-text context "Press ENTER to start" x y))) + + (define (draw-play time) + (draw-background image:starfield-bg 0.3) + (draw-background image:starfield-fg 0.5) + (draw-level-foreground level) + (draw-particles particles) + (draw-player-bullets) + (draw-enemies enemies time) + (draw-player) + (draw-enemy-bullets) + (draw-hud)) + + (define (draw-pause time) (draw-background image:starfield-bg 0.3) (draw-background image:starfield-fg 0.5) (draw-level-foreground level) @@ -1250,24 +1335,81 @@ (draw-player) (draw-enemy-bullets) (draw-hud) - (match *game-state* - ('game-over - (set-fill-color! context "#ffffff") - (set-font! context "bold 36px monogram") - (set-text-align! context "center") - (fill-text context "GAME OVER" (/ game-width 2.0) (/ game-height 2.0))) - ('game-win - (set-fill-color! context "#ffffff") - (set-font! context "bold 36px monogram") - (set-text-align! context "center") - (fill-text context "WELL DONE" (/ game-width 2.0) (/ game-height 2.0))) - ('paused - (set-fill-color! context "#ffffff") - (set-font! context "bold 36px monogram") - (set-text-align! context "center") - (fill-text context "PAUSED" (/ game-width 2.0) (/ game-height 2.0))) - (_ #t)) - (request-animation-frame draw)) + (set-fill-color! context "#ffffff") + (set-font! context "bold 36px monogram") + (set-text-align! context "center") + (fill-text context "PAUSED" (/ game-width 2.0) (/ game-height 2.0))) + + (define (draw-game-over time) + (draw-background image:starfield-bg 0.3) + (draw-background image:starfield-fg 0.5) + (draw-level-foreground level) + (draw-particles particles) + (draw-enemies enemies time) + (draw-enemy-bullets) + (draw-hud) + (set-fill-color! context "#ffffff") + (set-font! context "bold 36px monogram") + (set-text-align! context "center") + (fill-text context "CONTINUE?" + (/ game-width 2.0) (/ game-height 3.0)) + (set-font! context "bold 72px monogram") + (fill-text context *countdown* + (/ game-width 2.0) (+ (/ game-height 3.0) 60.0))) + + (define (draw-game-clear time) + (draw-background image:starfield-bg 0.3) + (draw-background image:starfield-fg 0.5) + (draw-level-foreground level) + (draw-particles particles) + (draw-player) + (set-fill-color! context "#ffffff") + (set-font! context "bold 36px monogram") + (set-text-align! context "center") + (fill-text context "CLEAR" (/ game-width 2.0) (/ game-height 3.0)) + (set-font! context "bold 24px monogram") + (set-text-align! context "left") + (when *clear-show-1cc-bonus?* + (fill-text context "1CC BONUS" + 16.0 + (+ (/ game-height 3.0) 40))) + (when *clear-show-life-bonus?* + (fill-text context "LIFE BONUS" + 16.0 + (+ (/ game-height 3.0) 80))) + (when *clear-show-total-score?* + (fill-text context "TOTAL SCORE" + 16.0 + (+ (/ game-height 3.0) 120))) + (set-text-align! context "right") + (when *clear-show-1cc-bonus?* + (fill-text context *clear-1cc-bonus* + (- game-width 16.0) + (+ (/ game-height 3.0) 40))) + (when *clear-show-life-bonus?* + (fill-text context *clear-life-bonus* + (- game-width 16.0) + (+ (/ game-height 3.0) 80))) + (when *clear-show-total-score?* + (fill-text context *clear-total-score* + (- game-width 16.0) + (+ (/ game-height 3.0) 120)))) + + (define (draw _prev-time) + (let ((time (current-time))) + (clear-screen) + (set-transform! context 1.0 0.0 0.0 1.0 0.0 0.0) + (set-scale! context *canvas-scale* *canvas-scale*) + (set-fill-color! context "#140c1c") + (fill-rect context 0.0 0.0 game-width game-height) + (let ((draw* (match *game-state* + ('splash draw-splash) + ('play draw-play) + ('pause draw-pause) + ('game-over draw-game-over) + ('game-clear draw-game-clear)))) + (draw* time)) + (request-animation-frame draw))) (define (reset!) (set! *game-state* 'play) @@ -1288,7 +1430,8 @@ (set! *player-invincible?* #f) (set! *player-visible?* #t) (set! *player-fire-counter* 0) - (set! *player-score* 0)) + (set! *player-score* 0) + (set! *player-1cc?* #t)) (define (on-key-down event) (let ((code (keyboard-event-code event))) @@ -1335,10 +1478,14 @@ (prevent-default! event)) (else (match *game-state* + ('splash + (when (string-=? code "Enter") + (reset!) + (set! *game-state* 'play))) ('play (cond ((string-=? code "Enter") - (set! *game-state* 'paused) + (set! *game-state* 'pause) (prevent-default! event)) ((string-=? code "KeyD") (set! *debug?* (not *debug?*)) @@ -1347,17 +1494,25 @@ (reset!) (prevent-default! event)) ((string-=? code "KeyW") - (set! *game-state* 'game-win) + (do-game-clear) + (prevent-default! event)) + ((string-=? code "KeyO") + (do-game-over) (prevent-default! event)))) - ('paused + ('pause (cond ((string-=? code "Enter") (set! *game-state* 'play) (prevent-default! event)))) - ((or 'game-over 'game-win) + ('game-clear (cond ((string-=? code "Enter") - (reset!) + (set! *game-state* 'splash) + (prevent-default! event)))) + ('game-over + (cond + ((string-=? code "Enter") + (do-continue) (prevent-default! event)))) (_ #t)))))) @@ -1401,9 +1556,9 @@ (define dt (/ 1000.0 60.0)) (define (update) + (scheduler-tick! *scheduler*) (match *game-state* ('play - (scheduler-tick! *scheduler*) (level-update! level) (player-update!) (bullet-pool-update! player-bullets player-bullet-collide) @@ -1411,7 +1566,18 @@ (enemy-pool-update! enemies) (particle-pool-update! particles) (when (game-over?) - (set! *game-state* 'game-over))) + (do-game-over))) + ('game-over + (set! *scroll* *last-scroll*) + (scheduler-tick! *countdown-scheduler*) + (bullet-pool-update! player-bullets player-bullet-collide) + (bullet-pool-update! enemy-bullets enemy-bullet-collide) + (particle-pool-update! particles) + (enemy-pool-update! enemies)) + ('game-clear + (bullet-pool-update! player-bullets player-bullet-collide) + (bullet-pool-update! enemy-bullets enemy-bullet-collide) + (particle-pool-update! particles)) (_ #t)) (timeout update dt)) @@ -1419,7 +1585,6 @@ (add-event-listener! (current-document) "keydown" on-key-down) (add-event-listener! (current-document) "keyup" on-key-up) (resize-canvas) - (reset!) (request-animation-frame draw) (timeout update dt))) |