pituicat/src/Affection/Actor.hs

63 lines
1.8 KiB
Haskell
Raw Normal View History

2017-03-21 11:04:56 +00:00
{-# LANGUAGE RecordWildCards #-}
2017-03-18 16:38:26 +00:00
-- | This module implements the Actor, a Datastructure binding a 'G.GeglNode'
-- to a game asset
module Affection.Actor
2017-04-17 10:40:17 +00:00
( Actor(..)
, ActorProperty(..)
, updateProperties
, applyProperties
, getProperty
) where
2017-03-18 16:38:26 +00:00
import qualified GEGL as G
2017-03-21 11:04:56 +00:00
import qualified Data.Map.Strict as M
import Data.List
import qualified Control.Monad.Parallel as MP
import Affection.Types
2017-07-29 00:20:32 +00:00
data (Show a, Ord a) => Actor a = Actor
2017-03-21 11:04:56 +00:00
{ actorProperties :: [ActorProperty a]
, actorNodes :: M.Map a G.GeglNode
2017-04-17 10:40:17 +00:00
, actorFlange :: G.GeglNode
2017-07-29 00:20:32 +00:00
} deriving (Show, Eq)
2017-03-21 11:04:56 +00:00
2017-07-29 00:20:32 +00:00
data (Show a, Ord a) => ActorProperty a = ActorProperty
2017-03-21 11:04:56 +00:00
{ apName :: String
, apValue :: G.PropertyValue
2017-04-17 10:40:17 +00:00
, apMapping :: Maybe (a, String)
2017-07-29 00:20:32 +00:00
} deriving (Show, Eq)
2017-03-21 11:04:56 +00:00
2017-07-29 00:20:32 +00:00
updateProperties :: (Show a, Ord a) => [G.Property] -> Actor a -> Actor a
2017-03-21 11:04:56 +00:00
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
2017-07-29 00:20:32 +00:00
applyProperties :: (Show a, Ord a) => Actor a -> Affection us ()
2017-03-21 11:04:56 +00:00
applyProperties Actor{..} =
2017-12-15 17:01:05 +00:00
MP.mapM_ (\ActorProperty{..} ->
2017-03-21 11:04:56 +00:00
maybe (return ()) (\m ->
2017-04-17 10:40:17 +00:00
liftIO $ G.gegl_node_set (actorNodes M.! fst m) $ G.Operation "" $
(G.Property (snd m) apValue) : []
2017-03-21 11:04:56 +00:00
) apMapping
) actorProperties
2017-04-17 10:40:17 +00:00
2017-07-29 00:20:32 +00:00
getProperty :: (Show a, Ord a) => String -> Actor a -> Maybe G.PropertyValue
2017-04-17 10:40:17 +00:00
getProperty name act =
case find (\a -> name == apName a) $ actorProperties act of
Just p -> Just $ apValue p
Nothing -> Nothing