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 _ = return ()
partUpd :: Double -> Particle -> Particle
partUpd sec p@Particle{..} =
p
partUpd :: Double -> Particle -> Affection UserData Particle
partUpd sec p@Particle{..} = do
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)
}
where
newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity)
newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity)
partDraw :: G.GeglBuffer -> G.GeglNode -> Particle -> Affection UserData ()
partDraw buf node Particle{..} = do
ud <- getAffection
drawRect'
particleDrawFlange
(G.RGBA 1 0 0 0.5)
(Fill)
(G.GeglRectangle ((floor $ fst particlePosition) - 10) ((floor $ snd particlePosition) -10) 20 20)
present
(G.GeglRectangle (floor $ fst particlePosition - 10) (floor $ snd particlePosition - 10) 20 20)
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
, handleDrawRequest
, invalidateDrawRequest
-- , present
, present
, clearArea
) where
@ -89,7 +89,20 @@ drawRect' node color Fill rect@GeglRectangle{..} buf = do
diw <- liftIO $ G.gegl_node_connect_to opNode "output" node "input"
unless diw $ error "Affection.Draw.drawRect': connect failed"
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
@ -168,8 +181,11 @@ invalidateDrawRequest pixels stride cpp dr@DrawRequest{..} = do
stride
G.GeglAbyssNone
liftIO $ SDL.unlockSurface surf
let Kill victim = requestPersist
liftIO $ G.gegl_node_drop victim
case requestPersist of
Kill (Just victim) ->
liftIO $ G.gegl_node_drop victim
_ ->
return ()
-- liftIO $ SDL.updateWindowSurface $ drawWindow ad
-- | 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
-- bother you.
updateParticle
:: Double -- ^ Elapsed time in seconds
-> (Double -> Particle -> Particle) -- ^ Update function for a single 'Particle'
-- This Function should take the elapsed time
-- in seconds and the initial particle as arguments.
-> Particle -- ^ 'Particle' to be processed
-> IO (Maybe Particle) -- ^ resulting 'Particle'
:: 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.
-> Particle
-- ^ 'Particle' to be processed
-> Affection us (Maybe Particle)
-- ^ resulting 'Particle'
updateParticle time funct pa =
if particleLife pa - time < 0
then do
G.gegl_node_drop $ particleRootNode pa
liftIO $ G.gegl_node_drop $ particleRootNode pa
return $ Nothing
else
return $ Just $ funct time $ pa { particleLife = particleLife pa - time }
Just <$> funct time pa { particleLife = particleLife pa - time }
-- updateParticle time funct acc@[p] pa =
-- if particleLife pa - time < 0
-- then do
@ -56,13 +60,13 @@ drawParticles = mapM_
updateParticleSystem
:: ParticleSystem
-> Double
-> (Double -> Particle -> Particle)
-> (Double -> Particle -> Affection us Particle)
-> (G.GeglBuffer -> G.GeglNode -> Particle -> Affection us ())
-> Affection us ParticleSystem
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 <- 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]
mapM_ (draw (psBuffer sys) (psNode sys)) x
return $ sys

View file

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