diff options
| -rw-r--r-- | game.scm | 105 | ||||
| -rw-r--r-- | images/player.ase | bin | 477 -> 530 bytes | |||
| -rw-r--r-- | images/player.png | bin | 195 -> 285 bytes |
3 files changed, 73 insertions, 32 deletions
@@ -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 Binary files differindex 2c90a8f..53dfcae 100644 --- a/images/player.ase +++ b/images/player.ase diff --git a/images/player.png b/images/player.png Binary files differindex 145655b..f4ac194 100644 --- a/images/player.png +++ b/images/player.png |
