Add particle effect when bomb explodes.

This commit is contained in:
David Thompson 2024-05-26 16:46:50 -04:00
parent 4feffecf8e
commit d725310239
3 changed files with 136 additions and 2 deletions

View file

@ -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 \

View file

@ -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)

116
modules/game/particles.scm Normal file
View file

@ -0,0 +1,116 @@
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;;
;;; 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 <particle-pool>
(%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
(($ <particle-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
(($ <particle-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
(($ <particle-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
(($ <particle-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))))))))