summaryrefslogtreecommitdiff
path: root/game.scm
diff options
context:
space:
mode:
Diffstat (limited to 'game.scm')
-rw-r--r--game.scm303
1 files changed, 234 insertions, 69 deletions
diff --git a/game.scm b/game.scm
index b0daad0..7a6b2b8 100644
--- a/game.scm
+++ b/game.scm
@@ -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)))