From c6a37e80f71241ab59f50aeffa81e6e719d7dd5f Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 24 Dec 2016 08:27:47 +0100 Subject: [PATCH] link only when needed --- src/Affection/Particle.hs | 75 ++++++++++++++++++++++++++++----------- 1 file changed, 54 insertions(+), 21 deletions(-) diff --git a/src/Affection/Particle.hs b/src/Affection/Particle.hs index 5a5d45d..c1a53fc 100644 --- a/src/Affection/Particle.hs +++ b/src/Affection/Particle.hs @@ -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 }