affection/src/Affection/Particle.hs

107 lines
3.2 KiB
Haskell
Raw Normal View History

{-# LANGUAGE RecordWildCards #-}
-- | This module introduces a simple particle system to Affection
module Affection.Particle
( updateParticle
, drawParticles
, updateParticleSystem
) where
import Affection.Types
import Control.Monad
import Data.Maybe
import qualified GEGL as G
2016-12-24 07:27:47 +00:00
import Debug.Trace
-- 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.
updateParticle
2016-12-24 00:13:00 +00:00
:: Double
-- ^ Elapsed time in seconds
-> (Double -> Particle -> Affection us Particle)
-- ^ Update function for a single 'Particle'
-- This Function should take the elapsed time
-- in seconds and the initial particle as arguments.
2016-12-24 07:27:47 +00:00
-> [Maybe Particle]
2016-12-24 00:13:00 +00:00
-> Particle
-- ^ 'Particle' to be processed
2016-12-24 07:27:47 +00:00
-> Affection us [Maybe Particle]
2016-12-24 00:13:00 +00:00
-- ^ resulting 'Particle'
2016-12-24 07:27:47 +00:00
updateParticle time funct acc@[] pa =
if particleLife pa - time < 0
then do
liftIO $ G.gegl_node_drop $ particleRootNode pa
return $ Nothing : acc
else do
np <- Just <$> funct time pa { particleLife = particleLife pa - time }
return $ np : acc
updateParticle time funct acc@[p] pa =
if particleLife pa - time < 0
then do
2016-12-24 00:13:00 +00:00
liftIO $ G.gegl_node_drop $ particleRootNode pa
2016-12-24 07:27:47 +00:00
return $ Nothing : acc
else do
when (not $ isNothing p) $ do
-- liftIO $ traceIO "linking second node in list"
liftIO $ G.gegl_node_link
(particleStackCont pa)
(particleStackCont $ fromJust p)
np <- Just <$> funct time pa { particleLife = particleLife pa - time }
return $ np : acc
updateParticle time funct acc@(p:ps) pa =
if particleLife pa - time < 0
then do
liftIO $ G.gegl_node_drop $ particleRootNode pa
return $ Nothing : acc
else do
when (isNothing p) $ do
let mnl = nextLiving ps
maybe
(return ())
(\nl -> do
-- liftIO $ traceIO "linking nth node on list"
liftIO $ G.gegl_node_link (particleStackCont pa) (particleStackCont nl))
mnl
np <- Just <$> funct time pa { particleLife = particleLife pa - time }
return $ np : acc
-- | Get the next living particle from a list
nextLiving
:: [Maybe Particle]
-> Maybe Particle
nextLiving [] = Nothing
nextLiving acc = case catMaybes acc of
[] -> Nothing
ps -> Just $ head $ ps
-- if isNothing p
-- then nextLiving ps
-- else p
drawParticles
:: (Particle -> Affection us ())
-> [Particle]
-> Affection us ()
drawParticles = mapM_
updateParticleSystem
:: ParticleSystem
-> Double
2016-12-24 00:13:00 +00:00
-> (Double -> Particle -> Affection us Particle)
-> (G.GeglBuffer -> G.GeglNode -> Particle -> Affection us ())
-> Affection us ParticleSystem
updateParticleSystem sys sec upd draw = do
-- let x = catMaybes <$> mapM (updateParticle sec upd) (psParts sys)
-- x <- liftIO $ catMaybes <$> foldM (updateParticle sec upd) [] (psParts sys)
2016-12-24 07:27:47 +00:00
x <- catMaybes <$> foldM (updateParticle sec upd) [] (reverse $ psParts sys)
when (not $ null x) $ do
-- liftIO $ traceIO "linking last node to output"
liftIO $ G.gegl_node_link (particleStackCont $ last x) (psNode sys)
mapM_ (draw (psBuffer sys) (psNode sys)) x
return $ sys
{ psParts = x }