ReadIpeGeometry.hs

{-# 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