116 lines
4.5 KiB
Scheme
116 lines
4.5 KiB
Scheme
;;; 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))))))))
|