{-# Language TypeFamilies
  #-}
module Data.Geometry.Ipe.WriteIpeGeometry( addToPage
                                         , addViewToDrawing
                                         , IsConvertableToIpeObject(..)
                                         , toIpeObjects'
                                        ) where

import Data.Geometry.Point
import Data.Geometry.Geometry
import Data.Geometry.Ipe.IpeTypes
import Data.Geometry.Ipe.IpeGeometryTypes
import Data.Geometry.Ipe.IpeView
import Data.Geometry.Ipe.IGC(IGC(IGC))
import Data.List

import qualified Data.Map as M

-----------------------------------------------------------------------------------
-- | Converting to IpeTypes

-- | convert a sequence of points into a list of operations representing a linear Path
toLinearPath         :: [Point2' a] -> [Operation a]
toLinearPath []      = []
toLinearPath (p:pts) = MoveTo p : map LineTo pts

-- | Express that this sequence of points represents a polygon
mkPolygonOps     :: [Point2' a] -> [Operation a]
mkPolygonOps pts = toLinearPath pts ++ [ClosePath]

class IsConvertableToIpeObject g where
    toIpeObject  :: g a -> IpeObject a
    toIpeObjects :: [g a] -> [IpeObject a]
    toIpeObjects = map toIpeObject


instance IsConvertableToIpeObject IpePoint' where
    toIpeObject (IpePoint p attrs) = Use p attrs

instance IsConvertableToIpeObject IpePolyline' where
    toIpeObject (IpePolyline lines attrs) =
        Path (toLinearPath . concatMap points $ lines) attrs

instance IsConvertableToIpeObject IpeSimplePolygon' where
    toIpeObject (IpeSimplePolygon pts attrs) =
        Path (mkPolygonOps pts) attrs

instance IsConvertableToIpeObject IpeMultiPolygon' where
    toIpeObject (IpeMultiPolygon pls attrs) =
        Path ops attrs
             where
               ops = concatMap (mkPolygonOps . points) pls


instance IsConvertableToIpeObject IGC where
    toIpeObject gc = Group obs ats
                     where
                       obs = toIpeObjects' gc
                       ats = case obs of
                                 []    -> M.empty
                                 (o:_) -> attrs o

toIpeObjects'                         :: IGC a -> [IpeObject a]
toIpeObjects' (IGC _ pts pll sps mps) = concat [ toIpeObjects pts
                                               , toIpeObjects pll
                                               , toIpeObjects sps
                                               , toIpeObjects mps ]

addViewToDrawing :: Eq a => ViewInstance a -> IpeDrawing a -> IpeDrawing a
addViewToDrawing v (Ipe pre sty [])      = Ipe pre sty [addToPage v emptyPage]
addViewToDrawing v (Ipe pre sty (p:pgs)) = Ipe pre sty (addToPage v p : pgs)


-- | Add (the objects in this View) to the given page
addToPage :: Eq a => ViewInstance a -> Page a -> Page a
addToPage (ViewInstance vd lrs) (Page lds vds obs) =
    Page lds' vds' obs'
         where
           lds' = nub $ layerNames vd ++ lds
           vds' = nub $ vd:vds
           obs' = nub $ map (toIpeObject . layerContent) lrs ++ obs