summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2023-10-22 20:16:31 -0400
committerDavid Thompson <dthompson2@worcester.edu>2023-10-22 20:16:31 -0400
commit07f7219be17097f08dac90a4d0f38f7c6e843722 (patch)
tree4750d3fc2f4ec2597bcf3255832139af1866f9ce
parentaa252183bb70e0a1d8feffeca25b149a49e30ee6 (diff)
Fix scheduler, add player lives, update player sprite.
-rw-r--r--game.scm105
-rw-r--r--images/player.asebin477 -> 530 bytes
-rw-r--r--images/player.pngbin195 -> 285 bytes
3 files changed, 73 insertions, 32 deletions
diff --git a/game.scm b/game.scm
index 8f1eb99..36f99d6 100644
--- a/game.scm
+++ b/game.scm
@@ -241,32 +241,42 @@
(vector-set! tasks num-tasks (cons (+ ticks delay) thunk))
(vector-set! scheduler 1 (+ num-tasks 1))))))
(define (scheduler-tick! scheduler)
- (match scheduler
- (#(ticks num-tasks max-tasks tasks)
- (let ((t (+ ticks 1)))
- (let loop ((i 0) (k num-tasks) (to-run '()))
- (if (< i k)
- (match (vector-ref tasks i)
- ((t* . thunk)
- (if (<= t* t)
- (let ((k* (- k 1)))
- (vector-set! tasks i (vector-ref tasks k*))
- (vector-set! tasks k* #f)
- (loop i k* (cons thunk to-run)))
- (loop (+ i 1) k to-run))))
- (begin
- (vector-set! scheduler 0 t)
- (vector-set! scheduler 1 k)
- (for-each (lambda (thunk) (thunk)) to-run))))))))
+ (define (run-thunks thunks)
+ (for-each (lambda (thunk) (thunk)) thunks))
+ (run-thunks
+ (match scheduler
+ (#(ticks num-tasks max-tasks tasks)
+ (let ((t (+ ticks 1)))
+ (let loop ((i 0) (k num-tasks) (to-run '()))
+ (if (< i k)
+ (match (vector-ref tasks i)
+ ((t* . thunk)
+ (if (<= t* t)
+ (let ((k* (- k 1)))
+ (vector-set! tasks i (vector-ref tasks k*))
+ (vector-set! tasks k* #f)
+ (loop i k* (cons thunk to-run)))
+ (loop (+ i 1) k to-run))))
+ (begin
+ (vector-set! scheduler 0 t)
+ (vector-set! scheduler 1 k)
+ to-run))))))))
(define *scheduler* (make-scheduler 100))
-
- (define %script-tag (make-prompt-tag 'script))
+ (define %script-tag (make-prompt-tag "script"))
(define (run-script thunk)
(define (run thunk)
(call-with-prompt %script-tag thunk handler))
(define (handler k delay)
- (scheduler-add! *scheduler* (lambda () (run k)) delay))
- (run thunk))
+ (when delay
+ (scheduler-add! *scheduler* (lambda () (run k)) delay)))
+ (run
+ (lambda ()
+ (thunk)
+ ;; Nasty hack: For some reason, falling through the prompt
+ ;; thunk messes up the Scheme stack, resulting in an invalid
+ ;; ref.cast somewhere. So, we *never* fall through. Instead,
+ ;; we create a continuation that gets thrown away.
+ (abort-to-prompt %script-tag #f))))
(define (wait delay)
(abort-to-prompt %script-tag delay))
@@ -398,7 +408,7 @@
X _ _ _ _ _ _ _ _ _ _ _ _ _ X
X \ _ _ _ _ _ _ _ _ _ _ _ / X
X X \ _ _ _ _ _ _ _ _ _ / X X
- X X X X X X X X X X X X X X X)
+ X X X \ _ _ _ _ _ _ _ / X X X)
(define (level-offset x y)
(* (+ (* level-width y) x) %tile-size))
(define (point-collides-with-level? level x y)
@@ -550,6 +560,12 @@
(define player-height 24.0)
(define *player-fire-counter* 0)
(define player-fire-interval 3)
+ (define player-hitbox-width 2.0)
+ (define player-hitbox-height 2.0)
+ (define %default-lives 3)
+ (define *player-lives* %default-lives)
+ (define *player-visible?* #t)
+ (define *player-invincible?* #f)
;; left, right, down, up, fire
(define key-state (vector #f #f #f #f #f))
(define (update-player-velocity!)
@@ -582,6 +598,22 @@
(set! *player-fire-counter* 0))))
(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))))
+ (define (game-over?)
+ (= *player-lives* 0))
(define (clear-screen)
(clear-rect context 0.0 0.0 canvas-width canvas-height))
@@ -594,7 +626,8 @@
(define (draw-player)
(draw-image context image:player
- 0.0 0.0 player-width player-height
+ (if *player-visible?* 0.0 player-width) 0.0
+ player-width player-height
(- (vec2-x player-position)
(/ player-width 2.0))
(- (vec2-y player-position)
@@ -674,6 +707,15 @@
(update-scroll!)
(vec2-add! player-position player-velocity)
(vec2-clamp! player-position 0.0 0.0 game-width game-height)
+ (when (and (not *player-invincible?*)
+ (rect-collides-with-level? level
+ (- (vec2-x player-position)
+ (/ player-hitbox-width 2.0))
+ (- (vec2-y player-position)
+ (/ player-hitbox-height 2.0))
+ player-hitbox-width
+ player-hitbox-height))
+ (player-die!))
(bullet-pool-update! player-bullets player-bullet-collide)
(bullet-pool-update! enemy-bullets enemy-bullet-collide)
(enemy-pool-update! enemies enemy-collide)
@@ -681,15 +723,14 @@
(set! *player-fire-counter*
(modulo (+ *player-fire-counter* 1) player-fire-interval))
(when (= *player-fire-counter* 0)
- (let ((xoff 4.0))
- (bullet-pool-add! player-bullets 0
- (- (vec2-x player-position) xoff)
- (vec2-y player-position)
- 0.0 (- player-bullet-speed))
- (bullet-pool-add! player-bullets 0
- (+ (vec2-x player-position) xoff)
- (vec2-y player-position)
- 0.0 (- player-bullet-speed)))
+ (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))
diff --git a/images/player.ase b/images/player.ase
index 2c90a8f..53dfcae 100644
--- a/images/player.ase
+++ b/images/player.ase
Binary files differ
diff --git a/images/player.png b/images/player.png
index 145655b..f4ac194 100644
--- a/images/player.png
+++ b/images/player.png
Binary files differ