module Data.Geometry.Ipe.ReadIpeGeometry(
IsConvertableToIGC(..)
) 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
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 (IpeObject a) where
type PM (IpeObject a) = a
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
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
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
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
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
getPoint :: Operation a -> Maybe (Point2' a)
getPoint (MoveTo p) = Just p
getPoint (LineTo p) = Just p
getPoint _ = Nothing