diff options
| -rw-r--r-- | game.scm | 175 | ||||
| -rw-r--r-- | images/dawnbringer-16.gpl | 20 | ||||
| -rw-r--r-- | images/particles.ase | bin | 0 -> 558 bytes | |||
| -rw-r--r-- | images/particles.png | bin | 0 -> 147 bytes |
4 files changed, 171 insertions, 24 deletions
@@ -198,6 +198,7 @@ (define f64-set! bytevector-ieee-double-native-set!) (define pi (* 4.0 (atan 1.0))) + (define 2pi (* 2.0 pi)) (define pi/2 (/ pi 2.0)) (define tau (* pi 2.0)) @@ -305,6 +306,7 @@ (define image:enemy-bullets (load-image "images/enemy-bullets.png")) (define image:map (load-image "images/map.png")) (define image:enemies (load-image "images/enemies.png")) + (define image:particles (load-image "images/particles.png")) (define sound:explosion (load-sound-effect "audio/explosion.wav")) (define sound:player-shoot (load-sound-effect "audio/player-shoot.wav")) (define sound:player-death (load-sound-effect "audio/player-death.wav")) @@ -390,7 +392,102 @@ (define (wait delay) (abort-to-prompt %script-tag delay)) + ;; Particles: + (define-type particle-pool + %make-particle-pool + particle-pool? + (length particle-pool-length set-particle-pool-length!) + (capacity particle-pool-capacity set-particle-pool-capacity!) + (image particle-pool-image set-particle-pool-image!) + (ticks particle-pool-ticks set-particle-pool-ticks!) + (particles particle-pool-particles set-particle-pool-particles!)) + ;; per particle: spawn-time, lifespan, tile-x, x, y, dx, dy + (define %particle-size (+ 4 4 8 8 8 8 8)) + (define particle-tile-width 8.0) + (define particle-tile-height 8.0) + (define (make-particle-pool capacity image) + (let ((particles (make-bytevector (* capacity %particle-size)))) + (%make-particle-pool 0 capacity image 0 particles))) + (define (particle-pool-offset i) + (* i %particle-size)) + (define (particle-pool-add! pool type lifespan x y dx dy) + (match pool + (#('particle-pool length capacity image ticks particles) + (let ((offset (particle-pool-offset length)) + (tx (* (match type + ('muzzle-flash 0.0) + ('explosion 1.0) + ('hit-wall 2.0)) + particle-tile-width))) + (s32-set! particles offset ticks) + (s32-set! particles (+ offset 4) lifespan) + (f64-set! particles (+ offset 8) tx) + (f64-set! particles (+ offset 16) x) + (f64-set! particles (+ offset 24) y) + (f64-set! particles (+ offset 32) dx) + (f64-set! particles (+ offset 40) dy) + (set-particle-pool-length! pool (+ length 1)))))) + (define (particle-pool-remove! pool i) + (match pool + (#('particle-pool length capacity image ticks particles) + (when (and (>= i 0) (< i length)) + (let ((at (particle-pool-offset i)) + (start (particle-pool-offset (- length 1)))) + (bytevector-copy! particles at particles start (+ start %particle-size)) + (set-particle-pool-length! pool (- length 1))))))) + (define (particle-pool-reset! pool) + (set-particle-pool-length! pool 0)) + (define (particle-pool-update! pool) + (match pool + (#('particle-pool length capacity image ticks particles) + (let ((t (+ ticks 1))) + (let loop ((i 0) (k length)) + (when (< i k) + (let* ((offset (particle-pool-offset i)) + (t* (s32-ref particles offset)) + (l (s32-ref particles (+ offset 4))) + (x (f64-ref particles (+ offset 16))) + (y (f64-ref particles (+ offset 24))) + (dx (f64-ref particles (+ offset 32))) + (dy (f64-ref particles (+ offset 40))) + (x* (+ x dx)) + (y* (+ y dy))) + (cond + ((>= (- t t*) l) + (particle-pool-remove! pool i) + (loop i (- k 1))) + (else + (f64-set! particles (+ offset 16) (+ x dx)) + (f64-set! particles (+ offset 24) (+ y dy)) + (loop (+ i 1) k)))))) + (set-particle-pool-ticks! pool t))))) + (define (draw-particles pool) + (match pool + (#('particle-pool length capacity image ticks particles) + (do ((i 0 (+ i 1))) + ((= i length)) + (let* ((offset (particle-pool-offset i)) + (tx (f64-ref particles (+ offset 8))) + (x (f64-ref particles (+ offset 16))) + (y (f64-ref particles (+ offset 24)))) + (draw-image context image tx 0.0 + particle-tile-width particle-tile-height + (- x (/ particle-tile-width 2.0)) + (- y (/ particle-tile-height 2.0)) + particle-tile-width particle-tile-height)))))) + + (define particles (make-particle-pool 500 image:particles)) + (define (explode x y) + (let ((speed 1.0)) + (sound-effect-play sound:explosion) + (do ((i 0 (+ i 1))) + ((= i 16)) + (let ((theta (* 2pi (/ i 16.0)))) + (particle-pool-add! particles 'explosion 20 x y + (* (cos theta) speed) (* (sin theta) speed)))))) + ;; Bullets: + ;; Similar to particles... but different. (define-type bullet-pool %make-bullet-pool bullet-pool? @@ -446,7 +543,18 @@ (x* (+ x dx)) (y* (+ y dy))) (cond + ((out-of-bounds? x* y* w h) + (bullet-pool-remove! pool i) + (loop i (- k 1))) ((collide type x* y* w h) + (let ((d 1.0) + (l 3)) + (sound-effect-play sound:bullet-hit 0.02) + (particle-pool-add! particles 'hit-wall l x* y* d d) + (particle-pool-add! particles 'hit-wall l x* y* (- d) d) + (particle-pool-add! particles 'hit-wall l x* y* (- d) (- d)) + (particle-pool-add! particles 'hit-wall l x* y* d (- d)) + #t) (bullet-pool-remove! pool i) (loop i (- k 1))) (else @@ -715,7 +823,7 @@ ((or (enemy-dead? enemy) (enemy-out-of-bounds? enemy)) (when (enemy-dead? enemy) - (sound-effect-play sound:explosion) + (explode (enemy-x enemy) (enemy-y enemy)) (set! *player-score* (+ *player-score* (enemy-points enemy)))) (enemy-pool-remove! pool i) @@ -820,13 +928,17 @@ (define (set-focusing! pressed?) (let ((was-focusing? (focusing?))) (vector-set! key-state 5 pressed?) + (update-player-velocity!) (when (and pressed? (not was-focusing?)) - (set! *player-fire-counter* 0) - (update-player-velocity!)))) + (set! *player-fire-counter* 0)))) + (define (player-position-reset!) + (set-vec2-x! player-position (/ game-width 2.0)) + (set-vec2-y! player-position (- game-height 12.0))) (define (player-die!) (unless *player-invincible?* ;; (sound-effect-play sound:player-death) (set! *player-lives* (max (- *player-lives* 1) 0)) + (player-position-reset!) (run-script (lambda () (set! *player-invincible?* #t) @@ -842,6 +954,13 @@ (define (game-over?) (= *player-lives* 0)) (define (player-update!) + (define (muzzle-flash x y) + (let ((life 6) + (ldx -1.0) + (rdx 1.0) + (dy -1.0)) + (particle-pool-add! particles 'muzzle-flash life x y ldx dy) + (particle-pool-add! particles 'muzzle-flash life x y rdx dy))) (vec2-add! player-position player-velocity) (vec2-clamp! player-position 0.0 0.0 game-width game-height) (set-vec2-x! player-hitbox-position @@ -865,23 +984,30 @@ player-fire-interval))) (when (= *player-fire-counter* 0) (sound-effect-play sound:player-shoot 0.2) - (if (focusing?) - (bullet-pool-add! player-bullets 1 - (vec2-x player-position) - (vec2-y player-position) - 6.0 6.0 - 0.0 (- player-bullet-speed)) - (begin - (bullet-pool-add! player-bullets 0 - (- (vec2-x player-position) 6.0) - (vec2-y player-position) - 3.0 4.0 - 0.0 (- player-bullet-speed)) - (bullet-pool-add! player-bullets 0 - (+ (vec2-x player-position) 8.0) - (vec2-y player-position) - 3.0 4.0 - 0.0 (- player-bullet-speed)))) + (let ((px (vec2-x player-position)) + (py (vec2-y player-position))) + (if (focusing?) + (let ((y-off 6.0)) + (muzzle-flash px (- py y-off)) + (bullet-pool-add! player-bullets 1 + px py + 6.0 6.0 + 0.0 (- player-bullet-speed))) + (let ((hbw 3.0) + (hbh 4.0) + (lx (- px 6.0)) + (rx (+ px 8.0)) + (y (- py 4.0))) + (muzzle-flash lx y) + (muzzle-flash rx y) + (bullet-pool-add! player-bullets 0 + lx py + hbw hbh + 0.0 (- player-bullet-speed)) + (bullet-pool-add! player-bullets 0 + rx py + hbw hbh + 0.0 (- player-bullet-speed))))) (set! *player-fire-counter* 0)))) (define (draw-player) (draw-image context image:player @@ -965,6 +1091,7 @@ ;; (draw-level-background level) (draw-background image:background 0.75) (draw-level-foreground level) + (draw-particles particles) (draw-player-bullets) (draw-enemies enemies time) (draw-player) @@ -998,8 +1125,8 @@ (bullet-pool-reset! player-bullets) (bullet-pool-reset! enemy-bullets) (enemy-pool-reset! enemies) - (set-vec2-x! player-position (/ game-width 2.0)) - (set-vec2-y! player-position (- game-height 12.0)) + (particle-pool-reset! particles) + (player-position-reset!) (set! *player-lives* %default-lives) (set! *player-invincible?* #f) (set! *player-visible?* #t) @@ -1082,8 +1209,7 @@ (define (player-bullet-collide type x y w h) (let ((x* (- x (/ w 2.0))) (y* (- y(/ h 2.0)))) - (or (out-of-bounds? x* y* w h) - (rect-collides-with-level? level x* y* w h) + (or (rect-collides-with-level? level x* y* w h) (let ((enemy (find-enemy enemies x y w h))) (and enemy (begin @@ -1123,6 +1249,7 @@ (bullet-pool-update! player-bullets player-bullet-collide) (bullet-pool-update! enemy-bullets enemy-bullet-collide) (enemy-pool-update! enemies) + (particle-pool-update! particles) (when (game-over?) (set! *game-state* 'game-over))) (_ #t)) diff --git a/images/dawnbringer-16.gpl b/images/dawnbringer-16.gpl new file mode 100644 index 0000000..f9e7ed0 --- /dev/null +++ b/images/dawnbringer-16.gpl @@ -0,0 +1,20 @@ +GIMP Palette
+#Palette Name: DawnBringer 16
+#Description: Created by <a href="http://pixeljoint.com/p/23821.htm">DawnBringer</a>.
+#Colors: 16
+20 12 28 140c1c
+68 36 52 442434
+48 52 109 30346d
+78 74 78 4e4a4e
+133 76 48 854c30
+52 101 36 346524
+208 70 72 d04648
+117 113 97 757161
+89 125 206 597dce
+210 125 44 d27d2c
+133 149 161 8595a1
+109 170 44 6daa2c
+210 170 153 d2aa99
+109 194 202 6dc2ca
+218 212 94 dad45e
+222 238 214 deeed6
diff --git a/images/particles.ase b/images/particles.ase Binary files differnew file mode 100644 index 0000000..6d96087 --- /dev/null +++ b/images/particles.ase diff --git a/images/particles.png b/images/particles.png Binary files differnew file mode 100644 index 0000000..d5e7dde --- /dev/null +++ b/images/particles.png |
