diff --git a/Makefile b/Makefile index bfa7c15..9ef20c1 100644 --- a/Makefile +++ b/Makefile @@ -9,6 +9,7 @@ modules = \ modules/game/actors.scm \ modules/game/effects.scm \ modules/game/level.scm \ + modules/game/particles.scm \ modules/game/scripts.scm \ modules/game/tileset.scm \ modules/game/time.scm \ diff --git a/game.scm b/game.scm index fe1b7c8..47509b7 100644 --- a/game.scm +++ b/game.scm @@ -48,6 +48,7 @@ (game levels catboss-2) (game levels catboss-3) (game levels credits) + (game particles) (game scripts) (game tileset) (game time) @@ -324,9 +325,22 @@ (('receive-electron x y) (play-sound-effect audio:warp 0.25)) (('explosion x y) - ;; TODO: Particles! (play-sound-effect audio:explosion) - (show-effect! (make-screen-shake-effect 0.2))) + (show-effect! (make-screen-shake-effect 0.2)) + (run-script + (lambda () + (do ((i 0 (1+ i))) + ((= i 16)) + (do ((j 0 (1+ j))) + ((= j 2)) + (let ((angle (* (random) 2.0 pi)) + (dx (- (* (random) tile-width 3.0) tile-width)) + (dy (- (* (random) tile-height 3.0) tile-height))) + (particle-pool-add! particles 51 8 + (+ (* x tile-width) dx) + (+ (* y tile-height) dy) + 0.0 0.0))) + (wait 1))))) (_ (values))) (lp rest)))) (update-objects!) @@ -338,6 +352,7 @@ (define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz (define (update) (scheduler-tick! (current-scheduler)) + (particle-pool-update! particles) (timeout update-callback dt)) (define update-callback (procedure->external update)) @@ -405,6 +420,7 @@ (94 .4) (114 .4)) +(define particles (make-particle-pool 512 tileset)) (define number->string* (let ((cache (make-eq-hashtable))) ; assuming fixnums only @@ -541,6 +557,7 @@ (define (draw-level) (draw-background) (for-each draw-object *objects*) + (draw-particles context particles) (let ((alive? (with-goblins ($ (level-player *level*) 'alive?)))) (unless alive? (set-global-alpha! context 0.7) diff --git a/modules/game/particles.scm b/modules/game/particles.scm new file mode 100644 index 0000000..7493d76 --- /dev/null +++ b/modules/game/particles.scm @@ -0,0 +1,116 @@ +;;; Copyright (C) 2024 David Thompson +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +(define-module (game particles) + #:use-module (dom canvas) + #:use-module (game tileset) + #:use-module (hoot bytevectors) + #:use-module (ice-9 match) + #:use-module (math) + #:use-module (srfi srfi-9) + #:export (make-particle-pool + particle-pool? + particle-pool-add! + particle-pool-reset! + particle-pool-update! + draw-particles)) + +(define s32-ref bytevector-s32-native-ref) +(define s32-set! bytevector-s32-native-set!) +(define f64-ref bytevector-ieee-double-native-ref) +(define f64-set! bytevector-ieee-double-native-set!) + +(define-record-type + (%make-particle-pool length capacity tileset ticks particles) + particle-pool? + (length particle-pool-length set-particle-pool-length!) + (capacity particle-pool-capacity set-particle-pool-capacity!) + (tileset particle-pool-tileset set-particle-pool-tileset!) + (ticks particle-pool-ticks set-particle-pool-ticks!) + (particles particle-pool-particles set-particle-pool-particles!)) + +;; per particle: spawn-time, lifespan, tile-idx, x, y, dx, dy +(define %particle-size (+ 4 4 4 8 8 8 8)) +(define particle-tile-width 16.0) +(define particle-tile-height 16.0) + +(define (make-particle-pool capacity tileset) + (let ((particles (make-bytevector (* capacity %particle-size)))) + (%make-particle-pool 0 capacity tileset 0 particles))) + +(define (particle-pool-offset i) + (* i %particle-size)) + +(define (particle-pool-add! pool tile-idx lifespan x y dx dy) + (match pool + (($ length capacity tileset ticks particles) + (let ((offset (particle-pool-offset length))) + (s32-set! particles offset ticks) + (s32-set! particles (+ offset 4) lifespan) + (s32-set! particles (+ offset 8) tile-idx) + (f64-set! particles (+ offset 12) x) + (f64-set! particles (+ offset 20) y) + (f64-set! particles (+ offset 28) dx) + (f64-set! particles (+ offset 36) dy) + (set-particle-pool-length! pool (1+ length)))))) + +(define (particle-pool-remove! pool i) + (match pool + (($ length capacity tileset 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 + (($ length capacity tileset 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 12))) + (y (f64-ref particles (+ offset 20))) + (dx (f64-ref particles (+ offset 28))) + (dy (f64-ref particles (+ offset 36))) + (x* (+ x dx)) + (y* (+ y dy))) + (cond + ((>= (- t t*) l) + (particle-pool-remove! pool i) + (loop i (- k 1))) + (else + (f64-set! particles (+ offset 12) (+ x dx)) + (f64-set! particles (+ offset 20) (+ y dy)) + (loop (+ i 1) k)))))) + (set-particle-pool-ticks! pool t))))) + +(define (draw-particles context pool) + (match pool + (($ length capacity tileset ticks particles) + (do ((i 0 (+ i 1))) + ((= i length)) + (let* ((offset (particle-pool-offset i)) + (idx (s32-ref particles (+ offset 8))) + (x (f64-ref particles (+ offset 12))) + (y (f64-ref particles (+ offset 20)))) + (draw-tile context tileset idx + (- x (/ particle-tile-width 2.0)) + (- y (/ particle-tile-height 2.0))))))))