{-# LANGUAGE RecordWildCards #-} -- | This module implements the Actor, a Datastructure binding a 'G.GeglNode' -- to a game asset module Affection.Actor ( Actor(..) , ActorProperty(..) , updateProperties , applyProperties , getProperty ) where import qualified GEGL as G import qualified Data.Map.Strict as M import Data.List import qualified Control.Monad.Parallel as MP import Affection.Types data (Show a, Ord a) => Actor a = Actor { actorProperties :: [ActorProperty a] , actorNodes :: M.Map a G.GeglNode , actorFlange :: G.GeglNode } deriving (Show, Eq) data (Show a, Ord a) => ActorProperty a = ActorProperty { apName :: String , apValue :: G.PropertyValue , apMapping :: Maybe (a, String) } deriving (Show, Eq) updateProperties :: (Show a, Ord a) => [G.Property] -> Actor a -> Actor a updateProperties ps act@Actor{..} = act { actorProperties = foldl (\acc (G.Property name val) -> newProp name val acc) actorProperties ps } where newProp name val acc = nubBy (\a b -> apName a == apName b) $ (getProp name) { apValue = val } : acc getProp n = getProp' n actorProperties getProp' n [] = error $ "no ActorProperty found: " ++ n getProp' n (p:ps) | apName p == n = p | otherwise = getProp' n ps applyProperties :: (Show a, Ord a) => Actor a -> Affection us () applyProperties Actor{..} = MP.mapM_ (\ActorProperty{..} -> maybe (return ()) (\m -> liftIO $ G.gegl_node_set (actorNodes M.! fst m) $ G.Operation "" $ (G.Property (snd m) apValue) : [] ) apMapping ) actorProperties getProperty :: (Show a, Ord a) => String -> Actor a -> Maybe G.PropertyValue getProperty name act = case find (\a -> name == apName a) $ actorProperties act of Just p -> Just $ apValue p Nothing -> Nothing