fixed routing

examples/example03.hs

@@ -75,7 +75,7 @@ load _ = do
   return $ UserData
     { nodeGraph = myMap
     , foreground = buffer
-    , partsys = ParticleSystem [] nop buffer
+    , partsys = ParticleSystem (ParticleStorage Nothing []) nop buffer
     }
 
 drawInit :: Affection UserData ()
@@ -138,29 +138,30 @@ update sec = do
           liftIO $ G.gegl_node_connect_to tempRect "output" tempOver "aux"
           -- traceM $ "position is: " ++ show x ++ " " ++ show y
           -- traceM $ "velocity is: " ++ show vx ++ " " ++ show vy
+          ips <- insertParticle (partsys ud) $
+            Particle
+              { particleTimeToLive = life
+              , particleCreation   = elapsedTime ad
+              , particlePosition   = (fromIntegral x, fromIntegral y)
+              , particleRotation   = Rad 0
+              , particleVelocity   = (vx, vy)
+              , particlePitchRate  = Rad 0
+              , particleRootNode   = tempRoot
+              , particleNodeGraph  = M.fromList
+                [ ("root", tempRoot)
+                , ("over", tempOver)
+                , ("rect", tempRect)
+                ]
+              , particleStackCont  = tempOver
+              , particleDrawFlange = tempOver
+              }
           putAffection $ ud
-            { partsys     = (partsys ud)
-                { psParts = (Particle
-                    { particleLife = life
-                    , particlePosition = (fromIntegral x, fromIntegral y)
-                    , particleRotation = Rad 0
-                    , particleVelocity = (vx, vy)
-                    , particlePitchRate = Rad 0
-                    , particleRootNode = tempRoot
-                    , particleNodeGraph = M.fromList
-                      [ ("root", tempRoot)
-                      , ("over", tempOver)
-                      , ("rect" , tempRect)
-                      ]
-                    , particleStackCont = tempOver
-                    , particleDrawFlange = tempOver
-                    }) : (psParts $ partsys ud)
-                }
+            { partsys = ips
             }
-          when (not $ null $ psParts $ partsys ud) $
-            liftIO $ G.gegl_node_link
-              tempOver
-              (particleStackCont $ head $ psParts $ partsys ud)
+          -- when (not $ null $ psParts $ partsys ud) $
+          --   liftIO $ G.gegl_node_link
+          --     tempOver
+          --     (particleStackCont $ head $ psParts $ partsys ud)
         else
           return ()
       SDL.WindowClosedEvent _ -> do

src/Affection.hs

@@ -65,6 +65,7 @@ withAffection AffectionConfig{..} = do
     , drawSurface     = surface
     , drawFormat      = format
     , drawStack       = []
+    , elapsedTime     = 0
     }) <$> loadState surface
   (_, nState) <- runStateT ( A.runState $ do
     preLoop
@@ -81,11 +82,14 @@ withAffection AffectionConfig{..} = do
         ad <- get
         -- clean draw requests from last run
         mapM_ (invalidateDrawRequest pixels stride cpp) $ drawStack ad
+        -- compute dt and update elapsedTime
+        let dt = (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) / (fromIntegral 10 ^ 9)
         put $ ad
-          { drawStack = [] }
+          { drawStack = []
+          , elapsedTime = elapsedTime ad + dt
+          }
         -- execute user defined update loop
-        updateLoop $ (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) /
-          (fromIntegral 10 ^ 9)
+        updateLoop dt
         -- execute user defined draw loop
         drawLoop
         -- handle all new draw requests

src/Affection/Particle.hs

@@ -5,11 +5,13 @@ module Affection.Particle
   ( updateParticle
   , drawParticles
   , updateParticleSystem
+  , insertParticle
   ) where
 
 import Affection.Types
 
 import Control.Monad
+import Control.Monad.State (get)
 
 import Data.Maybe
 
@@ -27,48 +29,67 @@ updateParticle
     -- ^ Update function for a single 'Particle'
     -- This Function should take the elapsed time
     -- in seconds and the initial particle as arguments.
-  -> [Maybe Particle]
+  -- -> [Maybe Particle]
   -> Particle
     -- ^ 'Particle' to be processed
-  -> Affection us [Maybe Particle]
+  -- -> Affection us [Maybe Particle]
+  -> Affection us (Maybe Particle)
     -- ^ resulting 'Particle'
-updateParticle time funct acc@[] pa =
-  if particleLife pa - time < 0
+updateParticle time funct pa = do
+  now <- elapsedTime <$> get
+  if particleCreation pa + particleTimeToLive pa < now
   then do
+    mproducer <- liftIO $ G.gegl_node_get_producer
+      (particleStackCont pa)
+      "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 : acc
+    return $ Nothing
   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
+    np <- Just <$> funct time pa
+    return $ np
+-- updateParticle time funct acc@[p] pa = do
+--   now <- elapsedTime <$> get
+--   if particleCreation pa + particleTimeToLive pa > now
+--   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
+--     return $ np : acc
+-- updateParticle time funct acc@(p:ps) pa = do
+--   now <- elapsedTime <$> get
+--   if particleCreation pa + particleTimeToLive pa > now
+--   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
+--     return $ np : acc
 
 -- | Get the next living particle from a list
 nextLiving
@@ -95,12 +116,53 @@ updateParticleSystem
   -> (G.GeglBuffer -> G.GeglNode -> Particle -> Affection us ())
   -> Affection us ParticleSystem
 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 <$> foldM (updateParticle sec upd) [] (reverse $ psParts sys)
+  x <- catMaybes <$> mapM (updateParticle sec upd) (partStorList $ partSysParts 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
+    liftIO $ G.gegl_node_link (particleStackCont $ last x) (partSysNode sys)
+  mapM_ (draw (partSysBuffer sys) (partSysNode sys)) x
   return $ sys
-    { psParts = x }
+    { partSysParts = (partSysParts sys)
+      { partStorList = x
+      , partStorLatest =
+          if null x
+          then Nothing
+          else partStorLatest (partSysParts sys)
+      }
+    }
+
+-- | Function for inserting a new 'Particle' into its 'PartileSystem'
+insertParticle
+  :: ParticleSystem -- ^ 'ParticleSystem' to insert into
+  -> Particle       -- ^ 'Particle' to insert
+  -> Affection us ParticleSystem -- ^ resulting new 'ParticleSystem'
+insertParticle ps p = do
+  now <- elapsedTime <$> get
+  let newList = chronoInsert now (partStorList $ partSysParts ps) p
+  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
+      , partStorList   = newList
+      }
+    }
+
+-- | Insert a 'Particle' into its chronologically ordered list
+chronoInsert
+  :: Double     -- ^ Time in seconds from beginning of program execution
+  -> [Particle] -- ^ List to insert to
+  -> Particle   -- ^ 'Particle' to insert
+  -> [Particle] -- ^ Resulting list
+chronoInsert now []       np = [np]
+chronoInsert now [p]      np =
+  if now + particleTimeToLive p < particleCreation np
+  then p : [np]
+  else np : [p]
+chronoInsert now l@(p:ps) np =
+  if now + particleTimeToLive p < particleCreation np
+  then p : chronoInsert now ps np
+  else np : l

