make it work!

This commit is contained in:
nek0 2016-12-24 01:13:00 +01:00
parent ee1200b597
commit d5bf09919c
4 changed files with 54 additions and 27 deletions

View file

@ -171,21 +171,28 @@ update sec = do
clean :: UserData -> IO () clean :: UserData -> IO ()
clean _ = return () clean _ = return ()
partUpd :: Double -> Particle -> Particle partUpd :: Double -> Particle -> Affection UserData Particle
partUpd sec p@Particle{..} = partUpd sec p@Particle{..} = do
p let newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity)
newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity)
liftIO $ G.gegl_node_set (particleNodeGraph M.! "rect") $ G.Operation "gegl:rectangle"
[ G.Property "x" $ G.PropertyDouble $ newX - 10
, G.Property "y" $ G.PropertyDouble $ newY - 10
]
return p
{ particlePosition = (newX, newY) { particlePosition = (newX, newY)
} }
where
newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity)
newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity)
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
ud <- getAffection present
drawRect' (G.GeglRectangle (floor $ fst particlePosition - 10) (floor $ snd particlePosition - 10) 20 20)
particleDrawFlange
(G.RGBA 1 0 0 0.5)
(Fill)
(G.GeglRectangle ((floor $ fst particlePosition) - 10) ((floor $ snd particlePosition) -10) 20 20)
buf buf
False
-- ud <- getAffection
-- drawRect'
-- particleDrawFlange
-- (G.RGBA 1 0 0 0.5)
-- (Fill)
-- (G.GeglRectangle ((floor $ fst particlePosition) - 10) ((floor $ snd particlePosition) -10) 20 20)
-- buf

View file

@ -8,7 +8,7 @@ module Affection.Draw
-- , clear -- , clear
, handleDrawRequest , handleDrawRequest
, invalidateDrawRequest , invalidateDrawRequest
-- , present , present
, clearArea , clearArea
) where ) where
@ -89,7 +89,20 @@ drawRect' node color Fill rect@GeglRectangle{..} buf = do
diw <- liftIO $ G.gegl_node_connect_to opNode "output" node "input" diw <- liftIO $ G.gegl_node_connect_to opNode "output" node "input"
unless diw $ error "Affection.Draw.drawRect': connect failed" unless diw $ error "Affection.Draw.drawRect': connect failed"
put $ ad put $ ad
{ drawStack = (DrawRequest rect buf (Kill tempRoot)) : drawStack ad { drawStack = (DrawRequest rect buf (Kill (Just tempRoot))) : drawStack ad
}
-- | Force update of a specific region on screen
present
:: G.GeglRectangle -- ^ Area to be updated
-> G.GeglBuffer -- ^ Target buffer
-> Bool -- ^ Shall the 'DrawRequest' persist?
-> Affection us ()
present rect buf kill = do
ad <- get
let k = if not kill then Kill Nothing else Yes
put ad
{ drawStack = (DrawRequest rect buf k) : drawStack ad
} }
-- -- | force a blit of a specified area. Do not use often as it slows down the program -- -- | force a blit of a specified area. Do not use often as it slows down the program
@ -168,8 +181,11 @@ invalidateDrawRequest pixels stride cpp dr@DrawRequest{..} = do
stride stride
G.GeglAbyssNone G.GeglAbyssNone
liftIO $ SDL.unlockSurface surf liftIO $ SDL.unlockSurface surf
let Kill victim = requestPersist case requestPersist of
liftIO $ G.gegl_node_drop victim Kill (Just victim) ->
liftIO $ G.gegl_node_drop victim
_ ->
return ()
-- liftIO $ SDL.updateWindowSurface $ drawWindow ad -- liftIO $ SDL.updateWindowSurface $ drawWindow ad
-- | compute color for a single pixel -- | compute color for a single pixel

View file

@ -19,19 +19,23 @@ import qualified GEGL as G
-- and death is being handled by 'updateParticles' itself and does not need to -- and death is being handled by 'updateParticles' itself and does not need to
-- bother you. -- bother you.
updateParticle updateParticle
:: Double -- ^ Elapsed time in seconds :: Double
-> (Double -> Particle -> Particle) -- ^ Update function for a single 'Particle' -- ^ Elapsed time in seconds
-- This Function should take the elapsed time -> (Double -> Particle -> Affection us Particle)
-- in seconds and the initial particle as arguments. -- ^ Update function for a single 'Particle'
-> Particle -- ^ 'Particle' to be processed -- This Function should take the elapsed time
-> IO (Maybe Particle) -- ^ resulting 'Particle' -- in seconds and the initial particle as arguments.
-> Particle
-- ^ 'Particle' to be processed
-> Affection us (Maybe Particle)
-- ^ resulting 'Particle'
updateParticle time funct pa = updateParticle time funct pa =
if particleLife pa - time < 0 if particleLife pa - time < 0
then do then do
G.gegl_node_drop $ particleRootNode pa liftIO $ G.gegl_node_drop $ particleRootNode pa
return $ Nothing return $ Nothing
else else
return $ Just $ funct time $ pa { particleLife = particleLife pa - time } Just <$> funct time pa { particleLife = particleLife pa - time }
-- updateParticle time funct acc@[p] pa = -- updateParticle time funct acc@[p] pa =
-- if particleLife pa - time < 0 -- if particleLife pa - time < 0
-- then do -- then do
@ -56,13 +60,13 @@ drawParticles = mapM_
updateParticleSystem updateParticleSystem
:: ParticleSystem :: ParticleSystem
-> Double -> Double
-> (Double -> Particle -> Particle) -> (Double -> Particle -> Affection us Particle)
-> (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
-- let x = catMaybes <$> mapM (updateParticle sec upd) (psParts sys) -- let x = catMaybes <$> mapM (updateParticle sec upd) (psParts sys)
-- x <- liftIO $ catMaybes <$> foldM (updateParticle sec upd) [] (psParts sys) -- x <- liftIO $ catMaybes <$> foldM (updateParticle sec upd) [] (psParts sys)
x <- liftIO $ catMaybes <$> mapM (updateParticle sec upd) (psParts sys) x <- catMaybes <$> mapM (updateParticle sec upd) (psParts sys)
liftIO $ G.gegl_node_link_many $ map particleStackCont x ++ [psNode sys] liftIO $ G.gegl_node_link_many $ map particleStackCont x ++ [psNode sys]
mapM_ (draw (psBuffer sys) (psNode sys)) x mapM_ (draw (psBuffer sys) (psNode sys)) x
return $ sys return $ sys

View file

@ -88,7 +88,7 @@ data DrawRequest = DrawRequest
data RequestPersist data RequestPersist
= Yes = Yes
| Kill G.GeglNode | Kill (Maybe G.GeglNode)
-- | A type for storing 'DrawRequest' results to be executed frequently. TODO -- | A type for storing 'DrawRequest' results to be executed frequently. TODO
data DrawAsset = DrawAsset data DrawAsset = DrawAsset