module PathCommand where import Point import Data.List(groupBy) import Helpers (replace,isFloat) import Debug.Trace(trace) type Command = Char type Angle = Double data PathCommand = PathClosePath | PathMoveTo { pMoveTo :: Point } | PathLineTo { pLineTo :: Point } | PathHLineTo { pHLineTo :: Float } | PathVLineTo { pVLineTo :: Float } | PathCurveTo { pCurveToC1 :: Point , pCurveToC2 :: Point , pCurveTo :: Point } | PathShorthandCurveTo { pCurveToC2 :: Point , pCurveTo :: Point } | PathQuadraticCurveTo { pCurveToC :: Point , pCurveTo :: Point } | PathShorthandQuadraticCurveTo { pCurveTo :: Point } | PathEllipticalArc { pArcRX :: Float , pArcRY :: Float , pArcxRotation :: Angle , pArcLargeArcFlag :: Bool , pArcSweepFlag :: Bool , pArcTo :: Point } | PathNothingYet deriving (Show, Eq) -- inserts spaces after each path-command-character sanatize :: String -> String sanatize s = let helper r "" = r helper r (x:xs) = if x `elem` "MmZzLlHhVvCcSsQqTtAa" then helper (r ++ (' ':x:" ")) xs else helper (r ++ (x:"")) xs in helper "" (replace s "," " ") createPathCommands:: Maybe String -> [PathCommand] createPathCommands Nothing = trace "Warning: createPathCommands got\ \ Nothing. Returning empty list" [] createPathCommands (Just s) = let x = createCmdAndArgList (words (sanatize s)) cpch [] = [] cpch input@(((x:_):_):[]) = if x `elem` "Zz" then [[PathClosePath]] else error ("Other command than\ \ \"Z\" supplied \ \with no arguments\ \ in Path:"++show input) cpch ((x:_):args:xs) = createCmds x args:cpch xs pc = concat (cpch x) in optimizePath (head pc) pc createCmds :: String -> [String] -> [PathCommand] createCmds _ [] = [] createCmds s@(c:_) (a0:as) | c =='H' = PathHLineTo (read a0):createCmds s as | c == 'V' = PathVLineTo (read a0):createCmds s as createCmds s@(c:_) (a0:a1:as) | c == 'M' = PathMoveTo (Point (read a0) (read a1)):createCmds s as | c == 'L' = PathLineTo (Point (read a0) (read a1)):createCmds s as | c == 'T' = PathShorthandQuadraticCurveTo (Point (read a0) (read a1)):createCmds s as createCmds s@(c:_) (a0:a1:a2:a3:as) | c == 'S' = PathShorthandCurveTo (Point (read a0) (read a1)) (Point (read a2) (read a3)):createCmds s as | c == 'Q' = PathQuadraticCurveTo (Point (read a0) (read a1)) (Point (read a2) (read a3)):createCmds s as createCmds s@(c:_) (a0:a1:a2:a3:a4:a5:as) | c == 'C' = PathCurveTo (Point (read a0) (read a1)) (Point (read a2) (read a3)) (Point (read a4) (read a5)):createCmds s as createCmds s@(c:_) (a0:a1:a2:a3:a4:a5:a6:as) | c == 'A' = PathNothingYet:createCmds s as createCmds s l = error $ "createCmd: Nothing \ \ matched for createCmds "++s++" "++show l createCmdAndArgList :: [String] -> [[String]] createCmdAndArgList = groupBy (\x y -> isFloat x == isFloat y) optimizePath :: PathCommand -> [PathCommand] -> [PathCommand] optimizePath (PathMoveTo x) (PathClosePath:[]) = [PathLineTo x] optimizePath _ (x:[]) = [x] optimizePath _ [] = [] optimizePath c (PathMoveTo x0:PathMoveTo x1: xs) = optimizePath c (PathMoveTo x1:xs) optimizePath c (x@(PathCurveTo c1 c2 p1):PathShorthandCurveTo sc2 sp1:xs) = x : optimizePath c (PathCurveTo (reflect c2 p1) sc2 sp1:xs) optimizePath c (x@(PathQuadraticCurveTo c0 p0):PathShorthandQuadraticCurveTo p1:xs) = x : optimizePath c (PathQuadraticCurveTo (reflect c0 p0) p1:xs) optimizePath c (x:xs) = x : optimizePath c xs