diff --git a/examples/example03.hs b/examples/example03.hs index a50a4d3..53af30b 100644 --- a/examples/example03.hs +++ b/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 diff --git a/src/Affection.hs b/src/Affection.hs index 316f4db..343e16e 100644 --- a/src/Affection.hs +++ b/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 diff --git a/src/Affection/Particle.hs b/src/Affection/Particle.hs index c1a53fc..311048f 100644 --- a/src/Affection/Particle.hs +++ b/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 diff --git a/src/Affection/Types.hs b/src/Affection/Types.hs index 9d43022..c197961 100644 --- a/src/Affection/Types.hs +++ b/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 }