link only when needed
This commit is contained in:
parent
b75f20c3d5
commit
c6a37e80f7
1 changed files with 54 additions and 21 deletions
|
@ -15,6 +15,8 @@ import Data.Maybe
|
|||
|
||||
import qualified GEGL as G
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
-- This function updates particles through a specified function. Particle ageing
|
||||
-- and death is being handled by 'updateParticles' itself and does not need to
|
||||
-- bother you.
|
||||
|
@ -25,31 +27,60 @@ updateParticle
|
|||
-- ^ Update function for a single 'Particle'
|
||||
-- This Function should take the elapsed time
|
||||
-- in seconds and the initial particle as arguments.
|
||||
-> [Maybe Particle]
|
||||
-> Particle
|
||||
-- ^ 'Particle' to be processed
|
||||
-> Affection us (Maybe Particle)
|
||||
-> Affection us [Maybe Particle]
|
||||
-- ^ resulting 'Particle'
|
||||
updateParticle time funct pa =
|
||||
updateParticle time funct acc@[] pa =
|
||||
if particleLife pa - time < 0
|
||||
then do
|
||||
liftIO $ G.gegl_node_drop $ particleRootNode pa
|
||||
return $ Nothing
|
||||
else
|
||||
Just <$> funct time pa { particleLife = particleLife pa - time }
|
||||
-- updateParticle time funct acc@[p] pa =
|
||||
-- if particleLife pa - time < 0
|
||||
-- then do
|
||||
-- G.gegl_node_drop $ particleRootNode pa
|
||||
-- return $ Nothing : acc
|
||||
-- else
|
||||
-- return $ (Just $ funct time $ pa { particleLife = particleLife pa - time }) : acc
|
||||
-- updateParticle time funct acc@(p:ps) pa =
|
||||
-- if particleLife pa - time < 0
|
||||
-- then do
|
||||
-- G.gegl_node_drop $ particleRootNode pa
|
||||
-- return $ Nothing : acc
|
||||
-- else
|
||||
-- return $ (Just $ funct time $ pa { particleLife = particleLife pa - time }) : acc
|
||||
return $ Nothing : acc
|
||||
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
|
||||
|
||||
-- | Get the next living particle from a list
|
||||
nextLiving
|
||||
:: [Maybe Particle]
|
||||
-> Maybe Particle
|
||||
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 ())
|
||||
|
@ -66,8 +97,10 @@ updateParticleSystem
|
|||
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 <$> mapM (updateParticle sec upd) (psParts sys)
|
||||
liftIO $ G.gegl_node_link_many $ map particleStackCont x ++ [psNode 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
|
||||
return $ sys
|
||||
{ psParts = x }
|
||||
|
|
Loading…
Reference in a new issue