diff --git a/SVGPath.cabal b/SVGPath.cabal --- a/SVGPath.cabal +++ b/SVGPath.cabal @@ -1,12 +1,12 @@ Name: SVGPath -Version: 1.0.3 +Version: 1.1 Synopsis: Parsing the path command of SVG Description: Parsing the path command of SVG category: Graphics License: BSD3 License-file: LICENSE Author: Tillmann Vogt -Maintainer: Tillmann.Vogt@rwth-aachen.de +Maintainer: tillk.vogt@googlemail.com Build-Type: Simple Cabal-Version: >=1.6 @@ -14,6 +14,6 @@ hs-source-dirs: src build-depends: base == 4.*, - parsec == 3.1.* + parsec >= 2.1 && <= 3.1 exposed-modules: Graphics.SVG.ReadPath diff --git a/src/Graphics/SVG/ReadPath.hs b/src/Graphics/SVG/ReadPath.hs --- a/src/Graphics/SVG/ReadPath.hs +++ b/src/Graphics/SVG/ReadPath.hs @@ -4,7 +4,7 @@ -- Copyright : (c) 2011 Tillmann Vogt -- License : BSD3 -- --- Maintainer: Tillmann Vogt +-- Maintainer: Tillmann Vogt -- Stability : stable -- Portability: portable -- @@ -21,9 +21,11 @@ import Text.ParserCombinators.Parsec hiding (spaces) import Text.ParserCombinators.Parsec.Expr +import Text.ParserCombinators.Parsec.Prim import qualified Text.ParserCombinators.Parsec.Token as P -import Text.ParserCombinators.Parsec.Language( javaStyle ) +import Text.ParserCombinators.Parsec.Language(emptyDef) import System.IO.Unsafe (unsafePerformIO) +import Debug.Trace type X = Float type Y = Float @@ -74,8 +76,7 @@ spaces = skipMany space path :: Parser [PathCommand] -path = do{ whiteSpace - ; l <- many1 pathElement +path = do{ l <- many pathElement ; eof ; return (concat l) } @@ -104,28 +105,31 @@ do{ symbol "a"; l <- many1 tupel2; return (map (\x-> A_rel) l) } -- not used } +comma = do{ spaces; try (do { (char ','); return () }) <|> spaces } + tupel2 :: Parser (X,Y) -tupel2 = do{ x <- myfloat; spaces; y <- myfloat; spaces; - ; return (realToFrac x, realToFrac y) +tupel2 = do{ x <- myfloat; comma; y <- myfloat; spaces; + return (realToFrac x, realToFrac y) } tupel4 :: Parser (X,Y,X,Y) -tupel4 = do{ x1 <- myfloat; spaces; y1 <- myfloat; spaces; x <- myfloat; spaces; y <- myfloat; spaces; - ; return (realToFrac x1, realToFrac y1, realToFrac x, realToFrac y) +tupel4 = do{ x1 <- myfloat; comma; y1 <- myfloat; spaces; + x <- myfloat; comma; y <- myfloat; spaces; + return (realToFrac x1, realToFrac y1, realToFrac x, realToFrac y) } tupel6 :: Parser (X,Y,X,Y,X,Y) -tupel6 = do{ x1 <- myfloat; spaces; y1 <- myfloat; spaces; - x2 <- myfloat; spaces; y2 <- myfloat; spaces; x <- myfloat; spaces; y <- myfloat; spaces; - ; return (realToFrac x1, realToFrac y1, realToFrac x2, realToFrac y2, realToFrac x, realToFrac y) +tupel6 = do{ x1 <- myfloat; comma; y1 <- myfloat; spaces; + x2 <- myfloat; comma; y2 <- myfloat; spaces; + x <- myfloat; comma; y <- myfloat; spaces; + return (realToFrac x1, realToFrac y1, realToFrac x2, realToFrac y2, realToFrac x, realToFrac y) } myfloat = try (do{ symbol "-"; n <- float; return (negate n) }) <|> - try float <|> -- 0 is not recognized as a float, so recognize it as an integer and then convert it to float + try float <|> -- 0 is not recognized as a float, so recognize it as an integer and then convert to float do { i<-integer; return(fromIntegral i) } -lexer = P.makeTokenParser oDef -oDef = javaStyle +lexer = P.makeTokenParser emptyDef whiteSpace = P.whiteSpace lexer symbol = P.symbol lexer @@ -134,51 +138,60 @@ ------------------------------------------- -- | convert path-commands to outline points -commandsToPoints :: [PathCommand] -> F2 -> [[F2]] -commandsToPoints commands (dx, dy) | length result == 0 = [] - | otherwise = result - where result = ctp commands [(0,0)] (0,0) False 255 (dx,dy) +commandsToPoints :: [PathCommand] -> F2 -> F2 -> [[F2]] +commandsToPoints commands (dx, dy) (offsetX, offsetY) | null result = [] + | otherwise = result + where result = ctp commands [(0,0)] (0,0) False (dx,dy) (offsetX, offsetY) -ctp :: [PathCommand] -> [F2] -> F2 -> Bool -> Int -> F2 -> [[F2]] +ctp :: [PathCommand] -> [F2] -> F2 -> Bool -> F2 -> F2 -> [[F2]] ctp [] _ _ _ _ _ = [] -ctp (c:commands) points lastContr useTex n (dx, dy) -- dx, dy is the size of a pixel, used for rasterisation - | (length nextPoints) == 0 = [tail $ tail points] ++ -- one outline completed - ( ctp commands [] (contr c) useTex nminus (dx,dy) ) - | otherwise = ctp commands (points ++ (tail nextPoints)) (contr c) useTex nminus (dx,dy) - where nminus = if n>0 then n-1 else 0 - nextPoints = (go c) - contr ( C_abs (x1,y1,x2,y2,x,y) ) = ( (x+x-x2)/dx, (y+y-y2)/dy ) -- control point of bezier curve - contr ( C_rel (x1,y1,x2,y2,x,y) ) = (x0+(x+x-x2)/dx, y0+(y+y-y2)/dy ) - contr ( S_abs (x2,y2,x,y) ) = ( (x+x-x2)/dx, (y+y-y2)/dy ) - contr ( S_rel (x2,y2,x,y) ) = (x0+(x+x-x2)/dx, y0+(y+y-y2)/dy ) - contr ( Q_abs (x1,y1,x,y) ) = ( (x+x-x1)/dx, (y+y-y1)/dy ) - contr ( Q_rel (x1,y1,x,y) ) = (x0+(x+x-x1)/dx, y0+(y+y-y1)/dy ) - contr ( T_abs (x,y) ) = ( (x+x)/dx-cx, (y+y)/dy - cy ) - contr ( T_rel (x,y) ) = ( 2*(x0+x/dx)-cx, 2*(y0+y/dy)-cy ) -- absolute coordinates - contr ( L_abs (x,y) ) = ( x/dx, y/dy) - contr ( L_rel (x,y) ) = (x0 + x/dx, y0 + y/dy) - contr ( M_abs (x,y) ) = ( x/dx, y/dy) - contr ( M_rel (x,y) ) = (x0 + x/dx, y0 + y/dy) - contr ( H_abs x ) = ( x/dx, y0 ) - contr ( H_rel x ) = (x0 + x/dx, y0 ) - contr ( V_abs y ) = (x0, y/dy ) - contr ( V_rel y ) = (x0, y0 + y/dy ) - go ( L_abs (x,y) ) = bsub [(x0,y0), (x/dx, y/dy)] - go ( L_rel (x,y) ) = bsub [(x0,y0), (x0 + x/dx, y0 + y/dy)] - go ( M_abs (x,y) ) = [(0, 0), (x/dx, y/dy)] - go ( M_rel (x,y) ) = [(0, 0), (x0 + x/dx, y0 + y/dy)] - go ( H_abs x) = bsub [(x0,y0), (x/dx, y0)] - go ( H_rel x) = bsub [(x0,y0), (x0 + x/dx, y0)] - go ( V_abs y) = bsub [(x0,y0), (x0, y/dy)] - go ( V_rel y) = bsub [(x0,y0), (x0, y0 + y/dy)] - go ( C_abs (x1,y1,x2,y2,x,y) ) = bsub [(x0, y0), (x1/dx, y1/dy), (x2/dx, y2/dy), (x/dx, y/dy)] - go ( C_rel (x1,y1,x2,y2,x,y) ) = bsub [(x0, y0), (x0+x1/dx, y0+y1/dy), (x0+x2/dx,y0+y2/dy), (x0+x/dx,y0+y/dy)] - go ( S_abs ( x2,y2,x,y) ) = bsub [(x0, y0), (cx, cy), (x2/dx, y2/dy), (x/dx, y/dy) ] - go ( S_rel ( x2,y2,x,y) ) = bsub [(x0, y0), (cx, cy), (x0 + x2/dx, y0 + y2/dy), (x0 + x/dx, y0 + y/dy)] - go ( Q_abs (x1,y1,x,y) ) = bsub [(x0, y0), (x1/dx, y1/dy), (x/dx, y/dy)] - go ( Q_rel (x1,y1,x,y) ) = bsub [(x0, y0), (x0 + x1/dx, y0 + y1/dy), (x0 + x/dx, y0 + y/dy)] - go ( T_abs (x,y) ) = bsub [(x0,y0), (cx, cy), (x/dx, y/dy) ] - go ( T_rel (x,y) ) = bsub [(x0,y0), (cx, cy), (x0 + x/dx, y0 + y/dy)] +ctp (c:commands) points lastContr useTex (dx, dy) (ox,oy) -- dx, dy is the size of a pixel, used for rasterisation + -- one outline completed + | null nextPoints = [tail points] ++ (if useTex && unequal dx dy (last points) (head points) + -- add a line from the last point to the first point + then [( go (L_abs (head (tail points))) )] + else []) ++ + ( ctp commands [(0,0)] (contr c) useTex (dx,dy) (ox,oy)) + | otherwise = ctp commands (points ++ (tail nextPoints)) (contr c) useTex (dx,dy) (ox,oy) -- work on outline + where nextPoints = (go c) + contr ( C_abs (x1,y1,x2,y2,x,y) ) = ( x+x-x2, y+y-y2 ) -- control point of bezier curve + contr ( C_rel (x1,y1,x2,y2,x,y) ) = (x0+x+x-x2, y0+y+y-y2 ) + contr ( S_abs (x2,y2,x,y) ) = ( x+x-x2, y+y-y2 ) + contr ( S_rel (x2,y2,x,y) ) = (x0+x+x-x2, y0+y+y-y2 ) + contr ( Q_abs (x1,y1,x,y) ) = ( x+x-x1, y+y-y1 ) + contr ( Q_rel (x1,y1,x,y) ) = (x0+x+x-x1, y0+y+y-y1 ) + contr ( T_abs (x,y) ) = ( x+x-cx, y+y-cy ) + contr ( T_rel (x,y) ) = ( 2*(x0+x)-cx, 2*(y0+y)-cy ) -- absolute coordinates + contr ( L_abs (x,y) ) = ( x, y) + contr ( L_rel (x,y) ) = (x0 + x, y0 + y) + contr ( M_abs (x,y) ) = ( x, y) + contr ( M_rel (x,y) ) = (x0 + x, y0 + y) + contr ( H_abs x ) = ( x, y0 ) + contr ( H_rel x ) = (x0 + x, y0 ) + contr ( V_abs y ) = (x0, y ) + contr ( V_rel y ) = (x0, y0 + y ) + go ( M_abs (x,y) ) = [(0, 0), (x + ox, y + oy)] + go ( M_rel (x,y) ) = [(0, 0), (x0 + x + ox, y0 + y + oy)] + go ( L_abs (x,y) ) | useTex = bsub [(x0,y0), (x, y)] + | otherwise = [(x0,y0), (x, y)] + go ( L_rel (x,y) ) | useTex = bsub [(x0,y0), (x0 + x, y0 + y)] + | otherwise = [(x0,y0), (x0 + x, y0 + y)] + go ( H_abs x) | useTex = bsub [(x0,y0), (x, y0)] + | otherwise = [(x0,y0), (x, y0)] + go ( H_rel x) | useTex = bsub [(x0,y0), (x0 + x, y0)] + | otherwise = [(x0,y0), (x0 + x, y0)] + go ( V_abs y) | useTex = bsub [(x0,y0), (x0, y)] + | otherwise = [(x0,y0), (x0, y)] + go ( V_rel y) | useTex = bsub [(x0,y0), (x0, y0 + y)] + | otherwise = [(x0,y0), (x0, y0 + y)] + go ( C_abs (x1,y1,x2,y2,x,y) ) = bsub [(x0, y0), (x1, y1), (x2, y2), (x, y)] + go ( C_rel (x1,y1,x2,y2,x,y) ) = bsub [(x0, y0), (x0+x1, y0+y1), (x0+x2,y0+y2), (x0+x,y0+y)] + go ( S_abs ( x2,y2,x,y) ) = bsub [(x0, y0), (cx, cy), (x2, y2), (x, y) ] + go ( S_rel ( x2,y2,x,y) ) = bsub [(x0, y0), (cx, cy), (x0 + x2, y0 + y2), (x0 + x, y0 + y)] + go ( Q_abs (x1,y1,x,y) ) = bsub [(x0, y0), (x1, y1), (x, y)] + go ( Q_rel (x1,y1,x,y) ) = bsub [(x0, y0), (x0 + x1, y0 + y1), (x0 + x, y0 + y)] + go ( T_abs (x,y) ) = bsub [(x0,y0), (cx, cy), (x, y) ] + go ( T_rel (x,y) ) = bsub [(x0,y0), (cx, cy), (x0 + x, y0 + y)] go ( Z ) = [] x0 = fst (last points) y0 = snd (last points) @@ -186,6 +199,8 @@ cy = (snd lastContr) bsub xs = bSubCurve useTex (dx,dy) xs + unequal dx dy (x0,y0) (x1,y1) | (abs (x0-x1) < dx/4) && (abs (y0-y1) < dy/4) = False + | otherwise = True ----------------- -- bezier-curves @@ -207,11 +222,10 @@ -- This function computes outline points (tex==False) as well as border points for rasterisation (tex==True) by using -- an x-, y-resoultion raster. dx, dy is the width and height of a pixel of this raster. bSubCurve :: Bool -> (X,Y) -> [F2] -> [F2] -bSubCurve useTex (dx,dy) bs | ((abs (p1x-p0x)) < dx && (abs (p1y-p0y)) < dy && (not useTex)) || -- line that is at most one pixel long - ((dx == 0 || dy == 0) && (not useTex)) || - ((abs (p1x-p0x)) < 1 && (abs (p1y-p0y)) < 1 && useTex) || - ((abs (p1x-p0x)) < 1 && p0x_int == p1x_int && useTex) || -- vertical line - ((abs (p1y-p0y)) < 1 && p0y_int == p1y_int && useTex) -- horizontal line +bSubCurve useTex (dx,dy) bs | ( (abs (p1x_int-p0x_int)) == 1 && (abs (p1y_int-p0y_int)) == 1 ) || -- at most one point per pixel + ( (abs (p1x-p0x)) < dx && (abs (p1y-p0y)) < dy ) || + ( (abs (p1x-p0x)) < dx && p0x_int == p1x_int && useTex ) || -- vertical line + ( (abs (p1y-p0y)) < dy && p0y_int == p1y_int && useTex ) -- horizontal line = [ (p0x, p0y), (p1x, p1y) ] | otherwise = firstArc ++ (tail secondArc) -- subdivide @@ -222,7 +236,7 @@ (p0x, p0y) = head bs (p1x, p1y) = last bs - (p0x_int, p0y_int) | p0y < p1y = (truncate p0x, truncate p0y) - | otherwise = (truncate p1x, truncate p1y) - (p1x_int, p1y_int) | p0y < p1y = (truncate p1x, truncate p1y) - | otherwise = (truncate p0x, truncate p0y) + (p0x_int, p0y_int) | p0y < p1y = (truncate (p0x/dx), truncate (p0y/dy)) + | otherwise = (truncate (p1x/dx), truncate (p1y/dy)) + (p1x_int, p1y_int) | p0y < p1y = (truncate (p1x/dx), truncate (p1y/dy)) + | otherwise = (truncate (p0x/dx), truncate (p0y/dy))