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


-- | A complete ipe file
data IpeFile a = IpeFile { preamble :: Maybe IpePreamble
                         , styles   :: [IpeStyle]
                         , ipePages :: [IpePage a]
                         }
                 deriving (Eq,Show)

-- for now we pretty much ignore these
-- | the maybe string is the styles name
data IpeStyle = IpeStyle (Maybe String) [XmlTree]
              deriving (Eq,Show)

-- | The maybe string is the encoding
data IpePreamble  = IpePreamble (Maybe String) XmlTree
                  deriving (Eq,Show)

type IpeBitmap = XmlTree


-- | Represents the <page> tag
data IpePage a = IpePage [LayerDefinition] [ViewDefinition] [IpeObject a]
              deriving (Eq, Show)


type LayerDefinition = String

-- | The definition of a view
-- make active layer into an index ?
data ViewDefinition = ViewDefinition { layerNames      :: [String]
                                     , activeLayer     :: String
                                     }
                      deriving (Eq, Show)

--------------------------------------------------------------------------------
-- | An ipe-object. The main ``thing'' that defines the drawings

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

-- | Attribute Map
type AMap = Map String String

-- | type that represents a path in ipe.
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)
    -- TODO: Should we transform the matrix too?
    -- p2fmap f (Ellipse m)        = Ellipse m
    -- p2fmap f (ArcTo m p)        = ArcTo m (f p)
    p2fmap f (Spline pts)       = Spline (map f pts)
    p2fmap f (ClosedSpline pts) = ClosedSpline (map f pts)
    p2fmap f ClosePath          = ClosePath


--------------------------------------------------------------------------------------
-- | Stuff with attributes

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)