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

v3ToPnt :: V3 Double -> Acquire (Ptr GP.Pnt)
v3ToPnt :: V3 Double -> Acquire (Ptr Pnt)
v3ToPnt (V3 Double
x Double
y Double
z) = Double -> Double -> Double -> Acquire (Ptr Pnt)
GP.Pnt.new Double
x Double
y Double
z

edgesToPath :: Acquire [Ptr TopoDS.Edge] -> Path
edgesToPath :: Acquire [Ptr Edge] -> Path
edgesToPath Acquire [Ptr Edge]
es = Acquire (Ptr Wire) -> Path
Path (Acquire (Ptr Wire) -> Path) -> Acquire (Ptr Wire) -> Path
forall a b. (a -> b) -> a -> b
$ do
    [Ptr Edge]
edges <- Acquire [Ptr Edge]
es
    Ptr MakeWire
builder <- Acquire (Ptr MakeWire)
MakeWire.new
    IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ (Ptr Edge -> IO ()) -> [Ptr Edge] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Ptr MakeWire -> Ptr Edge -> IO ()
MakeWire.addEdge Ptr MakeWire
builder) [Ptr Edge]
edges
    Ptr MakeWire -> Acquire (Ptr Wire)
MakeWire.wire Ptr MakeWire
builder

-- | A straight line between two points
line :: V3 Double -> V3 Double -> Path
line :: V3 Double -> V3 Double -> Path
line V3 Double
start V3 Double
end = Acquire [Ptr Edge] -> Path
edgesToPath (Acquire [Ptr Edge] -> Path) -> Acquire [Ptr Edge] -> Path
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pnt
pt1 <- V3 Double -> Acquire (Ptr Pnt)
v3ToPnt V3 Double
start
    Ptr Pnt
pt2 <- V3 Double -> Acquire (Ptr Pnt)
v3ToPnt V3 Double
end
    Ptr Edge -> [Ptr Edge]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Edge -> [Ptr Edge])
-> Acquire (Ptr Edge) -> Acquire [Ptr Edge]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Pnt -> Ptr Pnt -> Acquire (Ptr Edge)
MakeEdge.fromPnts Ptr Pnt
pt1 Ptr Pnt
pt2

-- | Version of `line` designed to work with `pathFrom`
lineTo :: V3 Double -> V3 Double -> (V3 Double, Path)
lineTo :: V3 Double -> V3 Double -> (V3 Double, Path)
lineTo V3 Double
end = \V3 Double
start -> (V3 Double
end, V3 Double -> V3 Double -> Path
line V3 Double
start V3 Double
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 :: V3 Double -> V3 Double -> (V3 Double, Path)
lineRelative V3 Double
dEnd = do
    V3 Double
end <- (V3 Double -> V3 Double -> V3 Double
forall a. Num a => a -> a -> a
+ V3 Double
dEnd)
    V3 Double -> V3 Double -> (V3 Double, Path)
lineTo V3 Double
end

-- | 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 :: V3 Double -> V3 Double -> V3 Double -> Path
arcVia V3 Double
start V3 Double
mid V3 Double
end = Acquire [Ptr Edge] -> Path
edgesToPath (Acquire [Ptr Edge] -> Path) -> Acquire [Ptr Edge] -> Path
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pnt
s <- V3 Double -> Acquire (Ptr Pnt)
v3ToPnt V3 Double
start
    Ptr Pnt
m <- V3 Double -> Acquire (Ptr Pnt)
v3ToPnt V3 Double
mid
    Ptr Pnt
e <- V3 Double -> Acquire (Ptr Pnt)
v3ToPnt V3 Double
end
    Ptr (Handle TrimmedCurve)
theArc <- Ptr Pnt
-> Ptr Pnt -> Ptr Pnt -> Acquire (Ptr (Handle TrimmedCurve))
MakeArcOfCircle.from3Pnts Ptr Pnt
s Ptr Pnt
m Ptr Pnt
e
    Ptr Edge -> [Ptr Edge]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Edge -> [Ptr Edge])
-> Acquire (Ptr Edge) -> Acquire [Ptr Edge]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (Handle Curve) -> Acquire (Ptr Edge)
MakeEdge.fromCurve (Ptr (Handle TrimmedCurve) -> Ptr (Handle Curve)
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr (Handle TrimmedCurve)
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 :: V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)
arcViaTo :: V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)
arcViaTo V3 Double
mid V3 Double
end = \V3 Double
start -> (V3 Double
end, V3 Double -> V3 Double -> V3 Double -> Path
arcVia V3 Double
start V3 Double
mid V3 Double
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 :: V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)
arcViaRelative :: V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)
arcViaRelative V3 Double
dMid V3 Double
dEnd = do
    V3 Double
mid <- (V3 Double -> V3 Double -> V3 Double
forall a. Num a => a -> a -> a
+ V3 Double
dMid) 
    V3 Double
end <- (V3 Double -> V3 Double -> V3 Double
forall a. Num a => a -> a -> a
+ V3 Double
dEnd) 
    V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)
arcViaTo V3 Double
mid V3 Double
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 :: V3 Double -> V3 Double -> V3 Double -> V3 Double -> Path
bezier :: V3 Double -> V3 Double -> V3 Double -> V3 Double -> Path
bezier V3 Double
start V3 Double
controlPoint1 V3 Double
controlPoint2 V3 Double
end = Acquire [Ptr Edge] -> Path
edgesToPath (Acquire [Ptr Edge] -> Path) -> Acquire [Ptr Edge] -> Path
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pnt
s <- V3 Double -> Acquire (Ptr Pnt)
v3ToPnt V3 Double
start
    Ptr Pnt
c1 <- V3 Double -> Acquire (Ptr Pnt)
v3ToPnt V3 Double
controlPoint1
    Ptr Pnt
