waterfall-cad-svg 0.5.0.0 → 0.5.0.1
raw patch · 3 files changed
+43/−33 lines, 3 filesdep ~opencascade-hsdep ~waterfall-cadPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: opencascade-hs, waterfall-cad
API changes (from Hackage documentation)
Files
- CHANGELOG.md +9/−1
- src/Waterfall/SVG/ToSVG.hs +31/−29
- waterfall-cad-svg.cabal +3/−3
CHANGELOG.md view
@@ -8,4 +8,12 @@ ## Unreleased -## 0.1.0.0 - YYYY-MM-DD+## 0.5.0.1++### Changed++- Svg Path segments that originate from the same edge should no longer contain breaks++## 0.5.0.0++- Initial Release
src/Waterfall/SVG/ToSVG.hs view
@@ -11,7 +11,7 @@ import qualified Waterfall import qualified Graphics.Svg as Svg import qualified Graphics.Svg.CssTypes as Svg.Css-import Linear (_xy, _x, _y)+import Linear (_xy, _x, _y, V2 (..), nearZero) import Control.Lens ((^.), (&), (.~)) import Foreign.Ptr (Ptr) import Control.Monad ((<=<)) @@ -39,10 +39,9 @@ lineToPathCommand :: Ptr TopoDS.Edge -> IO [Svg.PathCommand] lineToPathCommand edge = do- (s, e) <- Internal.Edges.edgeEndpoints edge+ (_s, e) <- Internal.Edges.edgeEndpoints edge return - [ Svg.MoveTo Svg.OriginAbsolute . pure $ s ^. _xy- , Svg.LineTo Svg.OriginAbsolute . pure $ e ^. _xy+ [ Svg.LineTo Svg.OriginAbsolute . pure $ e ^. _xy ] bezierCurveToPathCommand :: Ptr TopoDS.Edge -> Ptr (Handle Geom.BezierCurve) -> Acquire [Svg.PathCommand]@@ -54,18 +53,12 @@ else do poles <- traverse ((liftIO . gpPntToV3) <=< Geom.BezierCurve.pole bezier) [1..nbPoles] case poles of - [s, e] -> return- [ Svg.MoveTo Svg.OriginAbsolute . pure $ s ^. _xy- , Svg.LineTo Svg.OriginAbsolute . pure $ e ^. _xy- ]- [s, cp, e] -> return- [ Svg.MoveTo Svg.OriginAbsolute . pure $ s ^. _xy- , Svg.QuadraticBezier Svg.OriginAbsolute . pure $ (cp ^. _xy, e ^. _xy)- ]- [s, cp1, cp2, e] -> return- [ Svg.MoveTo Svg.OriginAbsolute . pure $ s ^. _xy- , Svg.CurveTo Svg.OriginAbsolute . pure $ (cp1 ^. _xy, cp2 ^. _xy, e ^. _xy)- ]+ [_s, e] -> return . pure .+ Svg.LineTo Svg.OriginAbsolute . pure $ e ^. _xy+ [_s, cp, e] -> return . pure .+ Svg.QuadraticBezier Svg.OriginAbsolute . pure $ (cp ^. _xy, e ^. _xy)+ [_s, cp1, cp2, e] -> return . pure .+ Svg.CurveTo Svg.OriginAbsolute . pure $ (cp1 ^. _xy, cp2 ^. _xy, e ^. _xy) _ -> liftIO $ discretizedEdgePathCommand edge bezierToPathCommand :: Ptr TopoDS.Edge -> Ptr BRepAdaptor.Curve.Curve -> Acquire [Svg.PathCommand]@@ -110,22 +103,28 @@ discretizedEdgePathCommand :: Ptr TopoDS.Edge -> IO [Svg.PathCommand] discretizedEdgePathCommand edge = do- s <- Internal.Edges.edgeValue edge 0 ps <- traverse (Internal.Edges.edgeValue edge . (/10) . fromIntegral) [1..(10::Integer)]- return - [ Svg.MoveTo Svg.OriginAbsolute . pure $ s ^. _xy- , Svg.LineTo Svg.OriginAbsolute $ (^. _xy) <$> ps- ]+ return . pure .+ Svg.LineTo Svg.OriginAbsolute $ (^. _xy) <$> ps -edgeToPathCommand :: Ptr TopoDS.Edge -> [Svg.PathCommand]-edgeToPathCommand edge = Internal.Finalizers.unsafeFromAcquire $ do+edgeToPathCommand :: Maybe (V2 Double) -> Ptr TopoDS.Edge -> (Maybe (V2 Double), [Svg.PathCommand])+edgeToPathCommand curPos edge = Internal.Finalizers.unsafeFromAcquire $ do+ startPos <- liftIO $ (^. _xy) <$> Internal.Edges.edgeValue edge 0+ endPos <- liftIO $ (^. _xy) <$> Internal.Edges.edgeValue edge 1+ let hasntMoved = nearZero . (startPos -) <$> curPos+ let addMoveCommand = + case hasntMoved of + Just True -> id+ _ -> ((Svg.MoveTo Svg.OriginAbsolute . pure $ startPos) :) adaptor <- BRepAdaptor.Curve.fromEdge edge curveType <- liftIO $ BRepAdaptor.Curve.curveType adaptor- case curveType of - GeomAbs.CurveType.Line -> liftIO $ lineToPathCommand edge- GeomAbs.CurveType.BezierCurve -> bezierToPathCommand edge adaptor- -- GeomAbs.CurveType.BSplineCurve -> There's some argument for special casing this, but we don't need to- _ -> approximateCurveToPathCommand edge+ thisSegment <-+ case curveType of + GeomAbs.CurveType.Line -> liftIO $ lineToPathCommand edge+ GeomAbs.CurveType.BezierCurve -> bezierToPathCommand edge adaptor+ -- GeomAbs.CurveType.BSplineCurve -> There's some argument for special casing this, but we don't need to+ _ -> approximateCurveToPathCommand edge+ return (Just endPos, addMoveCommand thisSegment) -- | Convert a `Waterfall.Path2D` into a list of `Svg.PathCommands` path2DToPathCommands :: Waterfall.Path2D -> [Svg.PathCommand]@@ -134,7 +133,10 @@ Internal.Path.Common.SinglePointRawPath _ -> [] Internal.Path.Common.ComplexRawPath wire -> Internal.Finalizers.unsafeFromAcquireT $- foldMap edgeToPathCommand <$> Internal.Edges.wireEdges wire+ mconcat + . fmap snd+ . scanr (flip (edgeToPathCommand . fst)) (Nothing, []) + <$> Internal.Edges.wireEdges wire -- | Convert a `Waterfall.Diagram` into an SVG document --
waterfall-cad-svg.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: waterfall-cad-svg-version: 0.5.0.0+version: 0.5.0.1 synopsis: Declarative CAD/Solid Modeling Library, SVG Support description: Please see the README on GitHub at <https://github.com/joe-warren/opencascade-hs#readme> category: Graphics@@ -42,9 +42,9 @@ , base >=4.7 && <5 , lens >5 && <6 , linear >=1.0 && <2.0- , opencascade-hs >=0.5.0.0 && <0.6+ , opencascade-hs >=0.5.0.1 && <0.6 , resourcet >=1.2 && <1.4 , svg-tree >=0.6 && <1.0 , text >=1.2 && <3.0- , waterfall-cad >=0.5.0.0 && <0.6+ , waterfall-cad >=0.5.0.1 && <0.6 default-language: Haskell2010