62 lines
1.8 KiB
Haskell
62 lines
1.8 KiB
Haskell
{-# 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
|