link only when needed

This commit is contained in:
nek0 2016-12-24 08:27:47 +01:00
parent b75f20c3d5
commit c6a37e80f7

View file

@ -15,6 +15,8 @@ import Data.Maybe
import qualified GEGL as G import qualified GEGL as G
import Debug.Trace
-- This function updates particles through a specified function. Particle ageing -- This function updates particles through a specified function. Particle ageing
-- and death is being handled by 'updateParticles' itself and does not need to -- and death is being handled by 'updateParticles' itself and does not need to
-- bother you. -- bother you.
@ -25,31 +27,60 @@ updateParticle
-- ^ Update function for a single 'Particle' -- ^ Update function for a single 'Particle'
-- This Function should take the elapsed time -- This Function should take the elapsed time
-- in seconds and the initial particle as arguments. -- in seconds and the initial particle as arguments.
-> [Maybe Particle]
-> Particle -> Particle
-- ^ 'Particle' to be processed -- ^ 'Particle' to be processed
-> Affection us (Maybe Particle) -> Affection us [Maybe Particle]
-- ^ resulting 'Particle' -- ^ resulting 'Particle'
updateParticle time funct pa = updateParticle time funct acc@[] pa =
if particleLife pa - time < 0 if particleLife pa - time < 0
then do then do
liftIO $ G.gegl_node_drop $ particleRootNode pa liftIO $ G.gegl_node_drop $ particleRootNode pa
return $ Nothing return $ Nothing : acc
else else do
Just <$> funct time pa { particleLife = particleLife pa - time } np <- Just <$> funct time pa { particleLife = particleLife pa - time }
-- updateParticle time funct acc@[p] pa = return $ np : acc
-- if particleLife pa - time < 0 updateParticle time funct acc@[p] pa =
-- then do if particleLife pa - time < 0
-- G.gegl_node_drop $ particleRootNode pa then do
-- return $ Nothing : acc liftIO $ G.gegl_node_drop $ particleRootNode pa
-- else return $ Nothing : acc
-- return $ (Just $ funct time $ pa { particleLife = particleLife pa - time }) : acc else do
-- updateParticle time funct acc@(p:ps) pa = when (not $ isNothing p) $ do
-- if particleLife pa - time < 0 -- liftIO $ traceIO "linking second node in list"
-- then do liftIO $ G.gegl_node_link
-- G.gegl_node_drop $ particleRootNode pa (particleStackCont pa)
-- return $ Nothing : acc (particleStackCont $ fromJust p)
-- else np <- Just <$> funct time pa { particleLife = particleLife pa - time }
-- return $ (Just $ funct time $ pa { particleLife = particleLife pa - time }) : acc 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 drawParticles
:: (Particle -> Affection us ()) :: (Particle -> Affection us ())
@ -66,8 +97,10 @@ updateParticleSystem
updateParticleSystem sys sec upd draw = do updateParticleSystem sys sec upd draw = do
-- let x = catMaybes <$> mapM (updateParticle sec upd) (psParts sys) -- let x = catMaybes <$> mapM (updateParticle sec upd) (psParts sys)
-- x <- liftIO $ catMaybes <$> foldM (updateParticle sec upd) [] (psParts sys) -- x <- liftIO $ catMaybes <$> foldM (updateParticle sec upd) [] (psParts sys)
x <- catMaybes <$> mapM (updateParticle sec upd) (psParts sys) x <- catMaybes <$> foldM (updateParticle sec upd) [] (reverse $ psParts sys)
liftIO $ G.gegl_node_link_many $ map particleStackCont x ++ [psNode 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 mapM_ (draw (psBuffer sys) (psNode sys)) x
return $ sys return $ sys
{ psParts = x } { psParts = x }