waterfall-cad 0.0.0.1 → 0.1.0.0

raw patch · 8 files changed

+401/−277 lines, 8 filesdep ~opencascade-hsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: opencascade-hs

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• README.md +16/−0
• src/Waterfall.hs +31/−0
• src/Waterfall/Path.hs +55/−131
• src/Waterfall/Path/Common.hs +173/−0
• src/Waterfall/TwoD/Path2D.hs +63/−144
• src/Waterfall/TwoD/Text.hs +45/−0
• waterfall-cad.cabal +5/−2

@@ -8,4 +8,17 @@  ## Unreleased +## 0.1.0.0 - 2023-12-05 ++### Added++- Reexported all modules under top level `Waterfall` module+- Refactored common code in `Path` and `Path2D` into the `AnyPath` typeclass+- Added Waterfall.Text, containing text rendering functions++### Fixed++- Fix build on MacOS (tested with the homebrew install of OpenCASCADE)++ ## 0.0.0.1 - YYYY-MM-DD

@@ -1,1 +1,17 @@ # Waterfall CAD ++Waterfall CAD is a declarative CAD/Solid Modeling library.++This uses [opencascade-hs](https://hackage.haskell.org/package/opencascade-hs) as the kernel, but provides a "more functional" API over it.++## Dependencies ++You'll need the main OpenCASCADE libraries/header files installed to use this.++Please see the [main readme](https://github.com/joe-warren/opencascade-hs/#installing-dependencies) on Github for more information.++## Examples++There are examples of how to use the library in [waterfall-cad-examples](https://hackage.haskell.org/package/waterfall-cad-examples).++You can see images of these examples in the [main readme](https://github.com/joe-warren/opencascade-hs/#examples) on Github.

@@ -0,0 +1,31 @@+module Waterfall +( module Waterfall.Booleans+, module Waterfall.Booleans.Operators+, module Waterfall.Fillet+, module Waterfall.IO+, module Waterfall.Path.Common+, module Waterfall.Path+, module Waterfall.Revolution+, module Waterfall.Solids+, module Waterfall.Sweep+, module Waterfall.Transforms+, module Waterfall.TwoD.Transforms+, module Waterfall.TwoD.Path2D+, module Waterfall.TwoD.Shape+, module Waterfall.TwoD.Text+)where++import Waterfall.Booleans+import Waterfall.Booleans.Operators+import Waterfall.Fillet+import Waterfall.IO+import Waterfall.Path.Common+import Waterfall.Path+import Waterfall.Revolution+import Waterfall.Solids+import Waterfall.Sweep+import Waterfall.Transforms+import Waterfall.TwoD.Transforms+import Waterfall.TwoD.Path2D+import Waterfall.TwoD.Shape+import Waterfall.TwoD.Text

