module Data.Geometry.Ipe.IpeGeometry( RunWith(..)
, runSimple
, runSimple'
, runSimpleIO
, runSimpleIO'
) where
import Data.Monoid
import Data.Geometry.Ipe.IpeTypes
import Data.Geometry.Ipe.IpeView
import Data.Geometry.Ipe.IGC(IGC)
import Data.Geometry.Ipe.ReadIpeGeometry
import Data.Geometry.Ipe.WriteIpeGeometry
import Data.Geometry.Ipe.Pickle
class IsConvertableToIGC c => RunWith c where
replaceIGC :: Eq a => IGC a -> c a -> c a
extend :: Eq a => IGC a -> c a -> c a
runAndReplace :: Eq a => (IGC a -> IGC a) -> c a -> c a
runAndReplace f o = let gc' = f . toIGC $ o in
replaceIGC gc' o
runWith :: Eq a => (IGC a -> IGC a) -> c a -> c a
runWith = runAndReplace
runAndExtend :: Eq a => (IGC a -> IGC a) -> c a -> c a
runAndExtend f o = let gc = toIGC o
gc' = f gc in
extend (gc `mappend` gc') o
instance RunWith Layer where
replaceIGC gc (Layer n _) = Layer n gc
extend gc (Layer n _) = Layer (n++"'") gc
instance RunWith ViewInstance where
replaceIGC gc v = let l@(Layer n _) = head . layers $ v in
ViewInstance (ViewDefinition [n] n) [replaceIGC gc l]
extend gc v = let l = head . layers $ v in
addLayer (extend gc l) v
instance RunWith Page where
replaceIGC gc _ = Page [] [] (toIpeObjects' gc)
extend gc p = let v = head . ipeViews $ p in
addToPage (extend gc v) p
instance RunWith IpeDrawing where
replaceIGC gc (Ipe pre sty []) = Ipe pre sty [extend gc emptyPage]
replaceIGC gc (Ipe pre sty (p:_)) = Ipe pre sty [replaceIGC gc p]
extend gc (Ipe pre sty []) = Ipe pre sty [extend gc emptyPage]
extend gc (Ipe pre sty (p:pgs)) = Ipe pre sty $ extend gc p : pgs
runSimple :: Eq a => (IGC a -> IGC a) -> IpeDrawing a -> IpeDrawing a
runSimple = runAndExtend
runSimple' :: (IGC a -> b) -> IpeDrawing a -> b
runSimple' f = f . toIGC
runSimpleIO :: (Eq a, Coordinate a) =>
(IGC a -> IGC a) -> FilePath -> IO (IpeDrawing a)
runSimpleIO f = fmap (runSimple f) . loadDrawing
runSimpleIO' :: (Eq a, Coordinate a) =>
(IGC a -> IGC a) -> FilePath -> FilePath -> IO ()
runSimpleIO' f inPath outPath = do
d <- loadDrawing inPath
storeDrawing (runSimple f d) outPath