link only when needed

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
+    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
   :: (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)
+  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
   return $ sys
     { psParts = x }