WriteIpeGeometry.hs

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

import Data.Geometry.Point
import Data.Geometry.Geometry

import Data.Geometry.Ipe.InternalTypes
import Data.Geometry.Ipe.IpeGeometryTypes

import Data.Geometry.Ipe.IGC(IGC(IGC))

import Data.Maybe
import Data.List

import qualified Data.Map as M

-----------------------------------------------------------------------------------
-- | Primitives for 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]


-- | Helper function to create an ipe object, more specifically a path, from a
-- list of operations.
mkPath           :: AMap -> [Operation a] -> Maybe (IpeObject a)
mkPath _     []  = Nothing
mkPath attrs ops = Just $ Path ops attrs


class IsConvertableToIpeObject g where
    type PM g
    toIpeObject  :: g -> Maybe (IpeObject (PM g))
    toIpeObjects :: [g] -> [IpeObject (PM g)]
    toIpeObjects = mapMaybe toIpeObject


instance IsConvertableToIpeObject (IpePoint' a) where
    type PM (IpePoint' a) = a
    toIpeObject (IpePoint p attrs) = Just $ Use p attrs

instance IsConvertableToIpeObject (IpePolyline' a) where
    type PM (IpePolyline' a) = a
    toIpeObject (IpePolyline lines attrs) =
        mkPath attrs . toLinearPath . concatMap points $ lines

instance IsConvertableToIpeObject (IpeSimplePolygon' a) where
    type PM (IpeSimplePolygon' a) = a
    toIpeObject (IpeSimplePolygon pts attrs) =
        mkPath attrs . mkPolygonOps $ pts

instance IsConvertableToIpeObject (IpeMultiPolygon' a) where
    type PM (IpeMultiPolygon' a) = a
    toIpeObject (IpeMultiPolygon pls attrs) =
        mkPath attrs . concatMap (mkPolygonOps . points) $ pls


instance IsConvertableToIpeObject (IGC a) where
    type PM (IGC a) = a
    toIpeObject gc = case obs of
                       [] -> Nothing
                       _  -> Just $ 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 -> IpeDocument a -> IpeDocument a
-- addViewToDrawing v (IpeDoc pre sty [])      = IpeDoc pre sty [addToPage v emptyPage]
-- addViewToDrawing v (IpeDoc pre sty (p:pgs)) = IpeDoc 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