Add particles.

4 files changed, 171 insertions, 24 deletions

diff --git a/game.scm b/game.scm
index 35bd477..0b7b4dd 100644
--- a/game.scm
+++ b/game.scm
@@ -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
new file mode 100644
index 0000000..6d96087
--- /dev/null
+++ b/images/particles.ase
diff --git a/images/particles.png b/images/particles.png
new file mode 100644
index 0000000..d5e7dde
--- /dev/null
+++ b/images/particles.png