src/Affection/Types.hs

@@ -19,6 +19,7 @@ module Affection.Types
     -- | Particle system
   , Particle(..)
   , ParticleSystem(..)
+  , ParticleStorage(..)
     -- | Convenience exports
   , liftIO
   , SDL.WindowConfig(..)
@@ -77,6 +78,7 @@ data AffectionData us = AffectionData
   , drawFormat      :: B.BablFormatPtr    -- ^ Target format
   , drawStack       :: [DrawRequest]      -- ^ Stack of 'DrawRequest's to be processed
   , clearStack      :: [DrawRequest]      -- ^ Stack of 'DrawRequest's to be invalidated
+  , elapsedTime     :: Double             -- ^ Elapsed time in seconds
   }
 
 -- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated
@@ -165,8 +167,10 @@ instance Eq Angle where
 
 -- | A single particle
 data Particle = Particle
-  { particleLife       :: Double
+  { particleTimeToLive :: Double
       -- ^ Time to live in seconds
+  , particleCreation   :: Double
+      -- ^ Creation time of particle in seconds form program start
   , particlePosition   :: (Double, Double)
       -- ^ Position of particle on canvas
   , particleRotation   :: Angle
@@ -185,8 +189,15 @@ data Particle = Particle
       -- ^ 'G.GeglNode' to connect draw actions to
   }
 
+-- | The particle system
 data ParticleSystem = ParticleSystem
-  { psParts  :: [Particle]
-  , psNode   :: G.GeglNode
-  , psBuffer :: G.GeglBuffer
+  { partSysParts  :: ParticleStorage
+  , partSysNode   :: G.GeglNode
+  , partSysBuffer :: G.GeglBuffer
+  }
+
+-- | The particle storage datatype
+data ParticleStorage = ParticleStorage
+  { partStorLatest :: Maybe Particle -- ^ The particle stored last
+  , partStorList   :: [Particle]     -- ^ List of particles in ascending order of remaining lifetime
   }