module Waterfall.TwoD.Shape
( Shape
, fromPath
, unitCircle
, unitSquare
, centeredSquare
) where

import Waterfall.TwoD.Internal.Shape (Shape (..))
import Waterfall.TwoD.Internal.Path2D (Path2D (..))
import Waterfall.TwoD.Transforms (translate2D)
import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire)
import qualified OpenCascade.BRepBuilderAPI.MakeFace as MakeFace
import OpenCascade.Inheritance (upcast)
import Linear (unit, _x, _y, zero, V2 (..))
import Waterfall.Path.Common (pathFrom, arcViaTo, lineTo)

-- | Construct a 2D Shape from a closed path 
fromPath :: Path2D -> Shape
fromPath :: Path2D -> Shape
fromPath (Path2D Ptr Wire
r)= Ptr Shape -> Shape
Shape (Ptr Shape -> Shape)
-> (Acquire (Ptr Shape) -> Ptr Shape)
-> Acquire (Ptr Shape)
-> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr Shape) -> Ptr Shape
forall a. Acquire a -> a
unsafeFromAcquire  (Acquire (Ptr Shape) -> Shape) -> Acquire (Ptr Shape) -> Shape
forall a b. (a -> b) -> a -> b
$ do
    Ptr Wire
p <- Ptr Wire -> Acquire (Ptr Wire)
forall a. a -> Acquire a
toAcquire Ptr Wire
r
    Ptr Face -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast (Ptr Face -> Ptr Shape)
-> Acquire (Ptr Face) -> Acquire (Ptr Shape)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr MakeFace -> Acquire (Ptr Face)
MakeFace.face (Ptr MakeFace -> Acquire (Ptr Face))
-> Acquire (Ptr MakeFace) -> Acquire (Ptr Face)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Wire -> Bool -> Acquire (Ptr MakeFace)
MakeFace.fromWire Ptr Wire
p Bool
False)

-- | Circle with radius 1, centered on the origin
unitCircle :: Shape
unitCircle :: Shape
unitCircle = Path2D -> Shape
fromPath (Path2D -> Shape) -> Path2D -> Shape
forall a b. (a -> b) -> a -> b
$ V2 Double -> [V2 Double -> (V2 Double, Path2D)] -> Path2D
forall path point.
Monoid path =>
point -> [point -> (point, path)] -> path
pathFrom (ASetter' (V2 Double) Double -> V2 Double
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (V2 Double) Double
forall a. Lens' (V2 a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)
                [ V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
forall point path.
AnyPath point path =>
point -> point -> point -> (point, path)
arcViaTo (ASetter' (V2 Double) Double -> V2 Double
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (V2 Double) Double
forall a. Lens' (V2 a) a
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y) (V2 Double -> V2 Double
forall a. Num a => a -> a
negate (V2 Double -> V2 Double) -> V2 Double -> V2 Double
forall a b. (a -> b) -> a -> b
$ ASetter' (V2 Double) Double -> V2 Double
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (V2 Double) Double
forall a. Lens' (V2 a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)
                , V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
forall point path.
AnyPath point path =>
point -> point -> point -> (point, path)
arcViaTo (V2 Double -> V2 Double
forall a. Num a => a -> a
negate (V2 Double -> V2 Double) -> V2 Double -> V2 Double
forall a b. (a -> b) -> a -> b
$ ASetter' (V2 Double) Double -> V2 Double
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (V2 Double) Double
forall a. Lens' (V2 a) a
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y) (ASetter' (V2 Double) Double -> V2 Double
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (V2 Double) Double
forall a. Lens' (V2 a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)
                ]

-- | Square with side length of 1, one vertex on the origin, another on \( (1, 1) \)
unitSquare :: Shape
unitSquare :: Shape
unitSquare =
    Path2D -> Shape
fromPath (Path2D -> Shape) -> Path2D -> Shape
forall a b. (a -> b) -> a -> b
$ V2 Double -> [V2 Double -> (V2 Double, Path2D)] -> Path2D
forall path point.
Monoid path =>
point -> [point -> (point, path)] -> path
pathFrom V2 Double
forall a. Num a => V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
        [ V2 Double -> V2 Double -> (V2 Double, Path2D)
forall point path.
AnyPath point path =>
point -> point -> (point, path)
lineTo (ASetter' (V2 Double) Double -> V2 Double
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (V2 Double) Double
forall a. Lens' (V2 a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)
        , V2 Double -> V2 Double -> (V2 Double, Path2D)
forall point path.
AnyPath point path =>
point -> point -> (point, path)
lineTo (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 Double
1 Double
1)
        , V2 Double -> V2 Double -> (V2 Double, Path2D)
forall point path.
AnyPath point path =>
point -> point -> (point, path)
lineTo (ASetter' (V2 Double) Double -> V2 Double
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (V2 Double) Double
forall a. Lens' (V2 a) a
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y)
        , V2 Double -> V2 Double -> (V2 Double, Path2D)
forall point path.
AnyPath point path =>
point -> point -> (point, path)
lineTo V2 Double
forall a. Num a => V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
        ]

-- | Square with side length of 1, centered on the origin
centeredSquare :: Shape
centeredSquare :: Shape
centeredSquare = V2 Double -> Shape -> Shape
forall a. Transformable2D a => V2 Double -> a -> a
translate2D (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (-Double
0.5) (-Double
0.5)) Shape
unitSquare