introducing actors

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.

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
+  nmap <- return $ M.adjust
+    (\a -> Actor (props $ do
+      prop "y" (fromIntegral (y - 10) :: Double)
       prop "x" (fromIntegral (x - 10) :: Double)
-        prop "y" $ (fromIntegral (y - 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!"

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
 

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
+  }

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