{-# 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 Waterfall.Internal.Finalizers (unsafeFromAcquire)
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 :: forall point path. AnyPath point path => Acquire [Ptr Edge] -> path
edgesToPath Acquire [Ptr Edge]
es = Acquire (Ptr Wire) -> path
forall point path. AnyPath point path => Acquire (Ptr Wire) -> path
fromWire (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 :: forall point path. (AnyPath point path) => point -> point -> path
line :: forall point path. AnyPath point path => point -> point -> path
line point
start point
end = Acquire [Ptr Edge] -> path
forall point path. AnyPath point path => Acquire [Ptr Edge] -> path
edgesToPath (Acquire [Ptr Edge] -> path) -> Acquire [Ptr Edge] -> path
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pnt
pt1 <- Proxy path -> point -> Acquire (Ptr Pnt)
forall point path.
AnyPath point path =>
Proxy path -> point -> Acquire (Ptr Pnt)
pointToGPPnt (Proxy path
forall {k} (t :: k). Proxy t
Proxy :: Proxy path) point
start
    Ptr Pnt
pt2 <- Proxy path -> point -> Acquire (Ptr Pnt)
forall point path.
AnyPath point path =>
Proxy path -> point -> Acquire (Ptr Pnt)
pointToGPPnt (Proxy path
forall {k} (t :: k). Proxy t
Proxy :: Proxy path) point
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 :: (AnyPath point path) => point -> point -> (point, path)
lineTo :: forall point path.
AnyPath point path =>
point -> point -> (point, path)
lineTo point
end = \point
start -> (point
end, point -> point -> path
forall point path. AnyPath point path => point -> point -> path
line point
start point
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 :: forall point path.
(AnyPath point path, Num point) =>
point -> point -> (point, path)
lineRelative point
dEnd = do
    point
end <- (point -> point -> point
forall a. Num a => a -> a -> a
+ point
dEnd)
    point -> point -> (point, path)
forall point path.
AnyPath point path =>
point -> point -> (point, path)
lineTo point
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 :: forall point path.
AnyPath point path =>
point -> point -> point -> path
arcVia point
start point
mid point
end = Acquire [Ptr Edge] -> path
forall point path. AnyPath point path => Acquire [Ptr Edge] -> path
edgesToPath (Acquire [Ptr Edge] -> path) -> Acquire [Ptr Edge] -> path
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pnt
s <- Proxy path -> point -> Acquire (Ptr Pnt)
forall point path.
AnyPath point path =>
Proxy path -> point -> Acquire (Ptr Pnt)
pointToGPPnt (Proxy path
forall {k} (t :: k). Proxy t
Proxy :: Proxy path) point
start
    Ptr Pnt
m <- Proxy path -> point -> Acquire (Ptr Pnt)
forall point path.
AnyPath point path =>
Proxy path -> point -> Acquire (Ptr Pnt)
pointToGPPnt (Proxy path
forall {k} (t :: k). Proxy t
Proxy :: Proxy path) point
mid
    Ptr Pnt
e <- Proxy path -> point -> Acquire (Ptr Pnt)
forall point path.
AnyPath point path =>
Proxy path -> point -> Acquire (Ptr Pnt)
pointToGPPnt (Proxy path
forall {k} (t :: k). Proxy t
Proxy :: Proxy path) point
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 :: (AnyPath point path) => point -> point -> point -> (point, path)
arcViaTo :: forall point path.
AnyPath point path =>
point -> point -> point -> (point, path)
arcViaTo point
mid point
end = \point
start -> (point
end, point -> point -> point -> path
forall point path.
AnyPath point path =>
point -> point -> point -> path
arcVia point
start point
mid point
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 :: forall point path.
(AnyPath point path, Num point) =>
point -> point -> point -> (point, path)
arcViaRelative point
dMid point
dEnd = do
    point
mid <- (point -> point -> point
forall a. Num a => a -> a -> a
+ point
dMid) 
    point
end <- (point -> point -> point
forall a. Num a => a -> a -> a
+ point
dEnd) 
    point -> point -> point -> (point, path)
forall point path.
AnyPath point path =>
point -> point -> point -> (point, path)
arcViaTo point
mid point
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 :: forall point path.
AnyPath point path =>
point -> point -> point -> point -> path
bezier point
start point
controlPoint1 point
controlPoint2 point
end = Acquire [Ptr Edge] -> path
forall point path. AnyPath point path => Acquire [Ptr Edge] -> path
edgesToPath (Acquire [Ptr Edge] -> path) -> Acquire [Ptr Edge] -> path
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pnt
s <- Proxy path -> point -> Acquire (Ptr Pnt)
forall point path.
AnyPath point path =>
Proxy path -> point -> Acquire (Ptr Pnt)
pointToGPPnt (Proxy path
forall {k} (t :: k). Proxy t
Proxy :: Proxy path) point
start
    Ptr Pnt
c1 <- Proxy path -> point -> Acquire (Ptr Pnt)
forall point path.
AnyPath point path =>
Proxy path -> point -> Acquire (Ptr Pnt)
pointToGPPnt (Proxy path
forall {k} (t :: k). Proxy t
Proxy :: Proxy path) point
controlPoint1
    Ptr Pnt
c2 <- Proxy path -> point -> Acquire (Ptr Pnt)
forall point path.
AnyPath point path =>
Proxy path -> point -> Acquire (Ptr Pnt)
pointToGPPnt (Proxy path
forall {k} (t :: k). Proxy t
Proxy :: Proxy path) point
controlPoint2
    Ptr Pnt
e <- Proxy path -> point -> Acquire (Ptr Pnt)
forall point path.
AnyPath point path =>
Proxy path -> point -> Acquire (Ptr Pnt)
pointToGPPnt (Proxy path
forall {k} (t :: k). Proxy t
Proxy :: Proxy path) point
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 :: (AnyPath point path) => point -> point -> point -> point -> (point, path)
bezierTo :: forall point path.
AnyPath point path =>
point -> point -> point -> point -> (point, path)
bezierTo point
controlPoint1 point
controlPoint2 point
end = \point
start -> (point
end, point -> point -> point -> point -> path
forall point path.
AnyPath point path =>
point -> point -> point -> point -> path
bezier point
start point
controlPoint1 point
controlPoint2 point
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 :: forall point path.
(AnyPath point path, Num point) =>
point -> point -> point -> point -> (point, path)
bezierRelative point
dControlPoint1 point
dControlPoint2 point
dEnd = do
    point
controlPoint1 <- (point -> point -> point
forall a. Num a => a -> a -> a
+ point
dControlPoint1)
    point
controlPoint2 <- (point -> point -> point
forall a. Num a => a -> a -> a
+ point
dControlPoint2)
    point
end <- (point -> point -> point
forall a. Num a => a -> a -> a
+ point
dEnd)
    point -> point -> point -> point -> (point, path)
forall point path.
AnyPath point path =>
point -> point -> point -> point -> (point, path)
bezierTo point
controlPoint1 point
controlPoint2 point
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 :: forall path point.
Monoid path =>
point -> [point -> (point, path)] -> path
pathFrom point
start [point -> (point, path)]
commands = (point, path) -> path
forall a b. (a, b) -> b
snd ((point, path) -> path) -> (point, path) -> path
forall a b. (a -> b) -> a -> b
$ [point -> (point, path)] -> point -> (point, path)
forall path point.
Monoid path =>
[point -> (point, path)] -> point -> (point, path)
pathFromTo [point -> (point, path)]
commands point
start 
     
-- | Combines a list of "path components", as used by `pathFrom`
pathFromTo :: (Monoid path) => [point -> (point, path)] -> point -> (point, path)
pathFromTo :: forall path point.
Monoid path =>
[point -> (point, path)] -> point -> (point, path)
pathFromTo [point -> (point, path)]
commands point
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)
        (point
end, [path]
allPaths) = ((point, [path]) -> (point -> (point, path)) -> (point, [path]))
-> (point, [path]) -> [point -> (point, path)] -> (point, [path])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (point, [path]) -> (point -> (point, path)) -> (point, [path])
forall {t} {b} {d}. (t, [b]) -> (t -> (d, b)) -> (d, [b])
go (point
start, []) [point -> (point, path)]
commands
     in (point
end, [path] -> path
forall a. Monoid a => [a] -> a
mconcat [path]
allPaths)

instance AnyPath (V3 Double) Path where
    fromWire :: Acquire (Ptr TopoDS.Wire) -> Path
    fromWire :: Acquire (Ptr Wire) -> Path
fromWire = Ptr Wire -> Path
Path (Ptr Wire -> Path)
-> (Acquire (Ptr Wire) -> Ptr Wire) -> Acquire (Ptr Wire) -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr Wire) -> Ptr Wire
forall a. Acquire a -> a
unsafeFromAcquire
    pointToGPPnt :: Proxy Path -> V3 Double -> Acquire (Ptr GP.Pnt)
    pointToGPPnt :: Proxy Path -> V3 Double -> Acquire (Ptr Pnt)
pointToGPPnt Proxy Path
_ (V3 Double
x Double
y Double
z) = Double -> Double -> Double -> Acquire (Ptr Pnt)
GP.Pnt.new Double
x Double
y Double
z 

instance AnyPath (V2 Double) Path2D where
    fromWire :: Acquire (Ptr TopoDS.Wire) -> Path2D
    fromWire :: Acquire (Ptr Wire) -> Path2D
fromWire = Ptr Wire -> Path2D
Path2D (Ptr Wire -> Path2D)
-> (Acquire (Ptr Wire) -> Ptr Wire) -> Acquire (Ptr Wire) -> Path2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr Wire) -> Ptr Wire
forall a. Acquire a -> a
unsafeFromAcquire
    pointToGPPnt :: Proxy Path2D -> V2 Double -> Acquire (Ptr GP.Pnt)
    pointToGPPnt :: Proxy Path2D -> V2 Double -> Acquire (Ptr Pnt)
pointToGPPnt Proxy Path2D
_ (V2 Double
x Double
y) = Double -> Double -> Double -> Acquire (Ptr Pnt)
GP.Pnt.new Double
x Double
y Double
0