diff options
Diffstat (limited to 'game.scm')
| -rw-r--r-- | game.scm | 125 |
1 files changed, 93 insertions, 32 deletions
@@ -205,6 +205,11 @@ (define pi/2 (/ pi 2.0)) (define tau (* pi 2.0)) + (define (do-circle proc k) + (do ((i 0 (+ i 1))) + ((= i k)) + (proc (* tau (inexact (/ i k)))))) + (define (clamp x min max) (cond ((< x min) min) ((> x max) max) @@ -359,14 +364,16 @@ ((= i num-tasks)) (vector-set! tasks i #f))))) (define *scheduler* (make-scheduler 100)) + (define current-script (make-parameter #f)) (define %script-tag (make-prompt-tag "script")) (define-type script %make-script script? (state script-state set-script-state!) - (cont script-cont set-script-cont!)) + (cont script-cont set-script-cont!) + (children script-children set-script-children!)) (define (make-script thunk) - (%make-script 'pending thunk)) + (%make-script 'pending thunk '())) (define (script-pending? script) (eq? (script-state script) 'pending)) (define (script-running? script) @@ -374,15 +381,23 @@ (define (script-cancelled? script) (eq? (script-state script) 'cancelled)) (define (script-cancel! script) - (set-script-state! script 'cancelled)) + (set-script-state! script 'cancelled) + (for-each script-cancel! (script-children script))) (define (script-run! script) (define (run thunk) (unless (script-cancelled? script) - (call-with-prompt %script-tag thunk handler))) + (call-with-prompt %script-tag + (lambda () + (parameterize ((current-script script)) + (thunk))) + handler))) (define (handler k delay) (when delay (scheduler-add! *scheduler* (lambda () (run k)) delay))) (when (script-pending? script) + (let ((parent (current-script))) + (when parent + (set-script-children! parent (cons script (script-children parent))))) (run (lambda () (set-script-state! script 'running) @@ -398,6 +413,10 @@ script)) (define (wait delay) (abort-to-prompt %script-tag delay)) + (define-syntax-rule (forever body ...) + (let loop () + body ... + (loop))) ;; Particles: (define-type particle-pool @@ -487,11 +506,11 @@ (define (explode x y) (let ((speed 1.0)) (sound-effect-play sound:explosion) - (do ((i 0 (+ i 1))) - ((= i 16)) - (let ((theta (* tau (/ i 16.0)))) - (particle-pool-add! particles 'explosion 20 x y - (* (cos theta) speed) (* (sin theta) speed)))))) + (do-circle + (lambda (theta) + (particle-pool-add! particles 'explosion 20 x y + (* (cos theta) speed) (* (sin theta) speed))) + 16))) ;; Bullets: ;; Similar to particles... but different. @@ -728,6 +747,10 @@ (vec2-x (enemy-velocity enemy))) (define (enemy-dy enemy) (vec2-y (enemy-velocity enemy))) + (define (set-enemy-dx! enemy dx) + (set-vec2-x! (enemy-velocity enemy) dx)) + (define (set-enemy-dy! enemy dy) + (set-vec2-y! (enemy-velocity enemy) dy)) (define (enemy-damage! enemy damage) (match enemy (#('enemy type health _ _ _ _ _ _ _ _ _ _) @@ -781,11 +804,12 @@ (h (vec2-y image-size))) (draw-image context image tx 0.0 w h (- x (/ w 2.0)) (- y (/ h 2.0)) w h) - (set-fill-color! context "#ff00ff80") - (fill-rect context - (- x (/ hbw 2.0)) - (- y (/ hbh 2.0)) - hbw hbh)))))) + ;; (set-fill-color! context "#ff00ff80") + ;; (fill-rect context + ;; (- x (/ hbw 2.0)) + ;; (- y (/ hbh 2.0)) + ;; hbw hbh) + ))))) (define-type enemy-pool %make-enemy-pool @@ -836,7 +860,10 @@ (set! *player-score* (+ *player-score* (enemy-points enemy)))) (when (eq? (enemy-type enemy) 'boss) - (set! *game-state* 'game-win)) + (run-script + (lambda () + (wait 60) + (set! *game-state* 'game-win)))) (enemy-pool-remove! pool i) (loop i (- k 1))) (else @@ -862,6 +889,30 @@ (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) + #t (vec2 0.0 0.0) script 100 + #(0.0 0.0 0.0 0.0) image:turret (vec2 32.0 32.0)))) + + (define (spawn-popcorn* x y script) + (spawn-enemy + (make-enemy 'popcorn 1 (vec2 x y) (vec2 12.0 12.0) + #t (vec2 0.0 0.0) script 100 + #(0.0 0.0 0.0 0.0) image:popcorn (vec2 32.0 32.0)))) + + (define (spawn-flyer0* x y script) + (spawn-enemy + (make-enemy 'flyer0 20 (vec2 x y) (vec2 12.0 12.0) + #f (vec2 0.0 0.0) script 100 + #(0.0 0.0 0.0 0.0) image:flyer0 (vec2 32.0 32.0)))) + + (define (spawn-flyer1* x y script) + (spawn-enemy + (make-enemy 'flyer1 10 (vec2 x y) (vec2 16.0 16.0) + #f (vec2 0.0 0.0) script 100 + #(0.0 0.0 0.0 0.0) image:flyer1 (vec2 32.0 32.0)))) + (define (spawn-turret x y) (define (script enemy) (let ((speed 2.0)) @@ -878,32 +929,42 @@ (* (vec2-y v) speed))) (wait 30) (loop (+ theta 0.2))))) - (spawn-enemy - (make-enemy 'turret 10 (vec2 x y) (vec2 16.0 16.0) - #t (vec2 0.0 0.0) script 100 - #(0.0 0.0 0.0 0.0) image:turret (vec2 64.0 64.0)))) + (spawn-turret* x y script)) (define (spawn-popcorn x y) - (spawn-enemy - (make-enemy 'popcorn 1 (vec2 x y) (vec2 16.0 16.0) - #t (vec2 0.0 0.0) #f 100 - #(0.0 0.0 0.0 0.0) image:popcorn (vec2 32.0 32.0)))) + (spawn-popcorn* x y #f)) (define (spawn-flyer0 x y) - (spawn-enemy - (make-enemy 'flyer0 20 (vec2 x y) (vec2 16.0 16.0) - #t (vec2 0.0 0.0) #f 100 - #(0.0 0.0 0.0 0.0) image:flyer0 (vec2 32.0 32.0)))) + (define (script flyer) + (run-script + (lambda () + (let ((speed 1.0)) + (forever + (do-circle + (lambda (theta) + (bullet-pool-add! enemy-bullets 0 + (enemy-x flyer) + (enemy-y flyer) + 2.0 2.0 + (* (cos theta) speed) + (* (sin theta) speed)) + (wait 5)) + 16))))) + (forever + (pk 'change-velocity) + (set-enemy-dx! flyer 0.5) + (wait 60) + (pk 'change-velocity) + (set-enemy-dx! flyer -0.5) + (wait 60))) + (spawn-flyer0* x y script)) (define (spawn-flyer1 x y) - (spawn-enemy - (make-enemy 'flyer1 10 (vec2 x y) (vec2 16.0 16.0) - #t (vec2 0.0 0.0) #f 100 - #(0.0 0.0 0.0 0.0) image:flyer1 (vec2 32.0 32.0)))) + (spawn-flyer1* x y #f)) (define (spawn-boss x y) (spawn-enemy - (make-enemy 'boss 100 (vec2 x y) (vec2 100.0 40.0) + (make-enemy 'boss 300 (vec2 x y) (vec2 100.0 40.0) #t (vec2 0.0 0.0) #f 1000000 #(0.0 0.0 0.0 0.0) image:boss (vec2 120.0 80.0)))) |