I implemented W3s recommended algorithm for converting SVG-path arcs from endpoint-arcs to center-arcs and back in Haskell.
type EndpointArc = ( Double, Double, Double, Double
, Bool, Bool, Double, Double, Double )
type CenterArc = ( Double, Double, Double, Double
, Double, Double, Double )
endpointToCenter :: EndpointArc -> CenterArc
centerToEndpoint :: CenterArc -> EndpointArc
See full implementation and test-code here.
But I can't get this property to pass:
import Test.QuickCheck
import Data.AEq ((~==))
instance Arbitrary EndpointArc where
arbitrary = do
((x1,y1),(x2,y2)) <- arbitrary `suchThat` (\(u,v) -> u /= v)
rx <- arbitrary `suchThat` (>0)
ry <- arbitrary `suchThat` (>0)
phi <- choose (0,2*pi)
(fA,fS) <- arbitrary
return $ correctRadiiSize (x1, y1, x2, y2, fA, fS, rx, ry, phi)
prop_conversionRetains :: EndpointArc -> Bool
prop_conversionRetains earc =
let result = centerToEndpoint (endpointToCenter earc)
in earc ~== result
Sometimes this is due to floating point errors (which seem to exceed ieee754) but sometimes there are NaNs in the result.
(NaN,NaN,NaN,NaN,False,False,1.0314334509082723,2.732814841776921,1.2776112657142984)
Which indicates there is no solution although I think I scale rx,ry as described in F.6.6.2 in W3's document.
import Numeric.Matrix
m :: [[Double]] -> Matrix Double
m = fromList
toTuple :: Matrix Double -> (Double, Double)
toTuple = (\[[x],[y]] -> (x,y)) . toList
primed :: Double -> Double -> Double -> Double -> Double
-> (Double, Double)
primed x1 y1 x2 y2 phi = toTuple $
m [[ cos phi, sin phi]
,[-sin phi, cos phi]
]
* m [[(x1 - x2)/2]
,[(y1 - y2)/2]
]
correctRadiiSize :: EndpointArc -> EndpointArc
correctRadiiSize (x1, y1, x2, y2, fA, fS, rx, ry, phi) =
let (x1',y1') = primed x1 y1 x2 y2 phi
lambda = (x1'^2/rx^2) + (y1'^2/ry^2)
(rx',ry') | lambda <= 1 = (rx, ry)
| otherwise = ((sqrt lambda) * rx, (sqrt lambda) * ry)
in (x1, y1, x2, y2, fA, fS, rx', ry', phi)