affection 0.0.0.5 → 0.0.0.6
raw patch · 13 files changed
+644/−306 lines, 13 filesdep +monad-paralleldep ~basenew-component:exe:example02.1
Dependencies added: monad-parallel
Dependency ranges changed: base
Files
- affection.cabal +21/−1
- examples/example00.hs +18/−12
- examples/example01.hs +27/−23
- examples/example02.1.hs +169/−0
- examples/example02.hs +76/−60
- examples/example03.hs +99/−105
- src/Affection.hs +32/−9
- src/Affection/Actor.hs +12/−0
- src/Affection/Draw.hs +52/−39
- src/Affection/MouseInteractable.hs +22/−0
- src/Affection/Particle.hs +62/−55
- src/Affection/Property.hs +46/−0
- src/Affection/Types.hs +8/−2
affection.cabal view
@@ -6,7 +6,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.0.0.5+version: 0.0.0.6 synopsis: A simple Game Engine using SDL description: This package contains Affection, a simple game engine written in Haskell using SDL and GEGL.@@ -41,6 +41,8 @@ , Affection.Types , Affection.StateMachine , Affection.MouseInteractable+ , Affection.Property+ , Affection.Actor default-extensions: OverloadedStrings -- Modules included in this library but not exported.@@ -63,6 +65,7 @@ , gegl , babl , monad-loops+ , monad-parallel , containers , clock , glib@@ -105,6 +108,23 @@ executable example02 hs-source-dirs: examples main-is: example02.hs+ ghc-options: -threaded -Wall+ default-language: Haskell2010+ default-extensions: OverloadedStrings+ if flag(examples)+ build-depends: base+ , affection+ , sdl2+ , gegl+ , babl+ , containers+ , mtl+ else+ buildable: False++executable example02.1+ hs-source-dirs: examples+ main-is: example02.1.hs ghc-options: -threaded -Wall default-language: Haskell2010 default-extensions: OverloadedStrings
examples/example00.hs view
@@ -29,8 +29,9 @@ , windowTitle = "Affection: example00" , windowConfig = SDL.defaultWindow , preLoop = return ()- , drawLoop = draw+ , eventLoop = handle , updateLoop = update+ , drawLoop = draw , loadState = load , cleanUp = clean }@@ -45,18 +46,18 @@ traceM "loading" root <- G.gegl_node_new traceM "new root node"- checkerboard <- G.gegl_node_new_child root $ G.checkerboardOperation- [ G.Property "color1" $ G.PropertyColor $ G.RGBA 0.4 0.4 0.4 1- , G.Property "color2" $ G.PropertyColor $ G.RGBA 0.6 0.6 0.6 1- ]+ checkerboard <- G.gegl_node_new_child root $ G.checkerboardOperation $+ props $ do+ prop "color1" $ G.RGBA 0.4 0.4 0.4 1+ prop "color2" $ G.RGBA 0.6 0.6 0.6 1 traceM "checkerboard" over <- G.gegl_node_new_child root G.defaultOverOperation traceM "over"- text <- G.gegl_node_new_child root $ G.textOperation- [ G.Property "string" $ G.PropertyString "Hello world!"- , G.Property "color" $ G.PropertyColor $ G.RGBA 0 0 1 0.5- , G.Property "size" $ G.PropertyDouble 40- ]+ text <- G.gegl_node_new_child root $ G.textOperation $+ props $ do+ prop "string" ("Hello world!"::String)+ prop "color" $ G.RGBA 0 0 1 0.5+ prop "size" (40::Int) traceM "text" G.gegl_node_link checkerboard over G.gegl_node_connect_to text "output" over "aux"@@ -96,11 +97,16 @@ liftIO $ SDL.unlockSurface drawSurface liftIO $ SDL.updateWindowSurface drawWindow -update :: Double -> [SDL.Event] -> Affection UserData ()-update sec _ = do+handle :: SDL.EventPayload -> Affection UserData ()+handle = const $ return ()++update :: Affection UserData ()+update = do traceM "updating" ad <- get ud@UserData{..} <- getAffection++ sec <- getDelta traceM $ (show $ 1 / sec) ++ " FPS" when (elapsedTime ad > 5) $ put $ ad
examples/example01.hs view
@@ -29,8 +29,9 @@ , windowTitle = "Affection: example00" , windowConfig = SDL.defaultWindow , preLoop = return ()- , drawLoop = draw+ , eventLoop = const $ return () , updateLoop = update+ , drawLoop = draw , loadState = load , cleanUp = clean }@@ -39,6 +40,7 @@ data UserData = UserData { nodeGraph :: M.Map String G.GeglNode , foreground :: G.GeglBuffer+ -- , lastTick :: Double } load :: SDL.Surface -> IO UserData@@ -46,25 +48,25 @@ traceM "loading" root <- G.gegl_node_new traceM "new root node"- checkerboard <- G.gegl_node_new_child root $ G.checkerboardOperation- [ G.Property "color1" $ G.PropertyColor $ G.RGBA 0.4 0.4 0.4 1- , G.Property "color2" $ G.PropertyColor $ G.RGBA 0.6 0.6 0.6 1- ]+ checkerboard <- G.gegl_node_new_child root $ G.checkerboardOperation $+ props $ do+ prop "color1" $ G.RGBA 0.4 0.4 0.4 1+ prop "color2" $ G.RGBA 0.6 0.6 0.6 1 traceM "checkerboard" over <- G.gegl_node_new_child root G.defaultOverOperation traceM "over" buffer <- G.gegl_buffer_new (Just $ G.GeglRectangle 0 0 800 600) =<< B.babl_format (B.PixelFormat B.RGBA B.CFfloat)- sink <- G.gegl_node_new_child root $ G.Operation "gegl:copy-buffer"- [ G.Property "buffer" $ G.PropertyBuffer buffer- ]+ sink <- G.gegl_node_new_child root $ G.Operation "gegl:copy-buffer" $+ props $+ prop "buffer" buffer traceM "buffer-source" nop <- G.gegl_node_new_child root $ G.Operation "gegl:nop" [] traceM "nop"- crop <- G.gegl_node_new_child root $ G.Operation "gegl:crop"- [ G.Property "width" $ G.PropertyDouble 800- , G.Property "height" $ G.PropertyDouble 600- ]+ crop <- G.gegl_node_new_child root $ G.Operation "gegl:crop" $+ props $ do+ prop "width" (800::Double)+ prop "height" (600.0::Double) G.gegl_node_link_many [checkerboard, over, crop, sink] G.gegl_node_connect_to nop "output" over "aux" traceM "connections made"@@ -80,6 +82,7 @@ return $ UserData { nodeGraph = myMap , foreground = buffer+ -- , lastTick = 0 } draw :: Affection UserData ()@@ -87,19 +90,20 @@ traceM "drawing" UserData{..} <- getAffection drawRect (nodeGraph M.! "nop") (G.RGB 1 0 0) Fill (G.GeglRectangle 10 10 500 500) foreground- liftIO $ G.gegl_node_process $ nodeGraph M.! "sink"+ process $ nodeGraph M.! "sink" -update :: Double -> [SDL.Event] -> Affection UserData ()-update sec _ = do+update :: Affection UserData ()+update = do traceM "updating"- -- liftIO $ delaySec 5- ad <- get- ud@UserData{..} <- getAffection- traceM $ (show $ 1 / sec) ++ " FPS"- when (elapsedTime ad > 20) $- put $ ad- { quitEvent = True- }+ ud <- getAffection+ -- let last = lastTick ud+ -- tick <- getTick+ -- putAffection $ ud { lastTick = tick }+ dt <- getDelta+ traceM $ (show $ 1 / dt) ++ " FPS"+ elapsed <- getElapsedTime+ when (elapsed > 20) $+ quit clean :: UserData -> IO () clean _ = return ()
+ examples/example02.1.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE RecordWildCards #-}++import Affection+import qualified SDL+import qualified GEGL as G+import qualified BABL as B+import qualified Data.Map.Strict as M++import Debug.Trace++main :: IO ()+main = do+ conf <- return $ AffectionConfig+ { initComponents = All+ , windowTitle = "Affection: example00"+ , windowConfig = SDL.defaultWindow+ , preLoop = return ()+ , eventLoop = handle+ , updateLoop = update+ , drawLoop = draw+ , loadState = load+ , cleanUp = clean+ }+ withAffection conf++data UserData = UserData+ -- { nodeGraph :: M.Map String G.GeglNode+ -- , foreground :: G.GeglBuffer+ -- , lastTick :: Double+ -- }+ { coordinates :: (Double, Double)+ , lastTick :: Double+ }++load :: SDL.Surface -> IO UserData+load _ = do+ -- traceM "loading"+ -- root <- G.gegl_node_new+ -- traceM "new root node"+ -- checkerboard <- G.gegl_node_new_child root $ G.checkerboardOperation $+ -- props $ do+ -- prop "color1" $ G.RGBA 0.4 0.4 0.4 1+ -- prop "color2" $ G.RGBA 0.6 0.6 0.6 1+ -- traceM "checkerboard"+ -- over <- G.gegl_node_new_child root G.defaultOverOperation+ -- traceM "over"+ -- buffer <- G.gegl_buffer_new (Just $ G.GeglRectangle 0 0 800 600) =<<+ -- B.babl_format (B.PixelFormat B.RGBA B.CFfloat)+ -- sink <- G.gegl_node_new_child root $ G.Operation "gegl:copy-buffer" $+ -- props $+ -- prop "buffer" buffer+ -- traceM "buffer-sink"+ -- rect <- G.gegl_node_new_child root $ G.Operation "gegl:rectangle" $+ -- props $ do+ -- prop "x" (0::Double)+ -- prop "y" (0::Double)+ -- prop "width" (20::Double)+ -- prop "height" (20::Double)+ -- prop "color" $ G.RGBA 1 0 0 0.5+ -- traceM "rect"+ -- crop <- G.gegl_node_new_child root $ G.Operation "gegl:crop" $+ -- props $ do+ -- prop "width" (800::Double)+ -- prop "height" (600::Double)+ -- G.gegl_node_link_many [checkerboard, over, crop, sink]+ -- _ <- G.gegl_node_connect_to rect "output" over "aux"+ -- traceM "connections made"+ -- myMap <- return $ M.fromList+ -- [ ("root" , root)+ -- , ("over" , over)+ -- , ("background" , checkerboard)+ -- , ("sink" , sink)+ -- , ("rect" , rect)+ -- , ("crop" , crop)+ -- ]+ -- traceM "loading complete"+ -- return $ UserData+ -- { nodeGraph = myMap+ -- , foreground = buffer+ -- , lastTick = 0+ -- }+ return $ UserData+ { coordinates = (400, 300)+ , lastTick = 0+ }++-- drawInit :: Affection UserData ()+-- drawInit = do+-- UserData{..} <- getAffection+-- present (GeglRectangle 0 0 800 600) foreground True++draw :: Affection UserData ()+draw = do+ UserData{..} <- getAffection+ traceM "loading"+ root <- liftIO $ G.gegl_node_new+ traceM "new root node"+ checkerboard <- liftIO $ G.gegl_node_new_child root $ G.checkerboardOperation $+ props $ do+ prop "color1" $ G.RGBA 0.4 0.4 0.4 1+ prop "color2" $ G.RGBA 0.6 0.6 0.6 1+ traceM "checkerboard"+ over <- liftIO $ G.gegl_node_new_child root G.defaultOverOperation+ traceM "over"+ buffer <- liftIO $ G.gegl_buffer_new (Just $ G.GeglRectangle 0 0 800 600) =<<+ B.babl_format (B.PixelFormat B.RGBA B.CFfloat)+ sink <- liftIO $ G.gegl_node_new_child root $ G.Operation "gegl:copy-buffer" $+ props $+ prop "buffer" buffer+ traceM "buffer-sink"+ rect <- liftIO $ G.gegl_node_new_child root $ G.Operation "gegl:rectangle" $+ props $ do+ prop "x" $ fst coordinates+ prop "y" $ snd coordinates+ prop "width" (20::Double)+ prop "height" (20::Double)+ prop "color" $ G.RGBA 1 0 0 0.5+ traceM "rect"+ crop <- liftIO $ G.gegl_node_new_child root $ G.Operation "gegl:crop" $+ props $ do+ prop "width" (800::Double)+ prop "height" (600::Double)+ liftIO $ G.gegl_node_link_many [checkerboard, over, crop, sink]+ _ <- liftIO $ G.gegl_node_connect_to rect "output" over "aux"+ traceM "connections made"+ myMap <- return $ M.fromList+ [ ("root" , root)+ , ("over" , over)+ , ("background" , checkerboard)+ , ("sink" , sink)+ , ("rect" , rect)+ , ("crop" , crop)+ ]+ traceM "loading complete"+ process (myMap M.! "sink")+ present (GeglRectangle 0 0 800 600) buffer True++update :: Affection UserData ()+update = do+ traceM "updating"++ tick <- getElapsedTime+ ud <- getAffection+ putAffection $ ud { lastTick = tick }++ let dt = tick - lastTick ud+ return ()+ traceM $ (show $ 1 / dt) ++ " FPS"++handle (SDL.MouseMotionEvent dat) = do+ let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat+ ud <- getAffection+ putAffection ud+ { coordinates = (fromIntegral (x - 10), fromIntegral (y - 10))+ }+ -- liftIO $ G.gegl_node_set (nodeGraph ud M.! "rect") $ G.Operation "" $+ -- props $ do+ -- prop "x" (fromIntegral (x - 10) :: Double)+ -- prop "y" $ (fromIntegral (y - 10) :: Double)++handle (SDL.WindowClosedEvent _) = do+ traceM "seeya!"+ quit++handle _ =+ return ()++clean :: UserData -> IO ()+clean _ = return ()
examples/example02.hs view
@@ -3,25 +3,21 @@ import Affection import qualified SDL import qualified GEGL as G-import qualified GEGL.FFI.Buffer as G import qualified BABL as B import qualified Data.Map.Strict as M -import Foreign.C.Types-import Foreign.Marshal.Utils (new)-import Foreign.Ptr (castPtr)- import Debug.Trace main :: IO () main = do- conf <- return $ AffectionConfig+ conf <- return AffectionConfig { initComponents = All , windowTitle = "Affection: example00" , windowConfig = SDL.defaultWindow , preLoop = return ()- , drawLoop = draw+ , eventLoop = handle , updateLoop = update+ , drawLoop = draw , loadState = load , cleanUp = clean }@@ -29,8 +25,9 @@ data UserData = UserData { nodeGraph :: M.Map String G.GeglNode+ , actors :: M.Map String Actor , foreground :: G.GeglBuffer- , coordinates :: Maybe (Int, Int)+ , lastTick :: Double } load :: SDL.Surface -> IO UserData@@ -38,88 +35,107 @@ traceM "loading" root <- G.gegl_node_new traceM "new root node"- checkerboard <- G.gegl_node_new_child root $ G.checkerboardOperation- [ G.Property "color1" $ G.PropertyColor $ G.RGBA 0.4 0.4 0.4 1- , G.Property "color2" $ G.PropertyColor $ G.RGBA 0.6 0.6 0.6 1- ]+ checkerboard <- G.gegl_node_new_child root $ G.checkerboardOperation $+ props $ do+ prop "color1" $ G.RGBA 0.4 0.4 0.4 1+ prop "color2" $ G.RGBA 0.6 0.6 0.6 1 traceM "checkerboard" over <- G.gegl_node_new_child root G.defaultOverOperation traceM "over" buffer <- G.gegl_buffer_new (Just $ G.GeglRectangle 0 0 800 600) =<< B.babl_format (B.PixelFormat B.RGBA B.CFfloat)- sink <- G.gegl_node_new_child root $ G.Operation "gegl:copy-buffer"- [ G.Property "buffer" $ G.PropertyBuffer buffer- ]+ sink <- G.gegl_node_new_child root $ G.Operation "gegl:copy-buffer" $+ props $+ prop "buffer" buffer traceM "buffer-sink"- nop <- G.gegl_node_new_child root $ G.Operation "gegl:nop" []- traceM "nop"- crop <- G.gegl_node_new_child root $ G.Operation "gegl:crop"- [ G.Property "width" $ G.PropertyDouble 800- , G.Property "height" $ G.PropertyDouble 600- ]+ rectProps <- return $+ props $ do+ prop "x" (0::Double)+ prop "y" (0::Double)+ prop "width" (20::Double)+ prop "height" (20::Double)+ prop "color" $ G.RGBA 1 0 0 0.5+ rect <- G.gegl_node_new_child root $ G.Operation "gegl:rectangle" rectProps+ traceM "rect"+ crop <- G.gegl_node_new_child root $ G.Operation "gegl:crop" $+ props $ do+ prop "width" (800::Double)+ prop "height" (600::Double) G.gegl_node_link_many [checkerboard, over, crop, sink]- G.gegl_node_connect_to nop "output" over "aux"+ _ <- G.gegl_node_connect_to rect "output" over "aux"+ let rectActor = Actor rectProps rect traceM "connections made" myMap <- return $ M.fromList [ ("root" , root) , ("over" , over) , ("background" , checkerboard) , ("sink" , sink)- , ("nop" , nop)+ , ("rect" , rect) , ("crop" , crop) ] traceM "loading complete"- return $ UserData+ actorMap <- return $ M.fromList+ [ ("rect", rectActor)+ ]+ return UserData { nodeGraph = myMap+ , actors = actorMap , foreground = buffer- , coordinates = Nothing+ , lastTick = 0 } -- drawInit :: Affection UserData () -- drawInit = do -- UserData{..} <- getAffection--- present (nodeGraph M.! "over") foreground (GeglRectangle 0 0 800 600) True+-- present (GeglRectangle 0 0 800 600) foreground True draw :: Affection UserData () draw = do- traceM "drawing"- ad <- get UserData{..} <- getAffection- SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions $ drawSurface ad- let (w, h) = (fromIntegral rw, fromIntegral rh)- liftIO $ clearArea foreground (GeglRectangle 0 0 w h)- maybe (return ()) (\(x, y) ->- drawRect- (nodeGraph M.! "nop")- (G.RGBA 1 0 0 0.5)- (Fill)- (G.GeglRectangle (x - 10) (y - 10) 20 20)- foreground- ) coordinates- liftIO $ G.gegl_node_process $ nodeGraph M.! "sink"+ mapM_ (\(Actor ps node) -> liftIO $ G.gegl_node_set node $ G.Operation "" ps) actors+ process (nodeGraph M.! "sink")+ present (GeglRectangle 0 0 800 600) foreground True -update :: Double -> [SDL.Event] -> Affection UserData ()-update sec evs = do+update :: Affection UserData ()+update = do traceM "updating"- ad <- get++ tick <- getElapsedTime ud <- getAffection- traceM $ (show $ 1 / sec) ++ " FPS"- -- ev <- liftIO $ SDL.pollEvent- mapM_ (\e ->- case SDL.eventPayload e of- SDL.MouseMotionEvent dat -> do- let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat- putAffection $ ud- { coordinates = Just (fromIntegral x, fromIntegral y)- }- SDL.WindowClosedEvent _ -> do- traceM "seeya!"- put $ ad- { quitEvent = True- }- _ ->- return ()- ) evs+ putAffection $ ud { lastTick = tick }++ let dt = tick - lastTick ud+ return ()+ traceM $ show (1 / dt) ++ " FPS"++handle :: SDL.EventPayload -> Affection UserData ()+handle (SDL.MouseMotionEvent dat) = do+ let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat+ ud <- getAffection+ + nmap <- return $ M.adjust+ (Actor (props $ do+ prop "y" (fromIntegral (y - 10) :: Double)+ prop "x" (fromIntegral (x - 10) :: Double)+ )+ . actorNode+ )+ "rect"+ (actors ud)+ putAffection ud+ { actors = nmap+ }+ -- liftIO $ G.gegl_node_set (nodeGraph ud M.! "rect") $ G.Operation "" $+ -- props $ do+ -- prop "x" (fromIntegral (x - 10) :: Double)+ -- prop "y" $ (fromIntegral (y - 10) :: Double)++handle (SDL.WindowClosedEvent _) = do+ traceM "seeya!"+ quit++handle _ =+ return () clean :: UserData -> IO () clean _ = return ()
examples/example03.hs view
@@ -23,8 +23,9 @@ , windowTitle = "Affection: example00" , windowConfig = SDL.defaultWindow , preLoop = drawInit- , drawLoop = draw+ , eventLoop = handle , updateLoop = update+ , drawLoop = draw , loadState = load , cleanUp = clean }@@ -41,10 +42,14 @@ traceM "loading" root <- G.gegl_node_new traceM "new root node"- checkerboard <- G.gegl_node_new_child root $ G.checkerboardOperation- [ G.Property "color1" $ G.PropertyColor $ G.RGBA 0.4 0.4 0.4 1- , G.Property "color2" $ G.PropertyColor $ G.RGBA 0.6 0.6 0.6 1- ]+ rect <- G.gegl_node_new_child root $ G.Operation "gegl:rectangle" $+ props $ do+ prop "x" (0 :: Double)+ prop "y" (0 :: Double)+ prop "width" (800 :: Double)+ prop "height" (600 :: Double)+ prop "color" $ G.RGB 0 0 0+ traceM "rect" traceM "checkerboard" over <- G.gegl_node_new_child root G.defaultOverOperation traceM "over"@@ -61,13 +66,12 @@ , G.Property "height" $ G.PropertyDouble 600 ] traceM "crop"- G.gegl_node_link_many [checkerboard, over, crop, sink]+ G.gegl_node_link_many [rect, over, crop, sink] G.gegl_node_connect_to nop "output" over "aux" traceM "connections made" myMap <- return $ M.fromList [ ("root" , root) , ("over" , over)- , ("background" , checkerboard) , ("sink" , sink) , ("nop" , nop) , ("crop" , crop)@@ -80,105 +84,94 @@ } drawInit :: Affection UserData ()-drawInit = do- UserData{..} <- getAffection- present (GeglRectangle 0 0 800 600) foreground True+drawInit = return ()+-- drawInit = do+-- UserData{..} <- getAffection+-- present (GeglRectangle 0 0 800 600) foreground True draw :: Affection UserData () draw = do traceM "drawing" UserData{..} <- getAffection- liftIO $ G.gegl_node_process $ nodeGraph M.! "sink"- -- ad <- get- -- ud <- getAffection- -- drawParticles partDraw $ particles ud- -- SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions $ drawSurface ad- -- let (w, h) = (fromIntegral rw, fromIntegral rh)- -- liftIO $ clearArea (foreground ud) (GeglRectangle 0 0 w h)- -- maybe (return ()) (\(x, y) ->- -- drawRect- -- (foreground ud)- -- (nodeGraph ud M.! "over")- -- (G.RGBA 1 0 0 0.5)- -- (Line 7)- -- (G.GeglRectangle (x - 10) (y - 10) 20 20)- -- ) $ coordinates ud+ drawParticleSystem partsys partDraw+ process $ nodeGraph M.! "sink"+ present+ (G.GeglRectangle 0 0 800 600)+ foreground+ True -update :: Double -> [SDL.Event] -> Affection UserData ()-update sec evs = do+update :: Affection UserData ()+update = do traceM "updating" ad <- get ud <- getAffection- -- let newPart = updateParticles sec partUpd $ particles ud- -- putAffection $ ud { particles = newPart }- traceM $ (show $ 1 / sec) ++ " FPS"- -- ev <- liftIO $ SDL.pollEvents- mapM_ (\e ->- case SDL.eventPayload e of- SDL.MouseMotionEvent dat ->- if SDL.ButtonLeft `elem` SDL.mouseMotionEventState dat- then do- let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat- vx <- liftIO $ randomRIO (-20, 20)- vy <- liftIO $ randomRIO (-20, 20)- life <- liftIO $ randomRIO (1, 5)- r <- liftIO $ randomRIO (0,1)- g <- liftIO $ randomRIO (0,1)- b <- liftIO $ randomRIO (0,1)- tempRoot <- liftIO $ G.gegl_node_new- tempOver <- liftIO $ G.gegl_node_new_child tempRoot- G.defaultOverOperation- tempRect <- liftIO $ G.gegl_node_new_child tempRoot $ G.Operation- "gegl:rectangle"- [ G.Property "x" $ G.PropertyDouble $ fromIntegral x - 10- , G.Property "y" $ G.PropertyDouble $ fromIntegral y - 10- , G.Property "width" $ G.PropertyDouble 20- , G.Property "height" $ G.PropertyDouble 20- , G.Property "color" $ G.PropertyColor $ (G.RGBA r g b 0.5)- ]- liftIO $ G.gegl_node_connect_to tempRect "output" tempOver "aux"- -- traceM $ "position is: " ++ show x ++ " " ++ show y- -- traceM $ "velocity is: " ++ show vx ++ " " ++ show vy- ips <- insertParticle (partsys ud) $- Particle- { particleTimeToLive = life- , particleCreation = elapsedTime ad- , particlePosition = (fromIntegral x, fromIntegral y)- , particleRotation = Rad 0- , particleVelocity = (vx, vy)- , particlePitchRate = Rad 0- , particleRootNode = tempRoot- , particleNodeGraph = M.fromList- [ ("root", tempRoot)- , ("over", tempOver)- , ("rect", tempRect)- ]- , particleStackCont = tempOver- , particleDrawFlange = tempOver- }- putAffection $ ud- { partsys = ips- }- -- when (not $ null $ psParts $ partsys ud) $- -- liftIO $ G.gegl_node_link- -- tempOver- -- (particleStackCont $ head $ psParts $ partsys ud)- else- return ()- SDL.WindowClosedEvent _ -> do- traceM "seeya!"- put $ ad- { quitEvent = True- }- _ ->- return ()- ) evs+ delta <- getDelta+ traceM $ (show $ 1 / delta) ++ " FPS" ud2 <- getAffection- !nps <- updateParticleSystem (partsys ud2) sec partUpd partDraw+ !nps <- updateParticleSystem (partsys ud2) delta partUpd putAffection $ ud2 { partsys = nps } +handle (SDL.MouseMotionEvent dat) =+ when (SDL.ButtonLeft `elem` SDL.mouseMotionEventState dat)+ $ do+ ad <- get+ ud <- getAffection+ let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat+ vx <- liftIO $ randomRIO (-20, 20)+ vy <- liftIO $ randomRIO (-20, 20)+ life <- liftIO $ randomRIO (1, 5)+ r <- liftIO $ randomRIO (0,1)+ g <- liftIO $ randomRIO (0,1)+ b <- liftIO $ randomRIO (0,1)+ tempRoot <- liftIO $ G.gegl_node_new+ tempOver <- liftIO $ G.gegl_node_new_child tempRoot+ G.defaultOverOperation+ tempRect <- liftIO $ G.gegl_node_new_child tempRoot $ G.Operation+ "gegl:rectangle"+ [ G.Property "x" $ G.PropertyDouble $ fromIntegral x - 10+ , G.Property "y" $ G.PropertyDouble $ fromIntegral y - 10+ , G.Property "width" $ G.PropertyDouble 20+ , G.Property "height" $ G.PropertyDouble 20+ , G.Property "color" $ G.PropertyColor $ (G.RGBA r g b 0.5)+ ]+ liftIO $ G.gegl_node_connect_to tempRect "output" tempOver "aux"+ -- traceM $ "position is: " ++ show x ++ " " ++ show y+ -- traceM $ "velocity is: " ++ show vx ++ " " ++ show vy+ ips <- insertParticle (partsys ud) $+ Particle+ { particleTimeToLive = life+ , particleCreation = elapsedTime ad+ , particlePosition = (fromIntegral x, fromIntegral y)+ , particleRotation = Rad 0+ , particleVelocity = (vx, vy)+ , particlePitchRate = Rad 0+ , particleRootNode = tempRoot+ , particleNodeGraph = M.fromList+ [ ("root", tempRoot)+ , ("over", tempOver)+ , ("rect", tempRect)+ ]+ , particleStackCont = tempOver+ , particleDrawFlange = tempOver+ }+ putAffection $ ud+ { partsys = ips+ }+ -- when (not $ null $ psParts $ partsys ud) $+ -- liftIO $ G.gegl_node_link+ -- tempOver+ -- (particleStackCont $ head $ psParts $ partsys ud)++handle (SDL.WindowClosedEvent _) = do+ traceM "seeya!"+ quit++handle _ =+ return ()+ clean :: UserData -> IO ()-clean _ = return ()+clean ud = do+ G.gegl_node_drop (nodeGraph ud M.! "root") partUpd :: Double -> Particle -> Affection UserData Particle partUpd sec p = do@@ -192,15 +185,16 @@ return np partDraw :: G.GeglBuffer -> G.GeglNode -> Particle -> Affection UserData ()-partDraw buf node Particle{..} = do- 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+partDraw _ _ _ = return ()+-- partDraw buf node Particle{..} = do+-- 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
src/Affection.hs view
@@ -9,6 +9,9 @@ , delaySec , get , put+ , getElapsedTime+ , getDelta+ , quit , module A ) where @@ -23,6 +26,7 @@ import System.Clock import Control.Monad.Loops+import qualified Control.Monad.Parallel as MP import Control.Monad.State import Foreign.C.Types (CInt(..))@@ -35,6 +39,8 @@ import Affection.Particle as A import Affection.StateMachine as A import Affection.MouseInteractable as A+import Affection.Property as A+import Affection.Actor as A import qualified BABL as B @@ -75,8 +81,8 @@ pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek ptr SDL.V2 (CInt rw) (CInt rh) <- liftIO $ SDL.surfaceDimensions surface let (w, h) = (fromIntegral rw, fromIntegral rh)- stride = (fromIntegral $ Raw.pixelFormatBytesPerPixel pixelFormat) * w- pixels <- SDL.surfacePixels $ surface+ stride = fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w+ pixels <- SDL.surfacePixels surface let bablFormat = B.PixelFormat B.RGBA B.CFu8 cpp = B.babl_components_per_pixel bablFormat format <- B.babl_format bablFormat@@ -93,6 +99,7 @@ , drawCPP = cpp , drawStack = [] , elapsedTime = 0+ , dt = 0 }) <$> loadState surface (_, nState) <- runStateT ( A.runState $ do preLoop@@ -109,18 +116,20 @@ -- clean draw requests from last run mapM_ (invalidateDrawRequest (drawPixels ad) (drawStride ad) (drawCPP ad)) (drawStack ad) -- clean the renderer form last time- SDL.clear renderer+ -- SDL.clear renderer -- compute dt and update elapsedTime- let !dt = (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) / (fromIntegral 10 ^ 9)+ let !dt = fromIntegral (toNanoSecs $ diffTimeSpec lastTime now) / (10 ^ 9) !ne = elapsedTime ad + dt put $ ad { drawStack = [] , elapsedTime = ne+ , dt = dt } -- poll events evs <- preHandleEvents =<< liftIO SDL.pollEvents+ MP.mapM_ eventLoop evs -- execute user defined update loop- updateLoop dt evs+ updateLoop -- execute user defined draw loop drawLoop -- handle all new draw requests@@ -138,7 +147,7 @@ -- clean the texture SDL.destroyTexture texture -- save new time- liftIO $ writeIORef execTime $ now+ liftIO $ writeIORef execTime now ) ) initContainer G.gegl_exit@@ -150,11 +159,11 @@ getSurfaces window = do oldSurf@(SDL.Surface ptr _) <- SDL.getWindowSurface window rawSurfacePtr <- Raw.convertSurfaceFormat ptr (SDL.toNumber SDL.ABGR8888) 0- let surface = (flip SDL.Surface Nothing) rawSurfacePtr+ let surface = SDL.Surface rawSurfacePtr Nothing return (oldSurf, surface) -- Prehandle SDL events in case any window events occur-preHandleEvents :: [SDL.Event] -> Affection us [SDL.Event]+preHandleEvents :: [SDL.Event] -> Affection us [SDL.EventPayload] preHandleEvents evs = -- mapM handle evs -- where@@ -165,7 +174,7 @@ -- return e -- _ -> -- return e- return evs+ return $ map SDL.eventPayload evs -- | Return the userstate to the user getAffection :: Affection us us@@ -187,3 +196,17 @@ :: Int -- ^ Number of seconds -> IO () delaySec dur = SDL.delay (fromIntegral $ dur * 1000)++-- | Get time since start but always the same in the current tick.+getElapsedTime :: Affection us Double+getElapsedTime =+ elapsedTime <$> get++getDelta :: Affection us Double+getDelta =+ dt <$> get++quit :: Affection us ()+quit = do+ ad <- get+ put $ ad { quitEvent = True }
+ src/Affection/Actor.hs view
@@ -0,0 +1,12 @@+-- | This module implements the Actor, a Datastructure binding a 'G.GeglNode'+-- to a game asset+module Affection.Actor+ ( Actor(..)+ ) where++import qualified GEGL as G++data Actor = Actor+ { actorProperties :: [G.Property]+ , actorNode :: G.GeglNode+ }
src/Affection/Draw.hs view
@@ -1,12 +1,13 @@-{-# LANGUAGE RecordWildCards, BangPatterns #-}+{-# LANGUAGE RecordWildCards #-} -- | Module for drawing primitives module Affection.Draw ( drawRect- -- , clear+ , clear , handleDrawRequest , invalidateDrawRequest , present+ , process , clearArea ) where @@ -39,7 +40,7 @@ -> Affection us () drawRect node color Fill rect@GeglRectangle{..} buf = do ad <- get- tempRoot <- liftIO $ G.gegl_node_new+ tempRoot <- liftIO G.gegl_node_new opNode <- liftIO $ G.gegl_node_new_child tempRoot $ G.Operation "gegl:rectangle" [ G.Property "x" $ G.PropertyDouble $ fromIntegral rectangleX , G.Property "y" $ G.PropertyDouble $ fromIntegral rectangleY@@ -50,7 +51,7 @@ 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 (Just tempRoot))) : drawStack ad+ { drawStack = DrawRequest rect buf (Kill (Just tempRoot)) : drawStack ad } -- | Force update of a specific region on screen@@ -63,9 +64,35 @@ ad <- get let k = if not kill then Kill Nothing else Persist put ad- { drawStack = (DrawRequest rect buf k) : drawStack ad+ { drawStack = DrawRequest rect buf k : drawStack ad } +process+ :: G.GeglNode+ -> Affection us ()+process = liftIO . G.gegl_node_process++putToSurface+ :: Ptr a+ -> G.GeglRectangle+ -> Int+ -> Int+ -> DrawRequest+ -> Affection us ()+putToSurface pixels realRect stride cpp DrawRequest{..} = do+ ad <- get+ liftIO $ SDL.lockSurface $ drawSurface ad+ liftIO $ G.gegl_buffer_get+ requestBuffer+ (Just realRect)+ 1+ (Just $ drawFormat ad)+ (pixels `plusPtr`+ (rectangleX realRect * cpp + rectangleY realRect * stride))+ stride+ G.GeglAbyssNone+ liftIO $ SDL.unlockSurface $ drawSurface ad+ -- | function for handling 'DrawRequest's and updating the output handleDrawRequest :: Ptr a -- ^ Pixel buffer to blit to@@ -79,20 +106,9 @@ let surf = drawSurface ad mrealRect <- liftIO $ G.gegl_rectangle_intersect requestArea- (G.GeglRectangle 0 0 (fst $ drawDimensions ad) (snd $ drawDimensions ad))- maybe (return()) (\realRect -> do- liftIO $ SDL.lockSurface surf- liftIO $ G.gegl_buffer_get- requestBuffer- (Just realRect)- 1- (Just $ drawFormat ad)- (pixels `plusPtr`- (rectangleX realRect * cpp + rectangleY realRect * stride))- stride- G.GeglAbyssNone- liftIO $ SDL.unlockSurface surf- -- liftIO $ SDL.updateWindowSurface $ drawWindow ad+ (uncurry (G.GeglRectangle 0 0) (drawDimensions ad))+ maybe (return()) (\realRect ->+ putToSurface pixels realRect stride cpp dr ) mrealRect case requestPersist of Persist ->@@ -112,21 +128,10 @@ ad <- get mrealRect <- liftIO $ G.gegl_rectangle_intersect requestArea- (G.GeglRectangle 0 0 (fst $ drawDimensions ad) (snd $ drawDimensions ad))+ (uncurry (G.GeglRectangle 0 0) (drawDimensions ad)) maybe (return()) (\realRect -> do- let surf = drawSurface ad liftIO $ clearArea requestBuffer realRect- liftIO $ SDL.lockSurface surf- liftIO $ G.gegl_buffer_get- requestBuffer- (Just realRect)- 1- (Just $ drawFormat ad)- (pixels `plusPtr`- (rectangleX realRect * cpp + rectangleY realRect * stride))- stride- G.GeglAbyssNone- liftIO $ SDL.unlockSurface surf+ putToSurface pixels realRect stride cpp dr ) mrealRect case requestPersist of Kill (Just victim) ->@@ -150,7 +155,7 @@ G.RGB r g b -> (r, g, b) ca = case col of G.RGBA _ _ _ a -> a- G.RGB _ _ _ -> 1+ G.RGB{} -> 1 alpha = ca dst_a = ba da = alpha + dst_a * (1 - alpha)@@ -162,7 +167,7 @@ ( G.CVdouble $ CDouble $ red / da , G.CVdouble $ CDouble $ gre / da , G.CVdouble $ CDouble $ blu / da- , G.CVdouble $ CDouble $ ca+ , G.CVdouble $ CDouble ca ) unsafeColorize col =@@ -172,12 +177,12 @@ G.RGB cr cg cb -> (cr, cg, cb) a = case col of G.RGBA _ _ _ ca -> ca- G.RGB _ _ _ -> 1+ G.RGB{} -> 1 in- ( G.CVdouble $ CDouble $ r- , G.CVdouble $ CDouble $ g- , G.CVdouble $ CDouble $ b- , G.CVdouble $ CDouble $ a+ ( G.CVdouble $ CDouble r+ , G.CVdouble $ CDouble g+ , G.CVdouble $ CDouble b+ , G.CVdouble $ CDouble a ) -- | Clear a specified area of a buffer from all data@@ -186,3 +191,11 @@ -> G.GeglRectangle -- ^ Area to clear -> IO () clearArea = G.gegl_buffer_clear++-- | Clear the whole drawing area+clear :: G.GeglBuffer -> Affection us ()+clear buffer = do+ ad <- get+ SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions $ drawSurface ad+ let (w, h) = (fromIntegral rw, fromIntegral rh)+ liftIO $ clearArea buffer (GeglRectangle 0 0 w h)
src/Affection/MouseInteractable.hs view
@@ -18,3 +18,25 @@ -> SDL.InputMotion -- The 'SDL.InputMotion' of the click -> Int -- The number of clicks -> Affection us ()++-- | A helper function that checks wether provided clickables have been clicked.+-- This function does not consume provided events, but passes them on.+handleMouseClicks+ :: (Foldable t, MouseClickable clickable us)+ => SDL.Event -- ^ Piped event in+ -> t clickable -- ^ 'MouseClickable' elemt to be checked+ -> Affection us SDL.Event -- ^ Unaltered event+handleMouseClicks e clickables =+ case SDL.eventPayload e of+ SDL.MouseButtonEvent dat -> do+ mapM_ (\clickable -> do+ let SDL.P (SDL.V2 x y) = SDL.mouseButtonEventPos dat+ onClick+ clickable+ (SDL.mouseButtonEventButton dat)+ (fromIntegral x, fromIntegral y)+ (SDL.mouseButtonEventMotion dat)+ (fromIntegral $ SDL.mouseButtonEventClicks dat)+ ) clickables+ return e+ _ -> return e
src/Affection/Particle.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE BangPatterns #-} -- | This module introduces a simple particle system to Affection@@ -6,6 +5,7 @@ ( updateParticle , drawParticles , updateParticleSystem+ , drawParticleSystem , insertParticle ) where @@ -13,6 +13,7 @@ import Control.Monad import Control.Monad.State (get)+import qualified Control.Monad.Parallel as MP import Data.Maybe @@ -25,42 +26,48 @@ -- 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 do+ dropParticle p+ return []+ else+ (: []) <$> 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+ (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_ (uncurry $ G.gegl_node_connect_to+ producer+ padname+ ) consumers+ ) mproducer+ liftIO $ G.gegl_node_drop $ particleRootNode p -- | Get the next living particle from a list nextLiving@@ -69,10 +76,7 @@ nextLiving [] = Nothing nextLiving acc = case catMaybes acc of [] -> Nothing- ps -> Just $ head $ ps- -- if isNothing p- -- then nextLiving ps- -- else p+ ps -> Just $ head ps drawParticles :: (Particle -> Affection us ())@@ -84,25 +88,17 @@ :: ParticleSystem -> Double -> (Double -> Particle -> Affection us Particle)- -> (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)- if (not $ null x)+updateParticleSystem sys sec upd = do+ !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 { partSysParts = (partSysParts sys) { partStorList = x } } else do- _ <- liftIO $ G.gegl_node_disconnect (partSysNode sys) "input" return sys { partSysParts = ParticleStorage { partStorList = []@@ -110,6 +106,21 @@ } } +drawParticleSystem+ :: ParticleSystem+ -> (G.GeglBuffer -> G.GeglNode -> Particle -> Affection us ())+ -> Affection us ()+drawParticleSystem sys draw =+ if not (null parts)+ then do+ liftIO $ G.gegl_node_link (particleStackCont $ head parts) (partSysNode sys)+ MP.mapM_ (draw (partSysBuffer sys) (partSysNode sys)) parts+ else do+ _ <- liftIO $ G.gegl_node_disconnect (partSysNode sys) "input"+ return ()+ where+ parts = partStorList (partSysParts sys)+ -- | Function for inserting a new 'Particle' into its 'PartileSystem' insertParticle :: ParticleSystem -- ^ 'ParticleSystem' to insert into@@ -119,11 +130,7 @@ 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+ return ps { partSysParts = (partSysParts ps) { partStorLatest = Just p , partStorList = newList
+ src/Affection/Property.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+module Affection.Property + ( Props+ , prop+ , props+ ) where++import qualified GEGL as G+import qualified BABL as B++import Control.Monad.State.Lazy+import Foreign.Ptr (Ptr)++type Props a = State [G.Property] a++props :: Props a -> [G.Property]+props = flip execState []++prop :: IsPropertyValue v => String -> v -> Props ()+prop k v = do+ ps <- get+ put $ G.Property k (toPropertyValue v) : ps++class IsPropertyValue v where+ toPropertyValue :: v -> G.PropertyValue++instance IsPropertyValue Int where+ toPropertyValue = G.PropertyInt++instance IsPropertyValue String where+ toPropertyValue = G.PropertyString++instance IsPropertyValue Double where+ toPropertyValue = G.PropertyDouble++instance IsPropertyValue G.Color where+ toPropertyValue = G.PropertyColor++instance IsPropertyValue B.PixelFormat where+ toPropertyValue = G.PropertyFormat+instance IsPropertyValue G.GeglBuffer where+ toPropertyValue = G.PropertyBuffer++instance IsPropertyValue (Ptr ()) where+ toPropertyValue = G.PropertyPointer
src/Affection/Types.hs view
@@ -40,6 +40,7 @@ import Control.Monad.IO.Class import Control.Monad.State+import qualified Control.Monad.Parallel as MP -- import Control.Monad.Reader -- import Control.Concurrent.MVar@@ -56,10 +57,12 @@ -- ^ Window configuration , preLoop :: Affection us () -- ^ Actions to be performed, before loop starts+ , eventLoop :: SDL.EventPayload -> Affection us ()+ -- ^ Main update function. Takes fractions of a second as input.+ , updateLoop :: Affection us ()+ -- ^ Main update function. Takes fractions of a second as input. , drawLoop :: Affection us () -- ^ Function for updating graphics.- , updateLoop :: Double -> [SDL.Event] -> Affection us ()- -- ^ Main update function. Takes fractions of a second as input. , loadState :: SDL.Surface -> IO us -- ^ Provide your own load function to create this data. , cleanUp :: us -> IO ()@@ -86,6 +89,7 @@ , drawStride :: Int -- ^ Stride of target buffer , drawCPP :: Int -- ^ Number of components per pixel , elapsedTime :: Double -- ^ Elapsed time in seconds+ , dt :: Double -- ^ Elapsed time in seconds since last tick } -- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated@@ -110,6 +114,8 @@ newtype AffectionState us m a = AffectionState { runState :: AffectionStateInner us m a } deriving (Functor, Applicative, Monad, MonadIO, MonadState us)++instance MP.MonadParallel m => MP.MonadParallel (AffectionState us m) type Affection us a = AffectionState (AffectionData us) IO a