recursive particle update

This commit is contained in:
nek0 2017-03-14 20:10:47 +01:00
parent af271f85b2
commit 161ace0770

View file

@ -27,27 +27,38 @@ updateParticle
:: Double :: Double
-- ^ Elapsed time in seconds -- ^ Elapsed time in seconds
-> (Double -> Particle -> Affection us Particle) -> (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 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 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 mproducer <- liftIO $ G.gegl_node_get_producer
(particleStackCont pa) (particleStackCont p)
"input" "input"
case mproducer of maybe (return ()) (\(producer, padname) -> do
Just (producer, padname) -> do
consumers <- liftIO $ G.gegl_node_get_consumers consumers <- liftIO $ G.gegl_node_get_consumers
(particleStackCont pa) (particleStackCont p)
"output" "output"
liftIO $ mapM_ (\(node, inpad) -> G.gegl_node_connect_to liftIO $ mapM_ (\(node, inpad) -> G.gegl_node_connect_to
producer producer
@ -55,12 +66,7 @@ updateParticle time funct pa =
node node
inpad inpad
) consumers ) 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 -- | Get the next living particle from a list
nextLiving nextLiving
@ -70,9 +76,6 @@ nextLiving [] = Nothing
nextLiving acc = case catMaybes acc of nextLiving acc = case catMaybes acc of
[] -> Nothing [] -> Nothing
ps -> Just $ head $ ps ps -> Just $ head $ ps
-- if isNothing p
-- then nextLiving ps
-- else p
drawParticles drawParticles
:: (Particle -> Affection us ()) :: (Particle -> Affection us ())
@ -87,13 +90,9 @@ updateParticleSystem
-> (G.GeglBuffer -> G.GeglNode -> Particle -> Affection us ()) -> (G.GeglBuffer -> G.GeglNode -> Particle -> Affection us ())
-> Affection us ParticleSystem -> Affection us ParticleSystem
updateParticleSystem sys sec upd draw = do 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) if (not $ null x)
then do 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) liftIO $ G.gegl_node_link (particleStackCont $ head x) (partSysNode sys)
mapM_ (draw (partSysBuffer sys) (partSysNode sys)) x mapM_ (draw (partSysBuffer sys) (partSysNode sys)) x
return sys return sys
@ -119,10 +118,6 @@ insertParticle ps p = do
now <- elapsedTime <$> get now <- elapsedTime <$> get
let newList = chronoInsert now (partStorList $ partSysParts ps) p let newList = chronoInsert now (partStorList $ partSysParts ps) p
liftIO $ G.gegl_node_link_many (reverse $ map particleStackCont newList) 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 return $ ps
{ partSysParts = (partSysParts ps) { partSysParts = (partSysParts ps)
{ partStorLatest = Just p { partStorLatest = Just p