rasterific-svg 0.2 → 0.2.2

raw patch · 4 files changed

+116/−7 lines, 4 filesdep ~lensPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: lens

API changes (from Hackage documentation)

Files

• changelog +6/−0
• rasterific-svg.cabal +3/−3
• src/Graphics/Rasterific/Svg/PathConverter.hs +106/−3
• src/Graphics/Rasterific/Svg/RenderContext.hs +1/−1

@@ -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 

@@ -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

@@ -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) 

@@ -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