diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,5 +1,11 @@ -*-change-log-*- +v0.2.2 + * Fix: lens upper bound, and removing it. + +v0.2.1 + * Adding: support for arc in path + v0.2 April 2015 * Bumping: using svg-tree 0.3 diff --git a/rasterific-svg.cabal b/rasterific-svg.cabal --- a/rasterific-svg.cabal +++ b/rasterific-svg.cabal @@ -1,7 +1,7 @@ -- Initial svg.cabal generated by cabal init. For further documentation, -- see http://haskell.org/cabal/users-guide/ name: rasterific-svg -version: 0.2 +version: 0.2.2 synopsis: SVG renderer based on Rasterific. description: SVG renderer that will let you render svg-tree parsed SVG file to a JuicyPixel image or Rasterific Drawing. @@ -22,7 +22,7 @@ Source-Repository this Type: git Location: git://github.com/Twinside/rasterific-svg.git - Tag: v0.2 + Tag: v0.2.2 library hs-source-dirs: src @@ -47,7 +47,7 @@ , Rasterific >= 0.5.2.1 && < 0.6 , FontyFruity >= 0.5 && < 0.6 , svg-tree >= 0.3 && < 0.4 - , lens >= 4.5 && < 4.10 + , lens >= 4.5 && < 5 , linear >= 1.16 , vector >= 0.10 , text >= 1.2 diff --git a/src/Graphics/Rasterific/Svg/PathConverter.hs b/src/Graphics/Rasterific/Svg/PathConverter.hs --- a/src/Graphics/Rasterific/Svg/PathConverter.hs +++ b/src/Graphics/Rasterific/Svg/PathConverter.hs @@ -16,8 +16,10 @@ , nearZero , zero ) import qualified Graphics.Rasterific as R +import Linear( dot, (!*!), (!*), V2( V2 ), scaled ) import qualified Linear as L import Graphics.Svg.Types +import Graphics.Rasterific.Svg.RenderContext singularize :: [PathCommand] -> [PathCommand] singularize = concatMap go @@ -39,8 +41,11 @@ {-# INLINE toR #-} toR (L.V2 x y) = realToFrac <$> R.V2 x y +fromR :: R.Point -> RPoint +{-# INLINE fromR #-} +fromR (R.V2 x y) = realToFrac <$> L.V2 x y + svgPathToPrimitives :: Bool -> [PathCommand] -> [R.Primitive] -svgPathToPrimitives _ lst | isPathWithArc lst = [] svgPathToPrimitives shouldClose lst | shouldClose && not (nearZero $ norm (lastPoint ^-^ firstPoint)) = concat $ prims ++ [R.line lastPoint firstPoint] @@ -60,6 +65,7 @@ go o (SmoothCurveTo _ []) = (o, []) go o (QuadraticBezier _ []) = (o, []) go o (SmoothQuadraticBezierCurveTo _ []) = (o, []) + go o (EllipticalArc _ []) = (o, []) go (_, _, _) (MoveTo OriginAbsolute (p:_)) = ((p', p', p'), []) where p' = toR p @@ -129,9 +135,17 @@ where c1' = o ^* 2 ^-^ control e' = o ^+^ toR e - go _ (EllipticalArc _ _) = error "Unimplemented" + go acc@(o, _, _) (EllipticalArc OriginAbsolute (e:_)) = + (accFinal, mconcat outList) + where + (accFinal, outList) = mapAccumL go acc $ arcToSegments (fromR o) e + go back@(o,_,_) (EllipticalArc OriginRelative ((rx, ry, rot, f1, f2, p): _)) = + go back $ EllipticalArc OriginAbsolute [new] + where p' = p L.^+^ (fromR o) + new = (rx, ry, rot, f1, f2, p') + -- | Conversion function between svg path to the rasterific one. svgPathToRasterificPath :: Bool -> [PathCommand] -> R.Path svgPathToRasterificPath shouldClose lst = @@ -155,6 +169,7 @@ go o (SmoothCurveTo _ []) = (o, []) go o (QuadraticBezier _ []) = (o, []) go o (SmoothQuadraticBezierCurveTo _ []) = (o, []) + go o (EllipticalArc _ []) = (o, []) go (_, _, _) (MoveTo OriginAbsolute (p:_)) = ((pp, pp, pp), []) where pp = toR p @@ -224,5 +239,93 @@ where c1' = o ^* 2 ^-^ control e' = o ^+^ toR e - go _ (EllipticalArc _ _) = error "Unimplemented" + go back@(o, _, _) (EllipticalArc OriginAbsolute (com:_)) = (nextState, mconcat pathCommands) + where + (nextState, pathCommands) = + mapAccumL go back $ arcToSegments (fromR o) com + go back@(o, _, _) (EllipticalArc OriginRelative ((rx, ry, rot, f1, f2, p):_)) = + go back $ EllipticalArc OriginAbsolute [new] + where p' = p L.^+^ (fromR o) + new = (rx, ry, rot, f1, f2, p') + + +-- | Create a 2 dimensional rotation matrix given an angle +-- expressed in radians. +mkRotation :: Floating a => a -> L.M22 a +mkRotation angle = + L.V2 (L.V2 ca (-sa)) + (L.V2 sa ca) + where + ca = cos angle + sa = sin angle + +mkRota' :: Floating a => a -> L.M22 a +mkRota' angle = + L.V2 (L.V2 ca sa) + (L.V2 (-sa) ca) + where + ca = cos angle + sa = sin angle + +arcToSegments :: RPoint -> (Coord, Coord, Coord, Bool, Bool, RPoint) + -> [PathCommand] +arcToSegments orig (radX, radY, rotateX, large, sweep, pos) = + [segmentToBezier transBackward (V2 xc yc) th2 th3 + | (th2, th3) <- zip angleSampling $ tail angleSampling] + where + angleSampling = + [th0 + i * th_arc / fromIntegral segmentCount | i <- fromIntegral <$> [0 .. segmentCount]] + theta = toRadian rotateX + rotation = mkRota' theta + + V2 px py = + (mkRota' theta !* (orig L.^-^ pos)) ^* 0.5 + + (rx, ry) + | tmp > 1 = (rx' * sqtmp, ry' * sqtmp) + | otherwise = (rx', ry') + where + sqtmp = sqrt tmp + tmp = (px * px) / (rx' * rx') + (py * py) / (ry' * ry') + rx' = abs radX + ry' = abs radY + + transBackward = mkRotation theta !*! scaled (V2 rx ry) + trans = scaled (V2 (1 / rx) (1 / ry)) !*! rotation + + orig'@(V2 x0 y0) = trans !* orig + pos'@(V2 x1 y1) = trans !* pos + delta = pos' L.^-^ orig' + d = delta `dot` delta + + sfactor | sweep == large = - factor + | otherwise = factor + where + factor = sqrt . max 0 $ 1 / d - 0.25 + + xc = 0.5 * (x0 + x1) - sfactor * (y1-y0) + yc = 0.5 * (y0 + y1) + sfactor * (x1-x0) + + th0 = atan2 (y0 - yc) (x0 - xc) + th1 = atan2 (y1 - yc) (x1 - xc) + + th_arc | tmp < 0 && sweep = tmp + 2 * pi + | tmp > 0 && not sweep = tmp - 2 * pi + | otherwise = tmp + where + tmp = th1 - th0 + + segmentCount :: Int + segmentCount = ceiling . abs $ th_arc / (pi / 2 + 0.001) + +segmentToBezier :: L.M22 Coord -> RPoint -> Coord -> Coord -> PathCommand +segmentToBezier trans (V2 cx cy) th0 th1 = + CurveTo OriginAbsolute [(trans !* p1, trans !* p2, trans !* p3)] + where + th_half = 0.5 * (th1 - th0) + t = (8 / 3) * sin (th_half * 0.5) * sin (th_half * 0.5) / sin th_half + + p1 = V2 (cx + cos th0 - t * sin th0) (cy + sin th0 + t * cos th0) + p3@(V2 x3 y3) = V2 (cx + cos th1) (cy + sin th1) + p2 = V2 (x3 + t * sin th1) (y3 - t * cos th1) diff --git a/src/Graphics/Rasterific/Svg/RenderContext.hs b/src/Graphics/Rasterific/Svg/RenderContext.hs --- a/src/Graphics/Rasterific/Svg/RenderContext.hs +++ b/src/Graphics/Rasterific/Svg/RenderContext.hs @@ -42,7 +42,7 @@ import Graphics.Text.TrueType import Graphics.Svg.Types -toRadian :: Float -> Float +toRadian :: Floating a => a -> a toRadian v = v / 180 * pi data RenderContext = RenderContext