@@ -1,154 +1,78 @@ {-| Paths in 3D space.--This module exposes functions with the same names as "Waterfall.TwoD.Path2D", and if used together they should be imported qualified. -} module Waterfall.Path ( Path-, line-, lineTo-, lineRelative-, arcVia-, arcViaTo-, arcViaRelative-, bezier-, bezierTo-, bezierRelative-, pathFrom-, pathFromTo+, module Waterfall.Path.Common+-- $ reexports+, line3D+, lineTo3D+, lineRelative3D+, arcVia3D+, arcViaTo3D+, arcViaRelative3D+, bezier3D+, bezierTo3D+, bezierRelative3D+, pathFrom3D+, pathFromTo3D ) where -import Waterfall.Internal.Path (Path(..), joinPaths)-import Control.Arrow (second)-import Data.Foldable (traverse_, foldl')-import Linear.V3 (V3(..))-import Control.Monad.IO.Class (liftIO)-import qualified OpenCascade.GP as GP-import qualified OpenCascade.GP.Pnt as GP.Pnt -import qualified OpenCascade.BRepBuilderAPI.MakeEdge as MakeEdge-import qualified OpenCascade.BRepBuilderAPI.MakeWire as MakeWire-import qualified OpenCascade.TopoDS as TopoDS-import qualified OpenCascade.GC.MakeArcOfCircle as MakeArcOfCircle-import qualified OpenCascade.NCollection.Array1 as NCollection.Array1-import qualified OpenCascade.Geom.BezierCurve as BezierCurve-import OpenCascade.Inheritance (upcast)-import Foreign.Ptr-import Data.Acquire+import Waterfall.Internal.Path (Path(..)) -v3ToPnt :: V3 Double -> Acquire (Ptr GP.Pnt)-v3ToPnt (V3 x y z) = GP.Pnt.new x y z -edgesToPath :: Acquire [Ptr TopoDS.Edge] -> Path-edgesToPath es = Path $ do-    edges <- es-    builder <- MakeWire.new-    liftIO $ traverse_ (MakeWire.addEdge builder) edges-    MakeWire.wire builder+import Waterfall.Path.Common+import Linear (V3) --- | A straight line between two points-line :: V3 Double -> V3 Double -> Path-line start end = edgesToPath $ do-    pt1 <- v3ToPnt start-    pt2 <- v3ToPnt end-    pure <$> MakeEdge.fromPnts pt1 pt2 --- | Version of `line` designed to work with `pathFrom`-lineTo :: V3 Double -> V3 Double -> (V3 Double, Path)-lineTo end = \start -> (end, line start end)  --- | Version of `line` designed to work with `pathFrom`--- --- With relative points; specifying the distance of the endpoint--- relative to the start of the line, rather than in absolute space.-lineRelative :: V3 Double -> V3 Double -> (V3 Double, Path)-lineRelative dEnd = do-    end <- (+ dEnd)-    lineTo end+-- $reexports+--+-- reexports from Waterfall.Path.Common, but monomorphised --- | Section of a circle based on three arguments, the start point, a point on the arc, and the endpoint-arcVia :: V3 Double -> V3 Double -> V3 Double -> Path-arcVia start mid end = edgesToPath $ do-    s <- v3ToPnt start-    m <- v3ToPnt mid-    e <- v3ToPnt end-    theArc <- MakeArcOfCircle.from3Pnts s m e-    pure <$> MakeEdge.fromCurve (upcast theArc)+-- | `line`, with the type fixed to `Path`+line3D :: V3 Double -> V3 Double -> Path+line3D = line  --- | Version of `arcVia` designed to work with `pathFrom`------ The first argument is a point on the arc--- The second argument is the endpoint of the arc-arcViaTo :: V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)-arcViaTo mid end = \start -> (end, arcVia start mid end) +-- | `lineTo`, with the type fixed to `Path`+lineTo3D :: V3 Double -> V3 Double -> (V3 Double, Path)+lineTo3D = lineTo --- | Version of `arcVia` designed to work with `pathFrom`--- --- With relative points; specifying the distance of the midpoint and endpoint--- relative to the start of the line, rather than in absolute space.-arcViaRelative :: V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)-arcViaRelative dMid dEnd = do-    mid <- (+ dMid) -    end <- (+ dEnd) -    arcViaTo mid end+-- | `lineRelative`, with the type fixed to `Path`+lineRelative3D :: V3 Double -> V3 Double -> (V3 Double, Path)+lineRelative3D = lineRelative --- | Bezier curve of order 3--- --- The arguments are, the start of the curve, the two control points, and the end of the curve-bezier :: V3 Double -> V3 Double -> V3 Double -> V3 Double -> Path-bezier start controlPoint1 controlPoint2 end = edgesToPath $ do-    s <- v3ToPnt start-    c1 <- v3ToPnt controlPoint1-    c2 <- v3ToPnt controlPoint2-    e <- v3ToPnt end-    arr <- NCollection.Array1.newGPPntArray 1 4-    liftIO $ do -        NCollection.Array1.setValueGPPnt arr 1 s-        NCollection.Array1.setValueGPPnt arr 2 c1-        NCollection.Array1.setValueGPPnt arr 3 c2-        NCollection.Array1.setValueGPPnt arr 4 e-    b <- BezierCurve.toHandle =<< BezierCurve.fromPnts arr-    pure <$> MakeEdge.fromCurve (upcast b)+-- | `arcVia`, with the type fixed to `Path`+arcVia3D :: V3 Double -> V3 Double -> V3 Double -> Path+arcVia3D = arcVia --- | Version of `bezier` designed to work with `pathFrom`-bezierTo :: V3 Double -> V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)-bezierTo controlPoint1 controlPoint2 end = \start -> (end, bezier start controlPoint1 controlPoint2 end) +-- | `arcViaTo`, with the type fixed to `Path`+arcViaTo3D :: V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)+arcViaTo3D = arcViaTo --- | Version of `bezier` designed to work with `pathFrom`--- --- With relative points; specifying the distance of the control points and the endpoint--- relative to the start of the line, rather than in absolute space.-bezierRelative :: V3 Double -> V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)-bezierRelative dControlPoint1 dControlPoint2 dEnd = do-    controlPoint1 <- (+ dControlPoint1)-    controlPoint2 <- (+ dControlPoint2)-    end <- (+ dEnd)-    bezierTo controlPoint1 controlPoint2 end+-- | `arcViaRelative`, with the type fixed to `Path`+arcViaRelative3D :: V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)+arcViaRelative3D = arcViaRelative --- | When combining paths, we're generally interested in pairs of paths that share a common endpoint.------ Rather than having to repeat these common endpoints, `pathFrom` can be used to combine a list of path components.--- --- Where a path component is a function from a start point, to a tuple of an end point, and a path; @V2 Double -> (V2 Double, Path2D)@. --- --- A typical use of `pathFrom` uses a list of functions with the suffix \"To\" or \"Relative\", e.g:------ @---Path.pathFrom zero ---    [ Path.bezierRelative (V3 0 0 0.5) (V3 0.5 0.5 0.5) (V3 0.5 0.5 1)---    , Path.bezierRelative (V3 0 0 0.5) (V3 (-0.5) (-0.5) 0.5) (V3 (-0.5) (-0.5) 1)---    , Path.arcViaRelative (V3 0 1 1) (V3 0 2 0)---    , Path.lineTo (V3 0 2 0) ---    ] @-pathFrom :: V3 Double -> [V3 Double -> (V3 Double, Path)] -> Path-pathFrom start commands = snd $ pathFromTo commands start -     --- | Combines a list of "path components", as used by `pathFrom`-pathFromTo :: [V3 Double -> (V3 Double, Path)] -> V3 Double -> (V3 Double, Path)-pathFromTo commands start = -    let go (pos, paths) cmd = second (:paths) (cmd pos)-        (end, allPaths) = foldl' go (start, []) commands-     in (end, joinPaths allPaths)+-- | `bezier`, with the type fixed to `Path`+bezier3D :: V3 Double -> V3 Double -> V3 Double -> V3 Double ->  Path+bezier3D = bezier +-- | `bezierTo`, with the type fixed to `Path`+bezierTo3D :: V3 Double -> V3 Double -> V3 Double -> V3 Double ->  (V3 Double, Path)+bezierTo3D = bezierTo++-- | `bezierRelative`, with the type fixed to `Path`+bezierRelative3D :: V3 Double -> V3 Double -> V3 Double -> V3 Double ->  (V3 Double, Path)+bezierRelative3D = bezierRelative++-- | `pathFrom`, with the type fixed to `Path`+pathFrom3D :: V3 Double -> [V3 Double -> (V3 Double, Path)] -> Path+pathFrom3D = pathFrom++-- | `pathFromTo`, with the type fixed to `Path`+pathFromTo3D :: [V3 Double -> (V3 Double, Path)] -> V3 Double -> (V3 Double, Path)+pathFromTo3D = pathFromTo   

@@ -0,0 +1,173 @@+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-|+Paths in 2D / 3D space.++This module defines functions that can be used with "Waterfall.Path" or "Waterfall.TwoD.Path2D".+Those modules both export monomorphized variants of the functions defined in this module+-}+module Waterfall.Path.Common +( AnyPath ()+, line+, lineTo+, lineRelative+, arcVia+, arcViaTo+, arcViaRelative+, bezier+, bezierTo+, bezierRelative+, pathFrom+, pathFromTo+) where+import Data.Acquire+import qualified OpenCascade.TopoDS as TopoDS+import qualified OpenCascade.GP as GP+import Foreign.Ptr+import Waterfall.Internal.Path (Path (..))+import Waterfall.TwoD.Internal.Path2D (Path2D (..))+import Control.Arrow (second)+import Data.Foldable (foldl', traverse_)+import qualified OpenCascade.BRepBuilderAPI.MakeWire as MakeWire+import Control.Monad.IO.Class (liftIO)+import qualified OpenCascade.BRepBuilderAPI.MakeEdge as MakeEdge+import qualified OpenCascade.GC.MakeArcOfCircle as MakeArcOfCircle+import OpenCascade.Inheritance (upcast)+import qualified OpenCascade.NCollection.Array1 as NCollection.Array1+import qualified OpenCascade.Geom.BezierCurve as BezierCurve+import Data.Proxy (Proxy (..))+import Linear (V3 (..), V2 (..))+import qualified OpenCascade.GP.Pnt as GP.Pnt++-- | Class used to abstract over constructing `Path` and `Path2D` +-- +-- There are instances for @AnyPath (V3 Double) Path@+-- and for @AnyPath (V2 Double) Path2D@+class AnyPath point path | path -> point where+    fromWire :: Acquire (Ptr TopoDS.Wire) -> path+    pointToGPPnt :: Proxy path -> point -> Acquire (Ptr GP.Pnt)++edgesToPath :: (AnyPath point path) => Acquire [Ptr TopoDS.Edge] -> path+edgesToPath es = fromWire $ do+    edges <- es+    builder <- MakeWire.new+    liftIO $ traverse_ (MakeWire.addEdge builder) edges+    MakeWire.wire builder++-- | A straight line between two points+line :: forall point path. (AnyPath point path) => point -> point -> path+line start end = edgesToPath $ do+    pt1 <- pointToGPPnt (Proxy :: Proxy path) start+    pt2 <- pointToGPPnt (Proxy :: Proxy path) end+    pure <$> MakeEdge.fromPnts pt1 pt2++-- | Version of `line` designed to work with `pathFrom`+lineTo :: (AnyPath point path) => point -> point -> (point, path)+lineTo end = \start -> (end, line start end) ++-- | Version of `line` designed to work with `pathFrom`+-- +-- With relative points; specifying the distance of the endpoint+-- relative to the start of the line, rather than in absolute space.+lineRelative :: (AnyPath point path, Num point) => point -> point -> (point, path)+lineRelative dEnd = do+    end <- (+ dEnd)+    lineTo end++-- | Section of a circle based on three arguments, the start point, a point on the arc, and the endpoint+arcVia :: forall point path. (AnyPath point path) => point -> point -> point -> path+arcVia start mid end = edgesToPath $ do+    s <- pointToGPPnt (Proxy :: Proxy path) start+    m <- pointToGPPnt (Proxy :: Proxy path) mid+    e <- pointToGPPnt (Proxy :: Proxy path) end+    theArc <- MakeArcOfCircle.from3Pnts s m e+    pure <$> MakeEdge.fromCurve (upcast theArc)++-- | Version of `arcVia` designed to work with `pathFrom`+--+-- The first argument is a point on the arc+-- The second argument is the endpoint of the arc+arcViaTo :: (AnyPath point path) => point -> point -> point -> (point, path)+arcViaTo mid end = \start -> (end, arcVia start mid end) ++-- | Version of `arcVia` designed to work with `pathFrom`+-- +-- With relative points; specifying the distance of the midpoint and endpoint+-- relative to the start of the line, rather than in absolute space.+arcViaRelative :: (AnyPath point path, Num point) => point -> point -> point -> (point, path)+arcViaRelative dMid dEnd = do+    mid <- (+ dMid) +    end <- (+ dEnd) +    arcViaTo mid end++-- | Bezier curve of order 3+-- +-- The arguments are, the start of the curve, the two control points, and the end of the curve+bezier :: forall point path. (AnyPath point path) => point -> point -> point -> point -> path+bezier start controlPoint1 controlPoint2 end = edgesToPath $ do+    s <- pointToGPPnt (Proxy :: Proxy path) start+    c1 <- pointToGPPnt (Proxy :: Proxy path) controlPoint1+    c2 <- pointToGPPnt (Proxy :: Proxy path) controlPoint2+    e <- pointToGPPnt (Proxy :: Proxy path) end+    arr <- NCollection.Array1.newGPPntArray 1 4+    liftIO $ do +        NCollection.Array1.setValueGPPnt arr 1 s+        NCollection.Array1.setValueGPPnt arr 2 c1+        NCollection.Array1.setValueGPPnt arr 3 c2+        NCollection.Array1.setValueGPPnt arr 4 e+    b <- BezierCurve.toHandle =<< BezierCurve.fromPnts arr+    pure <$> MakeEdge.fromCurve (upcast b)++-- | Version of `bezier` designed to work with `pathFrom`+bezierTo :: (AnyPath point path) => point -> point -> point -> point -> (point, path)+bezierTo controlPoint1 controlPoint2 end = \start -> (end, bezier start controlPoint1 controlPoint2 end) ++-- | Version of `bezier` designed to work with `pathFrom`+-- +-- With relative points; specifying the distance of the control points and the endpoint+-- relative to the start of the line, rather than in absolute space.+bezierRelative :: (AnyPath point path, Num point) => point -> point -> point -> point -> (point, path)+bezierRelative dControlPoint1 dControlPoint2 dEnd = do+    controlPoint1 <- (+ dControlPoint1)+    controlPoint2 <- (+ dControlPoint2)+    end <- (+ dEnd)+    bezierTo controlPoint1 controlPoint2 end++-- | When combining paths, we're generally interested in pairs of paths that share a common endpoint.+--+-- Rather than having to repeat these common endpoints, `pathFrom` can be used to combine a list of path components.+-- +-- Where a path component is a function from a start point, to a tuple of an end point, and a path; @V2 Double -> (V2 Double, Path2D)@. +-- +-- A typical use of `pathFrom` uses a list of functions with the suffix \"To\" or \"Relative\", e.g:+--+-- @+--Path.pathFrom zero +--    [ Path.bezierRelative (V3 0 0 0.5) (V3 0.5 0.5 0.5) (V3 0.5 0.5 1)+--    , Path.bezierRelative (V3 0 0 0.5) (V3 (-0.5) (-0.5) 0.5) (V3 (-0.5) (-0.5) 1)+--    , Path.arcViaRelative (V3 0 1 1) (V3 0 2 0)+--    , Path.lineTo (V3 0 2 0) +--    ] @+pathFrom :: (Monoid path) => point -> [point -> (point, path)] -> path+pathFrom start commands = snd $ pathFromTo commands start +     +-- | Combines a list of "path components", as used by `pathFrom`+pathFromTo :: (Monoid path) => [point -> (point, path)] -> point -> (point, path)+pathFromTo commands start = +    let go (pos, paths) cmd = second (:paths) (cmd pos)+        (end, allPaths) = foldl' go (start, []) commands+     in (end, mconcat allPaths)++instance AnyPath (V3 Double) Path where+    fromWire :: Acquire (Ptr TopoDS.Wire) -> Path+    fromWire = Path+    pointToGPPnt :: Proxy Path -> V3 Double -> Acquire (Ptr GP.Pnt)+    pointToGPPnt _ (V3 x y z) = GP.Pnt.new x y z ++instance AnyPath (V2 Double) Path2D where+    fromWire :: Acquire (Ptr TopoDS.Wire) -> Path2D+    fromWire = Path2D+    pointToGPPnt :: Proxy Path2D -> V2 Double -> Acquire (Ptr GP.Pnt)+    pointToGPPnt _ (V2 x y) = GP.Pnt.new x y 0

@@ -1,116 +1,48 @@ {-# LANGUAGE ScopedTypeVariables #-} {-| Paths in 2D space.--This module exposes functions with the same names as "Waterfall.Path", and if used together they should be imported qualified. -} module Waterfall.TwoD.Path2D ( Path2D , Sense (..)-, line-, lineTo-, lineRelative+, module Waterfall.Path.Common , arc , arcTo , arcRelative-, arcVia-, arcViaTo-, arcViaRelative-, bezier-, bezierTo-, bezierRelative-, pathFrom-, pathFromTo , repeatLooping , closeLoop+-- $ reexports+, line2D+, lineTo2D+, lineRelative2D+, arcVia2D+, arcViaTo2D+, arcViaRelative2D+, bezier2D+, bezierTo2D+, bezierRelative2D+, pathFrom2D+, pathFromTo2D ) where  -import Waterfall.TwoD.Internal.Path2D (Path2D(..), joinPaths)+import Waterfall.TwoD.Internal.Path2D (Path2D(..)) import Waterfall.TwoD.Transforms (rotate2D) import qualified Waterfall.Internal.Edges as Internal.Edges-import Control.Arrow (second)-import Data.Foldable (traverse_, foldl') import Linear.V2 (V2(..)) import Control.Monad.IO.Class (liftIO) import Control.Lens ((^.)) import Linear ((^*), _xy, distance, normalize, unangle)-import qualified OpenCascade.GP as GP-import qualified OpenCascade.GP.Pnt as GP.Pnt -import qualified OpenCascade.BRepBuilderAPI.MakeEdge as MakeEdge-import qualified OpenCascade.BRepBuilderAPI.MakeWire as MakeWire-import qualified OpenCascade.TopoDS as TopoDS-import qualified OpenCascade.GC.MakeArcOfCircle as MakeArcOfCircle-import qualified OpenCascade.NCollection.Array1 as NCollection.Array1-import qualified OpenCascade.Geom.BezierCurve as BezierCurve-import OpenCascade.Inheritance (upcast)-import Foreign.Ptr-import Data.Acquire--v2ToPnt :: V2 Double -> Acquire (Ptr GP.Pnt)-v2ToPnt (V2 x y) = GP.Pnt.new x y 0--edgesToPath :: Acquire [Ptr TopoDS.Edge] -> Path2D-edgesToPath es = Path2D $ do-    edges <- es-    builder <- MakeWire.new-    liftIO $ traverse_ (MakeWire.addEdge builder) edges-    MakeWire.wire builder---- | A straight line between two points-line :: V2 Double -> V2 Double -> Path2D-line start end = edgesToPath $ do-    pt1 <- v2ToPnt start-    pt2 <- v2ToPnt end-    pure <$> MakeEdge.fromPnts pt1 pt2---- | Version of `line` designed to work with `pathFrom`-lineTo :: V2 Double -> V2 Double -> (V2 Double, Path2D)-lineTo end = \start -> (end, line start end) ---- | Version of `line` designed to work with `pathFrom`--- --- With relative points; specifying the distance of the endpoint--- relative to the start of the line, rather than in absolute space.-lineRelative :: V2 Double -> V2 Double -> (V2 Double, Path2D)-lineRelative dEnd = do-    end <- (+ dEnd)-    lineTo end---- | Section of a circle based on three arguments, the start point, a point on the arc, and the endpoint-arcVia :: V2 Double -> V2 Double -> V2 Double -> Path2D-arcVia start mid end = edgesToPath $ do-    s <- v2ToPnt start-    m <- v2ToPnt mid-    e <- v2ToPnt end-    theArc <- MakeArcOfCircle.from3Pnts s m e-    pure <$> MakeEdge.fromCurve (upcast theArc)---- | Version of `arcVia` designed to work with `pathFrom`------ The first argument is a point on the arc.--- The second argument is the endpoint of the arc-arcViaTo :: V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)-arcViaTo mid end = \start -> (end, arcVia start mid end) ----- | Version of `arcVia` designed to work with `pathFrom`--- --- With relative points; specifying the distance of the midpoint and endpoint--- relative to the start of the line, rather than in absolute space.-arcViaRelative :: V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)-arcViaRelative dMid dEnd = do-    mid <- (+ dMid) -    end <- (+ dEnd) -    arcViaTo mid end+import Waterfall.Path.Common  data Sense = Clockwise | Counterclockwise deriving (Eq, Show) - -- | Section of a circle, with a given radius, that lies between two points. -- -- This may fail, if the radius is less than half of the distance between the points. ----- In general, `arcVia` is the \"safer\" way to construct an arc+-- In general, `arcVia` is the \"safer\" way to construct an arc.+--+-- `arc` is not polymorphic, as it would not be possible to define an arc in 3D space in this way. arc :: Sense -> Double -> V2 Double -> V2 Double -> Path2D  arc sense radius start end =      let mid = (start + end) ^* 0.5@@ -138,64 +70,6 @@     end <- (+ dEnd)     arcTo sense radius end --- | Bezier curve of order 3--- --- The arguments are, the start of the curve, the two control points, and the end of the curve-bezier :: V2 Double -> V2 Double -> V2 Double -> V2 Double -> Path2D-bezier start controlPoint1 controlPoint2 end = edgesToPath $ do-    s <- v2ToPnt start-    c1 <- v2ToPnt controlPoint1-    c2 <- v2ToPnt controlPoint2-    e <- v2ToPnt end-    arr <- NCollection.Array1.newGPPntArray 1 4-    liftIO $ do -        NCollection.Array1.setValueGPPnt arr 1 s-        NCollection.Array1.setValueGPPnt arr 2 c1-        NCollection.Array1.setValueGPPnt arr 3 c2-        NCollection.Array1.setValueGPPnt arr 4 e-    b <- BezierCurve.toHandle =<< BezierCurve.fromPnts arr-    pure <$> MakeEdge.fromCurve (upcast b)- --- | Version of `bezier` designed to work with `pathFrom`-bezierTo :: V2 Double -> V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)-bezierTo controlPoint1 controlPoint2 end = \start -> (end, bezier start controlPoint1 controlPoint2 end) ---- | Version of `bezier` designed to work with `pathFrom`--- --- With relative points; specifying the distance of the control points and the endpoint--- relative to the start of the line, rather than in absolute space.-bezierRelative :: V2 Double -> V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)-bezierRelative dControlPoint1 dControlPoint2 dEnd = do-    controlPoint1 <- (+ dControlPoint1)-    controlPoint2 <- (+ dControlPoint2)-    end <- (+ dEnd)-    bezierTo controlPoint1 controlPoint2 end---- | When combining paths, we're generally interested in pairs of paths that share a common endpoint.------ Rather than having to repeat these common endpoints, `pathFrom` can be used to combine a list of path components.--- --- Where a path component is a function from a start point, to a tuple of an end point, and a path; @ V2 Double -> (V2 Double, Path2D) @. --- --- A typical use of `pathFrom` uses a list of functions with the suffix \"To\" or \"Relative\", e.g.------ @---Path2D.pathFrom (V2 (-1) (-1)) ---    [ Path2D.arcViaTo (V2 (-1.5) 0) (V2 (-1) 1)---    , Path2D.lineTo (V2 1 1)---    , Path2D.bezierTo (V2 1.5 1) (V2 1.5 (-1)) (V2 1 (-1))---    , Path2D.lineTo (V2 (-1) (-1))---    ] @-pathFrom :: V2 Double -> [V2 Double -> (V2 Double, Path2D)] -> Path2D-pathFrom start commands = snd $ pathFromTo commands start -     --- | Combines a list of "path components", as used by `pathFrom`-pathFromTo :: [V2 Double -> (V2 Double, Path2D)] -> V2 Double -> (V2 Double, Path2D)-pathFromTo commands start = -    let go (pos, paths) cmd = second (:paths) (cmd pos)-        (end, allPaths) = foldl' go (start, []) commands-     in (end, joinPaths allPaths)- -- | Given a Path where both endpoints are equidistant from the origin. -- -- And which subtends an angle \( φ \) from the origin that evenly divides a complete revolution, such that \(n φ = 2 π \).@@ -218,5 +92,50 @@     (s, e) <- liftIO . Internal.Edges.wireEndpoints $ path     runPath $ mconcat [p, line (e ^. _xy)  (s ^. _xy)] +-- $reexports+--+-- reexports from Waterfall.Path.Common, but monomorphised +-- | `line`, with the type fixed to `Path2D`+line2D :: V2 Double -> V2 Double -> Path2D+line2D = line  +-- | `lineTo`, with the type fixed to `Path2D`+lineTo2D :: V2 Double -> V2 Double -> (V2 Double, Path2D)+lineTo2D = lineTo++-- | `lineRelative`, with the type fixed to `Path2D`+lineRelative2D :: V2 Double -> V2 Double -> (V2 Double, Path2D)+lineRelative2D = lineRelative++-- | `arcVia`, with the type fixed to `Path2D`+arcVia2D :: V2 Double -> V2 Double -> V2 Double -> Path2D+arcVia2D = arcVia++-- | `arcViaTo`, with the type fixed to `Path2D`+arcViaTo2D :: V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)+arcViaTo2D = arcViaTo++-- | `arcViaRelative`, with the type fixed to `Path2D`+arcViaRelative2D :: V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)+arcViaRelative2D = arcViaRelative++-- | `bezier`, with the type fixed to `Path2D`+bezier2D :: V2 Double -> V2 Double -> V2 Double -> V2 Double ->  Path2D+bezier2D = bezier++-- | `bezierTo`, with the type fixed to `Path2D`+bezierTo2D :: V2 Double -> V2 Double -> V2 Double -> V2 Double ->  (V2 Double, Path2D)+bezierTo2D = bezierTo++-- | `bezierRelative`, with the type fixed to `Path2D`+bezierRelative2D :: V2 Double -> V2 Double -> V2 Double -> V2 Double ->  (V2 Double, Path2D)+bezierRelative2D = bezierRelative++-- | `pathFrom`, with the type fixed to `Path2D`+pathFrom2D :: V2 Double -> [V2 Double -> (V2 Double, Path2D)] -> Path2D+pathFrom2D = pathFrom++-- | `pathFromTo`, with the type fixed to `Path2D`+pathFromTo2D :: [V2 Double -> (V2 Double, Path2D)] -> V2 Double -> (V2 Double, Path2D)+pathFromTo2D = pathFromTo

@@ -0,0 +1,45 @@+module Waterfall.TwoD.Text+( text+, Font +, FontAspect (..)+, fontFromPath+, fontFromSystem+) where++import qualified Waterfall.TwoD.Internal.Shape as Shape+import qualified OpenCascade.GP.Ax3 as GP.Ax3+import qualified OpenCascade.Font.BRepFont as BRepFont+import qualified OpenCascade.Font.BRepTextBuilder as BRepTextBuilder+import qualified OpenCascade.Graphic3D.VerticalTextAlignment as VTA+import qualified OpenCascade.Graphic3D.HorizontalTextAlignment as HTA+import Foreign.Ptr +import Control.Monad (unless)+import Control.Monad.IO.Class (liftIO)+import OpenCascade.Font.FontAspect (FontAspect (..))++newtype Font = Font {initFont :: Ptr BRepFont.BRepFont -> IO ()}++-- | create a font from a filepath and a font size +fontFromPath :: FilePath -> Double -> Font +fontFromPath fontpath size = Font $ \font -> do+    fontOk <- BRepFont.initFromPathAndSize font fontpath size+    unless (fontOk) $ error ("Unable to initialize font from filepath: " <> fontpath)++-- | Create a font from a system font name, aspect, and size+fontFromSystem :: String -> FontAspect -> Double -> Font +fontFromSystem name aspect size = Font $ \font -> do+    fontOk <- BRepFont.initFromNameAspectAndSize font name aspect size+    unless (fontOk) $ error ("Unable to initialize system font with name: " <> name <> ", and aspect" <> show aspect)++-- | Render text, using the font from the provided filepath, at a given size.+--+-- The IO of actually loading the font/checking the file exists is defered +-- until the Shape is actually used+text :: Font -> String -> Shape.Shape +text font content = Shape.Shape $ do+    axis <- GP.Ax3.new+    brepfont <- BRepFont.new+    liftIO $ initFont font brepfont+    builder <- BRepTextBuilder.new+    BRepTextBuilder.perform builder brepfont content axis HTA.Center VTA.Center+

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           waterfall-cad-version:        0.0.0.1+version:        0.1.0.0 synopsis:       Declarative CAD/Solid Modeling Library description:    Please see the README on GitHub at <https://github.com/joe-warren/opencascade-hs#readme> category:       Graphics@@ -28,6 +28,7 @@  library   exposed-modules:+      Waterfall       Waterfall.Booleans       Waterfall.Booleans.Operators       Waterfall.Fillet@@ -36,6 +37,7 @@       Waterfall.Internal.Solid       Waterfall.IO       Waterfall.Path+      Waterfall.Path.Common       Waterfall.Revolution       Waterfall.Solids       Waterfall.Sweep@@ -44,6 +46,7 @@       Waterfall.TwoD.Internal.Shape       Waterfall.TwoD.Path2D       Waterfall.TwoD.Shape+      Waterfall.TwoD.Text       Waterfall.TwoD.Transforms   other-modules:       Paths_waterfall_cad@@ -55,6 +58,6 @@     , lattices >=2.0 && <3     , lens ==5.*     , linear >=1.21 && <2-    , opencascade-hs >=0.0.0.1 && <0.1+    , opencascade-hs >=0.1.0.0 && <0.2     , resourcet >=1.2 && <1.4   default-language: Haskell2010