fixing leak in partUpd

This commit is contained in:
nek0 2017-02-25 17:23:54 +01:00
parent 46f51d1334
commit 767643a1af

View file

@ -1,4 +1,5 @@
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BangPatterns #-}
import Affection import Affection
import qualified SDL import qualified SDL
@ -173,23 +174,22 @@ update sec evs = do
return () return ()
) evs ) evs
ud2 <- getAffection ud2 <- getAffection
nps <- updateParticleSystem (partsys ud2) sec partUpd partDraw !nps <- updateParticleSystem (partsys ud2) sec partUpd partDraw
putAffection $ ud2 { partsys = nps } putAffection $ ud2 { partsys = nps }
clean :: UserData -> IO () clean :: UserData -> IO ()
clean _ = return () clean _ = return ()
partUpd :: Double -> Particle -> Affection UserData Particle partUpd :: Double -> Particle -> Affection UserData Particle
partUpd sec p@Particle{..} = do partUpd sec p = do
let newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity) let !newX = (fst $ particlePosition p) + sec * (fromIntegral $ fst $ particleVelocity p)
newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity) !newY = (snd $ particlePosition p) + sec * (fromIntegral $ snd $ particleVelocity p)
liftIO $ G.gegl_node_set (particleNodeGraph M.! "rect") $ G.Operation "gegl:rectangle" liftIO $ G.gegl_node_set (particleNodeGraph p M.! "rect") $ G.Operation "gegl:rectangle"
[ G.Property "x" $ G.PropertyDouble $ newX - 10 [ G.Property "x" $ G.PropertyDouble $ newX - 10
, G.Property "y" $ G.PropertyDouble $ newY - 10 , G.Property "y" $ G.PropertyDouble $ newY - 10
] ]
return p let !np = p {particlePosition = (newX, newY)}
{ particlePosition = (newX, newY) return np
}
partDraw :: G.GeglBuffer -> G.GeglNode -> Particle -> Affection UserData () partDraw :: G.GeglBuffer -> G.GeglNode -> Particle -> Affection UserData ()
partDraw buf node Particle{..} = do partDraw buf node Particle{..} = do