module Data.Geometry.Ipe.ReadIpeGeometry( ipeViews , IsConvertableToIGC(..) , perPage , perView , perView' ) where import Data.Geometry.Point import Data.Geometry.Line hiding (length) import Data.Geometry.Polygon import Data.Geometry.Geometry import Data.Geometry.Ipe.IGC(IGC) import Data.Geometry.Ipe.IpeTypes import Data.Geometry.Ipe.IpeGeometryTypes import Data.Geometry.Ipe.IpeView 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 toIGC :: t a -> IGC a listToIGC :: [t a] -> IGC a listToIGC = foldr (mappend . toIGC) IGC.empty perEntry :: [t a] -> [(t a, IGC a)] perEntry = map (\e -> (e, toIGC e)) ----------------------------------------------------------------------------------- -- | Converting from IpeTypes instance IsConvertableToIGC IpeDrawing where toIGC = listToIGC . pages -- | Get the IGC's with objects stored per page perPage :: IpeDrawing a -> [(Page a, IGC a)] perPage = perEntry . pages -- | Get the IGC's with objects stored per view (for all views in the drawing) perView :: IpeDrawing a -> [(ViewInstance a, IGC a)] perView = concatMap perView' . pages -- | Get the IGC's with objects stored per view (for all views in the page) perView' :: Page a -> [(ViewInstance a, IGC a)] perView' = perEntry . ipeViews instance IsConvertableToIGC Page where toIGC (Page _ _ obs) = listToIGC obs instance IsConvertableToIGC ViewInstance where toIGC = listToIGC . layers instance IsConvertableToIGC Layer where toIGC = layerContent ipeViews :: Page a -> [ViewInstance a] ipeViews (Page _ vds obs) = map (\vd -> extend (ViewInstance vd [])) vds where addLayer' = addLayer . layer' obs extend vi = foldr addLayer' vi (layerNames . viewDef $ vi) layer' :: (HasAttributes (t a), IsConvertableToIGC t) => [t a] -> String -> Layer a layer' allObs lrName = Layer lrName (listToIGC obs) where obs = filter (hasAttrWithValue "layer" lrName) allObs instance IsConvertableToIGC IpeObject where -- 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