module Data.Geometry.Ipe.InternalTypes where
import Data.Geometry.Point
import Data.Geometry.Geometry
import Text.XML.HXT.DOM.TypeDefs
import Data.Map(Map)
import Data.Maybe
import qualified Data.Map as M
data IpeFile a = IpeFile { preamble :: Maybe IpePreamble
, styles :: [IpeStyle]
, ipePages :: [IpePage a]
}
deriving (Eq,Show)
data IpeStyle = IpeStyle (Maybe String) [XmlTree]
deriving (Eq,Show)
data IpePreamble = IpePreamble (Maybe String) XmlTree
deriving (Eq,Show)
type IpeBitmap = XmlTree
data IpePage a = IpePage [LayerDefinition] [ViewDefinition] [IpeObject a]
deriving (Eq, Show)
type LayerDefinition = String
data ViewDefinition = ViewDefinition { layerNames :: [String]
, activeLayer :: String
}
deriving (Eq, Show)
data IpeObject a = Path [Operation a] AMap
| Group [IpeObject a] AMap
| IpeText String AMap
| Use (Point2' a) AMap
deriving (Eq,Show)
instance IsPoint2Functor IpeObject where
p2fmap f (Path ops attrs) = Path (map (p2fmap f) ops) attrs
p2fmap f (Group obs attrs) = Group (map (p2fmap f) obs) attrs
p2fmap f (IpeText s attrs) = IpeText s attrs
p2fmap f (Use p attrs) = Use (f p) attrs
type AMap = Map String String
data Operation a = MoveTo (Point2' a)
| LineTo (Point2' a)
| CurveTo (Point2' a) (Point2' a) (Point2' a)
| QCurveTo (Point2' a) (Point2' a)
| Ellipse (Matrix3 a)
| ArcTo (Matrix3 a) (Point2' a)
| Spline [Point2' a]
| ClosedSpline [Point2' a]
| ClosePath
deriving (Eq, Show)
instance IsPoint2Functor Operation where
p2fmap f (MoveTo p) = MoveTo (f p)
p2fmap f (LineTo p) = LineTo (f p)
p2fmap f (CurveTo p q r) = CurveTo (f p) (f q) (f r)
p2fmap f (QCurveTo p q) = QCurveTo (f p) (f q)
p2fmap f (Spline pts) = Spline (map f pts)
p2fmap f (ClosedSpline pts) = ClosedSpline (map f pts)
p2fmap f ClosePath = ClosePath
class HasAttributes c where
attrs :: c -> AMap
updateWith :: (AMap -> AMap) -> c -> c
getAttr :: String -> c -> Maybe String
getAttr s o = M.lookup s . attrs $ o
setAttr :: String -> String -> c -> c
setAttr k v = updateWith (M.insert k v)
setAttrs :: [(String,String)] -> c -> c
setAttrs ats = updateWith (insertAll ats)
where
insertAll :: [(String,String)] -> AMap -> AMap
insertAll ats m = foldr (uncurry M.insert) m ats
hasAttrWithValue :: String -> String -> c -> Bool
hasAttrWithValue at val o = Just val == getAttr at o
hasAttr :: String -> c -> Bool
hasAttr s = isJust . getAttr s
extractAttr :: String -> c -> c
extractAttr s = updateWith (M.delete s)
instance HasAttributes (IpeObject a) where
attrs (Path _ a) = a
attrs (Group _ a) = a
attrs (IpeText _ a) = a
attrs (Use _ a) = a
updateWith f (Path ops a) = Path ops (f a)
updateWith f (Group obs a) = Group obs (f a)
updateWith f (IpeText s a) = IpeText s (f a)
updateWith f (Use p a) = Use p (f a)