ReadIpeGeometry.hs

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

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