c2 <- V3 Double -> Acquire (Ptr Pnt)
v3ToPnt V3 Double
controlPoint2
    Ptr Pnt
e <- V3 Double -> Acquire (Ptr Pnt)
v3ToPnt V3 Double
end
    Ptr (Array1 Pnt)
arr <- Int -> Int -> Acquire (Ptr (Array1 Pnt))
NCollection.Array1.newGPPntArray Int
1 Int
4
    IO () -> Acquire ()
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Acquire ()) -> IO () -> Acquire ()
forall a b. (a -> b) -> a -> b
$ do 
        Ptr (Array1 Pnt) -> Int -> Ptr Pnt -> IO ()
NCollection.Array1.setValueGPPnt Ptr (Array1 Pnt)
arr Int
1 Ptr Pnt
s
        Ptr (Array1 Pnt) -> Int -> Ptr Pnt -> IO ()
NCollection.Array1.setValueGPPnt Ptr (Array1 Pnt)
arr Int
2 Ptr Pnt
c1
        Ptr (Array1 Pnt) -> Int -> Ptr Pnt -> IO ()
NCollection.Array1.setValueGPPnt Ptr (Array1 Pnt)
arr Int
3 Ptr Pnt
c2
        Ptr (Array1 Pnt) -> Int -> Ptr Pnt -> IO ()
NCollection.Array1.setValueGPPnt Ptr (Array1 Pnt)
arr Int
4 Ptr Pnt
e
    Ptr (Handle BezierCurve)
b <- Ptr BezierCurve -> Acquire (Ptr (Handle BezierCurve))
BezierCurve.toHandle (Ptr BezierCurve -> Acquire (Ptr (Handle BezierCurve)))
-> Acquire (Ptr BezierCurve) -> Acquire (Ptr (Handle BezierCurve))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (Array1 Pnt) -> Acquire (Ptr BezierCurve)
BezierCurve.fromPnts Ptr (Array1 Pnt)
arr
    Ptr Edge -> [Ptr Edge]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Edge -> [Ptr Edge])
-> Acquire (Ptr Edge) -> Acquire [Ptr Edge]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (Handle Curve) -> Acquire (Ptr Edge)
MakeEdge.fromCurve (Ptr (Handle BezierCurve) -> Ptr (Handle Curve)
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr (Handle BezierCurve)
b)

-- | Version of `bezier` designed to work with `pathFrom`
bezierTo :: V3 Double -> V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)
bezierTo :: V3 Double
-> V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)
bezierTo V3 Double
controlPoint1 V3 Double
controlPoint2 V3 Double
end = \V3 Double
start -> (V3 Double
end, V3 Double -> V3 Double -> V3 Double -> V3 Double -> Path
bezier V3 Double
start V3 Double
controlPoint1 V3 Double
controlPoint2 V3 Double
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 :: V3 Double -> V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)
bezierRelative :: V3 Double
-> V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)
bezierRelative V3 Double
dControlPoint1 V3 Double
dControlPoint2 V3 Double
dEnd = do
    V3 Double
controlPoint1 <- (V3 Double -> V3 Double -> V3 Double
forall a. Num a => a -> a -> a
+ V3 Double
dControlPoint1)
    V3 Double
controlPoint2 <- (V3 Double -> V3 Double -> V3 Double
forall a. Num a => a -> a -> a
+ V3 Double
dControlPoint2)
    V3 Double
end <- (V3 Double -> V3 Double -> V3 Double
forall a. Num a => a -> a -> a
+ V3 Double
dEnd)
    V3 Double
-> V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)
bezierTo V3 Double
controlPoint1 V3 Double
controlPoint2 V3 Double
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 :: V3 Double -> [V3 Double -> (V3 Double, Path)] -> Path
pathFrom :: V3 Double -> [V3 Double -> (V3 Double, Path)] -> Path
pathFrom V3 Double
start [V3 Double -> (V3 Double, Path)]
commands = (V3 Double, Path) -> Path
forall a b. (a, b) -> b
snd ((V3 Double, Path) -> Path) -> (V3 Double, Path) -> Path
forall a b. (a -> b) -> a -> b
$ [V3 Double -> (V3 Double, Path)] -> V3 Double -> (V3 Double, Path)
pathFromTo [V3 Double -> (V3 Double, Path)]
commands V3 Double
start 
     
-- | Combines a list of "path components", as used by `pathFrom`
pathFromTo :: [V3 Double -> (V3 Double, Path)] -> V3 Double -> (V3 Double, Path)
pathFromTo :: [V3 Double -> (V3 Double, Path)] -> V3 Double -> (V3 Double, Path)
pathFromTo [V3 Double -> (V3 Double, Path)]
commands V3 Double
start = 
    let go :: (t, [b]) -> (t -> (d, b)) -> (d, [b])
go (t
pos, [b]
paths) t -> (d, b)
cmd = (b -> [b]) -> (d, b) -> (d, [b])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (b -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
paths) (t -> (d, b)
cmd t
pos)
        (V3 Double
end, [Path]
allPaths) = ((V3 Double, [Path])
 -> (V3 Double -> (V3 Double, Path)) -> (V3 Double, [Path]))
-> (V3 Double, [Path])
-> [V3 Double -> (V3 Double, Path)]
-> (V3 Double, [Path])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (V3 Double, [Path])
-> (V3 Double -> (V3 Double, Path)) -> (V3 Double, [Path])
forall {t} {b} {d}. (t, [b]) -> (t -> (d, b)) -> (d, [b])
go (V3 Double
start, []) [V3 Double -> (V3 Double, Path)]
commands
     in (V3 Double
end, [Path] -> Path
joinPaths [Path]
allPaths)