SVG2Q-0.3: PathCommand.hs

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