;;; Sly
;;; Copyright (C) 2016 David Thompson <davet@gnu.org>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Particle simulations.
;;
;;; Code:

(define-module (sly render particles)
  #:use-module (srfi srfi-9)
  #:use-module (sly math vector)
  #:use-module (sly math rect)
  #:use-module (sly render)
  #:use-module (sly render mesh)
  #:use-module (sly render texture)
  #:use-module (sly render sprite-batch)
  #:export (make-simple-particle-renderer
            make-particle-system
            particle-system?
            particle-system-texture
            particle-system-duration
            particle-system-emit-interval
            particle-system-emit-count
            particle-system-life-span
            particle-system-renderer
            render-particles))

(define (make-simple-particle-renderer proc)
  "Create a particle renderer using PROC to define the position of
each particle.  PROC must accept 3 numeric arguments: the particle ID,
time, and life span.  PROC must return a 2D vector."
  (lambda (gfx batch texture rect n time life-span)
    (let* ((v (proc n time life-span)))
      (sprite-batch-add! batch gfx texture (rect-move rect v)))))

(define default-particle-renderer
  (make-simple-particle-renderer
   (lambda (n time life-span)
     (polar2 time n))))

(define-record-type <particle-system>
  (%make-particle-system texture sprite-rect duration emit-interval
                         emit-count life-span renderer)
  particle-system?
  (texture particle-system-texture)
  (sprite-rect particle-system-sprite-rect)
  (duration particle-system-duration)
  (emit-interval particle-system-emit-interval)
  (emit-count particle-system-emit-count)
  (life-span particle-system-life-span)
  (renderer particle-system-renderer))

(define* (make-particle-system #:key (texture null-texture) duration
                               (emit-interval 1) (emit-count 1)
                               (life-span 60)
                               (renderer default-particle-renderer))
  "Create a new particle system where each particle is rendered using
TEXTURE.  EMIT-COUNT particles are emitted every EMIT-INTERVAL ticks
of the game clock for DURATION ticks and each particle exists for
LIFE-SPAN ticks.  The procedure RENDERER is responsible for placing
and rendering each particle, and takes the following arguments:
graphics context, sprite batch, texture, sprite rectangle, particle
ID, time, and life span."
  (let* ((w (texture-width texture))
         (h (texture-height texture))
         (sprite-rect (make-rect (- (/ w 2)) (- (/ h 2)) w h)))
    (%make-particle-system texture sprite-rect duration emit-interval
                           emit-count life-span renderer)))

(define (render-particles particle-system batch time)
  "Create a renderer for PARTICLE-SYSTEM at TIME.  The particles will
be rendered using BATCH, a sprite batcher."
  (let* ((life-span (particle-system-life-span particle-system))
         (emit-count (particle-system-emit-count particle-system))
         (interval (particle-system-emit-interval particle-system))
         (duration (particle-system-duration particle-system))
         (first-wave (max (floor (/ (- time life-span) interval)) 0))
         (last-wave (floor
                     (/ (if duration
                            (min time duration)
                            time)
                        interval)))
         (render (particle-system-renderer particle-system))
         (texture (particle-system-texture particle-system))
         (sprite-rect (particle-system-sprite-rect particle-system)))
    (lambda (gfx)
      (with-sprite-batch batch gfx
        (let loop ((w first-wave))
          (when (<= w last-wave)
            (let ((life-time (- time (* w interval)))
                  (first-particle (* w emit-count)))
              (let loop ((p 0))
                (when (< p emit-count)
                  (render gfx batch texture sprite-rect
                          (+ first-particle p)
                          life-time life-span)
                  (loop (1+ p)))))
            (loop (1+ w))))))))