2016-12-13 10:08:49 +00:00
|
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
|
2016-12-12 02:34:57 +00:00
|
|
|
-- | This module introduces a simple particle system to Affection
|
|
|
|
module Affection.Particle
|
2016-12-13 10:08:49 +00:00
|
|
|
( updateParticle
|
2016-12-12 02:34:57 +00:00
|
|
|
, drawParticles
|
2016-12-13 10:08:49 +00:00
|
|
|
, updateParticleSystem
|
2016-12-12 02:34:57 +00:00
|
|
|
) where
|
|
|
|
|
|
|
|
import Affection.Types
|
|
|
|
|
2016-12-13 10:08:49 +00:00
|
|
|
import Data.Maybe (catMaybes)
|
|
|
|
|
|
|
|
import qualified GEGL as G
|
|
|
|
|
2016-12-12 02:34:57 +00:00
|
|
|
-- This function updates particles through a specified function. Particle ageing
|
|
|
|
-- and death is being handled by 'updateParticles' itself and does not need to
|
|
|
|
-- bother you.
|
2016-12-13 10:08:49 +00:00
|
|
|
updateParticle
|
2016-12-12 02:34:57 +00:00
|
|
|
:: Double -- ^ Elapsed time in seconds
|
|
|
|
-> (Double -> Particle -> Particle) -- ^ Update function for a single 'Particle'
|
|
|
|
-- This Function should take the elapsed time
|
|
|
|
-- in seconds and the initial particle as arguments.
|
2016-12-13 10:08:49 +00:00
|
|
|
-> Particle -- ^ 'Particle' to be processed
|
|
|
|
-> Maybe Particle -- ^ resulting 'Particle'
|
|
|
|
updateParticle time funct p@Particle{..} =
|
|
|
|
if particleLife - time < 0
|
2016-12-12 02:34:57 +00:00
|
|
|
then
|
2016-12-13 10:08:49 +00:00
|
|
|
Nothing
|
2016-12-12 02:34:57 +00:00
|
|
|
else
|
2016-12-13 10:08:49 +00:00
|
|
|
Just $ funct time $ p { particleLife = particleLife - time }
|
2016-12-12 02:34:57 +00:00
|
|
|
|
|
|
|
drawParticles
|
|
|
|
:: (Particle -> Affection us ())
|
|
|
|
-> [Particle]
|
|
|
|
-> Affection us ()
|
|
|
|
drawParticles = mapM_
|
2016-12-13 10:08:49 +00:00
|
|
|
|
|
|
|
updateParticleSystem
|
|
|
|
:: ParticleSystem
|
|
|
|
-> Double
|
|
|
|
-> (Double -> Particle -> Particle)
|
|
|
|
-> (G.GeglBuffer -> G.GeglNode -> Particle -> Affection us ())
|
|
|
|
-> Affection us ParticleSystem
|
|
|
|
updateParticleSystem sys sec upd draw = do
|
|
|
|
let x = catMaybes $ map (updateParticle sec upd) (psParts sys)
|
|
|
|
mapM_ (draw (psBuffer sys) (psNode sys)) x
|
|
|
|
return $ sys
|
|
|
|
{ psParts = x }
|