diff --git a/src/Affection/Particle.hs b/src/Affection/Particle.hs index 9c4b85a..8743234 100644 --- a/src/Affection/Particle.hs +++ b/src/Affection/Particle.hs @@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE BangPatterns #-} -- | This module introduces a simple particle system to Affection module Affection.Particle @@ -116,7 +117,7 @@ updateParticleSystem -> (G.GeglBuffer -> G.GeglNode -> Particle -> Affection us ()) -> Affection us ParticleSystem updateParticleSystem sys sec upd draw = do - x <- catMaybes <$> mapM (updateParticle sec upd) (partStorList $ partSysParts sys) + !x <- catMaybes <$> mapM (updateParticle sec upd) (partStorList $ partSysParts sys) -- liftIO $ traceIO $ show $ length x -- x <- catMaybes <$> foldM (updateParticle sec upd) [] (reverse $ psParts sys) if (not $ null x) @@ -125,17 +126,19 @@ updateParticleSystem sys sec upd draw = do -- liftIO $ traceIO "linking last node to output" liftIO $ G.gegl_node_link (particleStackCont $ head x) (partSysNode sys) mapM_ (draw (partSysBuffer sys) (partSysNode sys)) x - return $ sys + return sys { partSysParts = (partSysParts sys) { partStorList = x - , partStorLatest = - if null x - then Nothing - else partStorLatest (partSysParts sys) } } - else + else do + _ <- liftIO $ G.gegl_node_disconnect (partSysNode sys) "input" return sys + { partSysParts = ParticleStorage + { partStorList = [] + , partStorLatest = Nothing + } + } -- | Function for inserting a new 'Particle' into its 'PartileSystem' insertParticle