recursive particle update

src/Affection/Particle.hs

@@ -27,27 +27,38 @@ updateParticle
   :: Double
         -- ^ Elapsed time in seconds
   -> (Double -> Particle -> Affection us Particle)
-    -- ^ Update function for a single 'Particle'
+        -- ^ Update function for each 'Particle'
-    -- This Function should take the elapsed time
+  -> [Particle]
-    -- in seconds and the initial particle as arguments.
+        -- ^ List of 'Particle's to be processed
-  -- -> [Maybe Particle]
+  -> Affection us [Particle]
-  -> Particle
+        -- ^ processed 'Particle's
-    -- ^ 'Particle' to be processed
+updateParticle time func l =
-  -- -> Affection us [Maybe Particle]
+  updateParticle' time func l
-  -> Affection us (Maybe Particle)
+  where
-    -- ^ resulting 'Particle'
+    updateParticle' _  _   []     = return []
-updateParticle time funct pa =
+    updateParticle' dt fun [p]    = do
-  do
       now <- elapsedTime <$> get
-    if particleCreation pa + particleTimeToLive pa < now
+      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
+      maybe (return ()) (\(producer, padname) -> do
-        Just (producer, padname) -> do
         consumers <- liftIO $ G.gegl_node_get_consumers
-            (particleStackCont pa)
+          (particleStackCont p)
           "output"
         liftIO $ mapM_ (\(node, inpad) -> G.gegl_node_connect_to
           producer
@@ -55,12 +66,7 @@ updateParticle time funct pa =
           node
           inpad
           ) consumers
-        Nothing -> return ()
+        ) mproducer
-      liftIO $ G.gegl_node_drop $ particleRootNode pa
-      return $ Nothing
-    else do
-      np <- Just <$> funct time pa
-      return $ np
 
 -- | 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)
+  !x <- updateParticle sec upd (partStorList $ partSysParts sys)
-  -- liftIO $ traceIO $ show $ length x
-  -- x <- catMaybes <$> foldM (updateParticle sec upd) [] (reverse $ psParts 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