From 6eccf8ed5b78f64c4d164b530dc2254acc993f69 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 18 Mar 2017 17:38:26 +0100 Subject: [PATCH] introducing actors --- affection.cabal | 1 + examples/example02.hs | 31 ++++++++++++++++++++++++++----- src/Affection.hs | 4 ++-- src/Affection/Actor.hs | 12 ++++++++++++ src/Affection/Property.hs | 10 +++++++--- 5 files changed, 48 insertions(+), 10 deletions(-) create mode 100644 src/Affection/Actor.hs diff --git a/affection.cabal b/affection.cabal index 49f955e..46d0d1e 100644 --- a/affection.cabal +++ b/affection.cabal @@ -42,6 +42,7 @@ library , Affection.StateMachine , Affection.MouseInteractable , Affection.Property + , Affection.Actor default-extensions: OverloadedStrings -- Modules included in this library but not exported. diff --git a/examples/example02.hs b/examples/example02.hs index 5ae1aaa..4d58f06 100644 --- a/examples/example02.hs +++ b/examples/example02.hs @@ -25,6 +25,7 @@ main = do data UserData = UserData { nodeGraph :: M.Map String G.GeglNode + , actors :: M.Map String Actor , foreground :: G.GeglBuffer , lastTick :: Double } @@ -47,13 +48,14 @@ load _ = do props $ prop "buffer" buffer traceM "buffer-sink" - rect <- G.gegl_node_new_child root $ G.Operation "gegl:rectangle" $ + 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 @@ -61,6 +63,7 @@ load _ = do prop "height" (600::Double) G.gegl_node_link_many [checkerboard, over, crop, sink] _ <- G.gegl_node_connect_to rect "output" over "aux" + let rectActor = Actor rectProps rect traceM "connections made" myMap <- return $ M.fromList [ ("root" , root) @@ -71,8 +74,12 @@ load _ = do , ("crop" , crop) ] traceM "loading complete" + actorMap <- return $ M.fromList + [ ("rect", rectActor) + ] return $ UserData { nodeGraph = myMap + , actors = actorMap , foreground = buffer , lastTick = 0 } @@ -85,6 +92,7 @@ load _ = do draw :: Affection UserData () draw = do UserData{..} <- getAffection + 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 @@ -104,10 +112,23 @@ handle :: SDL.EventPayload -> Affection UserData () handle (SDL.MouseMotionEvent dat) = do let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat ud <- getAffection - 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) + + nmap <- return $ M.adjust + (\a -> Actor (props $ do + prop "y" (fromIntegral (y - 10) :: Double) + prop "x" (fromIntegral (x - 10) :: Double) + ) + (actorNode a) + ) + "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!" diff --git a/src/Affection.hs b/src/Affection.hs index f42d519..968c1e0 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -13,7 +13,6 @@ module Affection , getDelta , quit , module A - , module Affection.Property ) where import qualified SDL @@ -39,7 +38,8 @@ import Affection.Draw as A import Affection.Particle as A import Affection.StateMachine as A import Affection.MouseInteractable as A -import Affection.Property +import Affection.Property as A +import Affection.Actor as A import qualified BABL as B diff --git a/src/Affection/Actor.hs b/src/Affection/Actor.hs new file mode 100644 index 0000000..2e2a5bf --- /dev/null +++ b/src/Affection/Actor.hs @@ -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 + } diff --git a/src/Affection/Property.hs b/src/Affection/Property.hs index dfebc79..1caa42c 100644 --- a/src/Affection/Property.hs +++ b/src/Affection/Property.hs @@ -1,10 +1,15 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} -module Affection.Property where +module Affection.Property + ( Props(..) + , prop + , props + ) where -import Control.Monad.State.Lazy 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 @@ -34,7 +39,6 @@ instance IsPropertyValue G.Color where instance IsPropertyValue B.PixelFormat where toPropertyValue = G.PropertyFormat - instance IsPropertyValue G.GeglBuffer where toPropertyValue = G.PropertyBuffer