{-# Language TypeFamilies #-} module Data.Geometry.Ipe.ReadIpeGeometry( IsConvertableToIGC(..) -- , perPage -- , perView -- , perView' -- , layer' -- , findLayer ) where import Data.Geometry.Point import Data.Geometry.Line hiding (length, PM) import Data.Geometry.Polygon import Data.Geometry.Geometry import Data.Geometry.Ipe.IGC(IGC) import Data.Geometry.Ipe.InternalTypes import Data.Geometry.Ipe.IpeGeometryTypes import Data.List.Split import Data.Maybe import Data.Monoid import qualified Data.Geometry.Ipe.IGC as IGC ----------------------------------------------------------------------------------- -- | Typeclass expressing which ipetypes we can convert into a IGC -- | minimal implementation: toIGC class IsConvertableToIGC t where type PM t toIGC :: t -> IGC (PM t) listToIGC :: [t] -> IGC (PM t) listToIGC = foldr (mappend . toIGC) IGC.empty perEntry :: [t] -> [(t, IGC (PM t))] perEntry = map (\e -> (e, toIGC e)) instance IsConvertableToIGC (IpeFile a) where type PM (IpeFile a) = a toIGC = listToIGC . ipePages instance IsConvertableToIGC (IpePage a) where type PM (IpePage a) = a toIGC (IpePage _ _ obs) = listToIGC obs -- instance IsConvertableToIGC (ViewInstance a) where -- type PM (ViewInstance a) = a -- toIGC = listToIGC . layers -- instance IsConvertableToIGC (Layer a) where -- type PM (Layer a) = a -- toIGC = layerContent ----------------------------------------------------------------------------------- -- the most interesting one is an ipe object. Since this is where all the work -- really happens. instance IsConvertableToIGC (IpeObject a) where type PM (IpeObject a) = a -- todo: we still may need to apply a transformation matrix (in case of the group) toIGC o@(Path ops _) = case determineType ops of TPolyline -> singleton' . toPolyLine' $ o TSimplePolygon -> singleton' . toSimplePolygon $ o TMultiPolygon -> singleton' . toMultiPolygon $ o TOther -> IGC.empty where singleton' (Just g) = IGC.singleton g singleton' Nothing = IGC.empty toIGC (Group obs attrs) = listToIGC obs toIGC (Use p attrs) = IGC.singleton $ IpePoint p attrs toIGC (IpeText _ _) = IGC.empty ----------------------------------------------------------------------------------- -- | Stuff to determine the type of an IpeObject data GeometryType = TPolyline | TSimplePolygon |TMultiPolygon | TOther deriving (Eq,Show) determineType :: [Operation a] -> GeometryType determineType ops | numClose == 0 && allLinear = TPolyline | numClose == 1 && allLinear = TSimplePolygon | allLinear = TMultiPolygon | otherwise = TOther -- for the time being we only know these ones where numClose = length $ filter isClose ops allLinear = all isLinear ops isLinear (LineTo _) = True isLinear (MoveTo _) = True isLinear ClosePath = True isLinear _ = False isClose :: Operation a -> Bool isClose ClosePath = True isClose _ = False ----------------------------------------------------------------------------------- -- | Convert an ipe object into a X -- | to a polyline toPolyLine' :: IpeObject a -> Maybe (IpePolyline' a) toPolyLine' (Path ops attrs) = if null pts then Nothing else Just $ IpePolyline lines attrs where pts = mapMaybe getPoint ops (Polyline2 lines) = polyLine pts toPolyLine' _ = Nothing -- | to a polygon toSimplePolygon :: IpeObject a -> Maybe (IpeSimplePolygon' a) toSimplePolygon (Path ops attrs) = Just $ IpeSimplePolygon (mapMaybe getPoint ops) attrs toSimplePolygon _ = Nothing toMultiPolygon :: IpeObject a -> Maybe (IpeMultiPolygon' a) toMultiPolygon (Path ops attrs) = Just $ IpeMultiPolygon polygons attrs where parts = splitWhen isClose ops polygons = map (SimplePolygon . mapMaybe getPoint) parts toMultiPolygon _ = Nothing -- | helper to extract a point from an operation getPoint :: Operation a -> Maybe (Point2' a) getPoint (MoveTo p) = Just p getPoint (LineTo p) = Just p getPoint _ = Nothing