a little lint

This commit is contained in:
nek0 2017-03-14 22:18:39 +01:00
parent 161ace0770
commit 5d8c5d807c

View file

@ -1,4 +1,3 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
-- | This module introduces a simple particle system to Affection -- | This module introduces a simple particle system to Affection
@ -42,7 +41,7 @@ updateParticle time func l =
then then
return [] return []
else else
return . (: []) =<< (func time p) (: []) <$> func time p
updateParticle' dt fun (p:ps) = do updateParticle' dt fun (p:ps) = do
now <- elapsedTime <$> get now <- elapsedTime <$> get
if particleCreation p + particleTimeToLive p < now if particleCreation p + particleTimeToLive p < now
@ -51,7 +50,7 @@ updateParticle time func l =
updateParticle' dt fun ps updateParticle' dt fun ps
else do else do
np <- fun dt p np <- fun dt p
return . (np :) =<< updateParticle' dt fun ps (np :) <$> updateParticle' dt fun ps
dropParticle p = do dropParticle p = do
mproducer <- liftIO $ G.gegl_node_get_producer mproducer <- liftIO $ G.gegl_node_get_producer
(particleStackCont p) (particleStackCont p)
@ -60,11 +59,9 @@ updateParticle time func l =
consumers <- liftIO $ G.gegl_node_get_consumers consumers <- liftIO $ G.gegl_node_get_consumers
(particleStackCont p) (particleStackCont p)
"output" "output"
liftIO $ mapM_ (\(node, inpad) -> G.gegl_node_connect_to liftIO $ mapM_ (uncurry $ G.gegl_node_connect_to
producer producer
padname padname
node
inpad
) consumers ) consumers
) mproducer ) mproducer
@ -75,7 +72,7 @@ nextLiving
nextLiving [] = Nothing nextLiving [] = Nothing
nextLiving acc = case catMaybes acc of nextLiving acc = case catMaybes acc of
[] -> Nothing [] -> Nothing
ps -> Just $ head $ ps ps -> Just $ head ps
drawParticles drawParticles
:: (Particle -> Affection us ()) :: (Particle -> Affection us ())
@ -91,7 +88,7 @@ updateParticleSystem
-> Affection us ParticleSystem -> Affection us ParticleSystem
updateParticleSystem sys sec upd draw = do updateParticleSystem sys sec upd draw = do
!x <- updateParticle sec upd (partStorList $ partSysParts sys) !x <- updateParticle sec upd (partStorList $ partSysParts sys)
if (not $ null x) if not $ null x
then do then do
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
@ -118,7 +115,7 @@ 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)
return $ ps return ps
{ partSysParts = (partSysParts ps) { partSysParts = (partSysParts ps)
{ partStorLatest = Just p { partStorLatest = Just p
, partStorList = newList , partStorList = newList