{-# 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