recursive particle update

src/Affection/Particle.hs

@@ -25,42 +25,48 @@ import Debug.Trace
 -- bother you.
 updateParticle
   :: Double
-    -- ^ Elapsed time in seconds
+        -- ^ Elapsed time in seconds
   -> (Double -> Particle -> Affection us Particle)
-    -- ^ 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 =
-  do
-    now <- elapsedTime <$> get
-    if particleCreation pa + particleTimeToLive pa < now
-    then do
+        -- ^ Update function for each 'Particle'
+  -> [Particle]
+        -- ^ List of 'Particle's to be processed
+  -> Affection us [Particle]
+        -- ^ processed 'Particle's
+updateParticle time func l =
+  updateParticle' time func l
+  where
+    updateParticle' _  _   []     = return []
+    updateParticle' dt fun [p]    = do
+      now <- elapsedTime <$> get
+      if particleCreation p + particleTimeToLive p < now
+      then
+        return []
+      else
+        return . (: []) =<< (func time p)
+    updateParticle' dt fun (p:ps) = do
+      now <- elapsedTime <$> get
+      if particleCreation p + particleTimeToLive p < now
+      then do
+        dropParticle p
+        updateParticle' dt fun ps
+      else do
+        np <- fun dt p
+        return . (np :) =<< updateParticle' dt fun ps
+    dropParticle p = do
       mproducer <- liftIO $ G.gegl_node_get_producer
-        (particleStackCont pa)
+        (particleStackCont p)
         "input"
-      case mproducer of
-        Just (producer, padname) -> do
-          consumers <- liftIO $ G.gegl_node_get_consumers
-            (particleStackCont pa)
-            "output"
-          liftIO $ mapM_ (\(node, inpad)-> G.gegl_node_connect_to
-            producer
-            padname
-            node
-            inpad
-            ) consumers
-        Nothing -> return ()
-      liftIO $ G.gegl_node_drop $ particleRootNode pa
-      return $ Nothing
-    else do
-      np <- Just <$> funct time pa
-      return $ np
+      maybe (return ()) (\(producer, padname) -> do
+        consumers <- liftIO $ G.gegl_node_get_consumers
+          (particleStackCont p)
+          "output"
+        liftIO $ mapM_ (\(node, inpad) -> G.gegl_node_connect_to
+          producer
+          padname
+          node
+          inpad
+          ) consumers
+        ) mproducer
 
 -- | Get the next living particle from a list
 nextLiving
@@ -70,9 +76,6 @@ 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 ())
@@ -87,13 +90,9 @@ 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)
-  -- liftIO $ traceIO $ show $ length x
-  -- x <- catMaybes <$> foldM (updateParticle sec upd) [] (reverse $ psParts sys)
+  !x <- updateParticle sec upd (partStorList $ partSysParts sys)
   if (not $ null x)
     then do
-      -- liftIO $ G.gegl_node_link_many $ map particleStackCont (partStorList $ partSysParts sys)
-      -- 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
@@ -119,10 +118,6 @@ insertParticle ps p = do
   now <- elapsedTime <$> get
   let newList = chronoInsert now (partStorList $ partSysParts ps) p
   liftIO $ G.gegl_node_link_many (reverse $ map particleStackCont newList)
-  -- when (not $ isNothing $ partStorLatest $ partSysParts ps) $ 
-  --   liftIO $ G.gegl_node_link
-  --     (particleStackCont p)
-  --     (particleStackCont $ fromJust $ partStorLatest $ partSysParts ps)
   return $ ps
     { partSysParts = (partSysParts ps)
       { partStorLatest = Just p