diff --git a/src/Affection/Particle.hs b/src/Affection/Particle.hs index cafb298..863e616 100644 --- a/src/Affection/Particle.hs +++ b/src/Affection/Particle.hs @@ -25,42 +25,48 @@ import Debug.Trace -- bother you. updateParticle :: Double - -- ^ Elapsed time in seconds - -> (Double -> Particle -> Affection us Particle) - -- ^ 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 = - do - now <- elapsedTime <$> get - if particleCreation pa + particleTimeToLive pa < now - then do + -- ^ Elapsed time in seconds + -> (Double -> Particle -> Affection us Particle) + -- ^ Update function for each 'Particle' + -> [Particle] + -- ^ List of 'Particle's to be processed + -> Affection us [Particle] + -- ^ processed 'Particle's +updateParticle time func l = + updateParticle' time func l + where + updateParticle' _ _ [] = return [] + updateParticle' dt fun [p] = do + now <- elapsedTime <$> get + 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 + 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 - (particleStackCont pa) + (particleStackCont p) "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 - else do - np <- Just <$> funct time pa - return $ np + maybe (return ()) (\(producer, padname) -> do + consumers <- liftIO $ G.gegl_node_get_consumers + (particleStackCont p) + "output" + liftIO $ mapM_ (\(node, inpad) -> G.gegl_node_connect_to + producer + padname + node + inpad + ) consumers + ) mproducer -- | Get the next living particle from a list nextLiving @@ -70,9 +76,6 @@ 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 ()) @@ -87,13 +90,9 @@ updateParticleSystem -> (G.GeglBuffer -> G.GeglNode -> Particle -> Affection us ()) -> Affection us ParticleSystem updateParticleSystem sys sec upd draw = do - !x <- catMaybes <$> mapM (updateParticle sec upd) (partStorList $ partSysParts sys) - -- liftIO $ traceIO $ show $ length x - -- x <- catMaybes <$> foldM (updateParticle sec upd) [] (reverse $ psParts sys) + !x <- updateParticle sec upd (partStorList $ partSysParts sys) if (not $ null x) 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) mapM_ (draw (partSysBuffer sys) (partSysNode sys)) x return sys @@ -119,10 +118,6 @@ insertParticle ps p = do now <- elapsedTime <$> get let newList = chronoInsert now (partStorList $ partSysParts ps) p 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 { partSysParts = (partSysParts ps) { partStorLatest = Just p