link only when needed

This commit is contained in:
nek0 2016-12-24 08:27:47 +01:00
parent b75f20c3d5
commit c6a37e80f7
1 changed files with 54 additions and 21 deletions

View File

@ -15,6 +15,8 @@ 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.
@ -25,31 +27,60 @@ updateParticle
-- ^ 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)
-> Affection us [Maybe Particle]
-- ^ resulting 'Particle'
updateParticle time funct pa =
updateParticle time funct acc@[] pa =
if particleLife pa - time < 0
then do
liftIO $ G.gegl_node_drop $ particleRootNode pa
return $ Nothing
else
Just <$> funct time pa { particleLife = particleLife pa - time }
-- updateParticle time funct acc@[p] pa =
-- if particleLife pa - time < 0
-- then do
-- G.gegl_node_drop $ particleRootNode pa
-- return $ Nothing : acc
-- else
-- return $ (Just $ funct time $ pa { particleLife = particleLife pa - time }) : acc
-- updateParticle time funct acc@(p:ps) pa =
-- if particleLife pa - time < 0
-- then do
-- G.gegl_node_drop $ particleRootNode pa
-- return $ Nothing : acc
-- else
-- return $ (Just $ funct time $ pa { particleLife = particleLife pa - time }) : acc
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 ())
@ -66,8 +97,10 @@ updateParticleSystem
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 <$> mapM (updateParticle sec upd) (psParts sys)
liftIO $ G.gegl_node_link_many $ map particleStackCont x ++ [psNode 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 }