{-# 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 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 :: 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. -> [Maybe Particle] -> Particle -- ^ 'Particle' to be processed -> Affection us [Maybe Particle] -- ^ resulting 'Particle' 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 liftIO $ G.gegl_node_drop $ particleRootNode pa 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 -> (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) 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 }