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
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))
instance IsConvertableToIGC IpeDrawing where
toIGC = listToIGC . pages
perPage :: IpeDrawing a -> [(Page a, IGC a)]
perPage = perEntry . pages
perView :: IpeDrawing a -> [(ViewInstance a, IGC a)]
perView = concatMap perView' . pages
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
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