recursive particle update
This commit is contained in:
parent
af271f85b2
commit
161ace0770
1 changed files with 41 additions and 46 deletions
|
@ -25,42 +25,48 @@ import Debug.Trace
|
||||||
-- bother you.
|
-- bother you.
|
||||||
updateParticle
|
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 p + particleTimeToLive p < now
|
||||||
if particleCreation pa + particleTimeToLive pa < now
|
then
|
||||||
then do
|
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
|
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 p)
|
||||||
(particleStackCont pa)
|
"output"
|
||||||
"output"
|
liftIO $ mapM_ (\(node, inpad) -> G.gegl_node_connect_to
|
||||||
liftIO $ mapM_ (\(node, inpad)-> G.gegl_node_connect_to
|
producer
|
||||||
producer
|
padname
|
||||||
padname
|
node
|
||||||
node
|
inpad
|
||||||
inpad
|
) consumers
|
||||||
) consumers
|
) mproducer
|
||||||
Nothing -> return ()
|
|
||||||
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
|
||||||
|
|
Loading…
Reference in a new issue