{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
module Waterfall.Transforms
( Transformable
, scale
, uScale
, rotate
, translate
, mirror
) where
import Waterfall.Internal.Solid (Solid (..), acquireSolid, solidFromAcquire)
import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire) 
import Linear.V3 (V3 (..))
import Linear ((*^), normalize, dot )
import qualified Linear.Quaternion as Quaternion
import qualified OpenCascade.GP.Trsf as GP.Trsf
import qualified OpenCascade.GP as GP
import qualified OpenCascade.GP.GTrsf as GP.GTrsf
import qualified OpenCascade.GP.Ax1 as GP.Ax1
import qualified OpenCascade.GP.Ax2 as GP.Ax2
import qualified OpenCascade.GP.Dir as GP.Dir
import qualified OpenCascade.GP.Vec as GP.Vec
import qualified OpenCascade.BRepBuilderAPI.Transform  as BRepBuilderAPI.Transform
import qualified OpenCascade.BRepBuilderAPI.GTransform  as BRepBuilderAPI.GTransform
import Control.Monad.IO.Class (liftIO)
import Data.Acquire
import Foreign.Ptr
import Waterfall.Internal.Path (Path(..))
import OpenCascade.Inheritance (upcast, unsafeDowncast)

-- | Typeclass for objects that can be manipulated in 3D space
class Transformable a where
    -- | Scale by different amounts along the x, y and z axes
    scale :: V3 Double -> a -> a
    -- Uniform Scale
    -- | Scale uniformally along all axes
    uScale :: Double -> a -> a
    -- | Rotate by Axis and Angle (in radians)
    rotate :: V3 Double -> Double -> a -> a
    -- | Translate by a vector in 3D space
    translate :: V3 Double -> a -> a
    -- | Mirror in the plane, which passes through the origin, tangent to the specified vector
    mirror :: V3 Double -> a -> a


fromTrsfSolid :: Acquire (Ptr GP.Trsf) -> Solid -> Solid
fromTrsfSolid :: Acquire (Ptr Trsf) -> Solid -> Solid
fromTrsfSolid Acquire (Ptr Trsf)
mkTrsf Solid
s = Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ do 
    solid <- Solid -> Acquire (Ptr Shape)
acquireSolid Solid
s
    trsf <- mkTrsf 
    BRepBuilderAPI.Transform.transform solid trsf True 


fromGTrsfSolid :: Acquire (Ptr GP.GTrsf) -> Solid -> Solid
fromGTrsfSolid :: Acquire (Ptr GTrsf) -> Solid -> Solid
fromGTrsfSolid Acquire (Ptr GTrsf)
mkTrsf Solid
s = Acquire (Ptr Shape) -> Solid
solidFromAcquire (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ do 
    solid <- Solid -> Acquire (Ptr Shape)
acquireSolid Solid
s
    trsf <- mkTrsf 
    BRepBuilderAPI.GTransform.gtransform solid trsf True 


fromTrsfPath :: Acquire (Ptr GP.Trsf) -> Path -> Path
fromTrsfPath :: Acquire (Ptr Trsf) -> Path -> Path
fromTrsfPath Acquire (Ptr Trsf)
mkTrsf (Path Ptr Wire
p) = 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 (Acquire (Ptr Wire) -> Path) -> Acquire (Ptr Wire) -> Path
forall a b. (a -> b) -> a -> b
$ do 
    path <- Ptr Wire -> Acquire (Ptr Wire)
forall a. a -> Acquire a
toAcquire Ptr Wire
p
    trsf <- mkTrsf 
    (liftIO . unsafeDowncast) =<< BRepBuilderAPI.Transform.transform (upcast path) trsf True 

fromGTrsfPath :: Acquire (Ptr GP.GTrsf) -> Path -> Path
fromGTrsfPath :: Acquire (Ptr GTrsf) -> Path -> Path
fromGTrsfPath Acquire (Ptr GTrsf)
mkTrsf (Path Ptr Wire
p) = 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 (Acquire (Ptr Wire) -> Path) -> Acquire (Ptr Wire) -> Path
forall a b. (a -> b) -> a -> b
$ do 
    path <- Ptr Wire -> Acquire (Ptr Wire)
forall a. a -> Acquire a
toAcquire Ptr Wire
p
    trsf <- mkTrsf 
    (liftIO . unsafeDowncast) =<< BRepBuilderAPI.GTransform.gtransform (upcast path) trsf True 

scaleTrsf :: V3 Double -> Acquire (Ptr GP.GTrsf)
scaleTrsf :: V3 Double -> Acquire (Ptr GTrsf)
scaleTrsf (V3 Double
x Double
y Double
z ) = do
    trsf <- Acquire (Ptr GTrsf)
GP.GTrsf.new 
    liftIO $ do
        GP.GTrsf.setValue trsf 1 1 x
        GP.GTrsf.setValue trsf 2 2 y
        GP.GTrsf.setValue trsf 3 3 z
        GP.GTrsf.setForm trsf
        return trsf

uScaleTrsf :: Double -> Acquire (Ptr GP.Trsf)
uScaleTrsf :: Double -> Acquire (Ptr Trsf)
uScaleTrsf Double
factor = do
    trsf <- Acquire (Ptr Trsf)
GP.Trsf.new
    o <- GP.origin
    liftIO $ GP.Trsf.setScale trsf o factor 
    return trsf

rotateTrsf :: V3 Double -> Double -> Acquire (Ptr GP.Trsf)
rotateTrsf :: V3 Double -> Double -> Acquire (Ptr Trsf)
rotateTrsf (V3 Double
ax Double
ay Double
az) Double
angle = do
    trsf <- Acquire (Ptr Trsf)
GP.Trsf.new
    o <- GP.origin
    dir <- GP.Dir.new ax ay az
    axis <- GP.Ax1.new o dir
    liftIO $ GP.Trsf.setRotationAboutAxisAngle trsf axis angle
    return trsf

translateTrsf :: V3 Double -> Acquire (Ptr GP.Trsf)
translateTrsf :: V3 Double -> Acquire (Ptr Trsf)
translateTrsf (V3 Double
x Double
y Double
z) = do
    trsf <- Acquire (Ptr Trsf)
GP.Trsf.new
    vec <- GP.Vec.new x y z
    liftIO $ GP.Trsf.setTranslation trsf vec
    return trsf

mirrorTrsf :: V3 Double -> Acquire (Ptr GP.Trsf)
mirrorTrsf :: V3 Double -> Acquire (Ptr Trsf)
mirrorTrsf (V3 Double
x Double
y Double
z) = do
    trsf <- Acquire (Ptr Trsf)
GP.Trsf.new
    dir <- GP.Dir.new x y z
    axis <- GP.xoy
    liftIO $ do 
        GP.Ax2.setDirection axis dir
        GP.Trsf.setMirrorAboutAx2 trsf axis
    return trsf
    
instance Transformable Solid where
    scale :: V3 Double -> Solid -> Solid
    scale :: V3 Double -> Solid -> Solid
scale = Acquire (Ptr GTrsf) -> Solid -> Solid
fromGTrsfSolid (Acquire (Ptr GTrsf) -> Solid -> Solid)
-> (V3 Double -> Acquire (Ptr GTrsf))
-> V3 Double
-> Solid
-> Solid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V3 Double -> Acquire (Ptr GTrsf)
scaleTrsf

    uScale :: Double -> Solid -> Solid
    uScale :: Double -> Solid -> Solid
uScale = Acquire (Ptr Trsf) -> Solid -> Solid
fromTrsfSolid (Acquire (Ptr Trsf) -> Solid -> Solid)
-> (Double -> Acquire (Ptr Trsf)) -> Double -> Solid -> Solid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Acquire (Ptr Trsf)
uScaleTrsf

    rotate :: V3 Double -> Double -> Solid -> Solid
    rotate :: V3 Double -> Double -> Solid -> Solid
rotate V3 Double
axis Double
angle = Acquire (Ptr Trsf) -> Solid -> Solid
fromTrsfSolid (V3 Double -> Double -> Acquire (Ptr Trsf)
rotateTrsf V3 Double
axis Double
angle)

    translate :: V3 Double -> Solid -> Solid
    translate :: V3 Double -> Solid -> Solid
translate = Acquire (Ptr Trsf) -> Solid -> Solid
fromTrsfSolid (Acquire (Ptr Trsf) -> Solid -> Solid)
-> (V3 Double -> Acquire (Ptr Trsf)) -> V3 Double -> Solid -> Solid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V3 Double -> Acquire (Ptr Trsf)
translateTrsf

    mirror :: V3 Double -> Solid -> Solid
    mirror :: V3 Double -> Solid -> Solid
mirror = Acquire (Ptr Trsf) -> Solid -> Solid
fromTrsfSolid (Acquire (Ptr Trsf) -> Solid -> Solid)
-> (V3 Double -> Acquire (Ptr Trsf)) -> V3 Double -> Solid -> Solid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V3 Double -> Acquire (Ptr Trsf)
mirrorTrsf

instance Transformable Path where
    scale :: V3 Double -> Path -> Path
    scale :: V3 Double -> Path -> Path
scale = Acquire (Ptr GTrsf) -> Path -> Path
fromGTrsfPath (Acquire (Ptr GTrsf) -> Path -> Path)
-> (V3 Double -> Acquire (Ptr GTrsf)) -> V3 Double -> Path -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V3 Double -> Acquire (Ptr GTrsf)
scaleTrsf

    uScale :: Double -> Path -> Path
    uScale :: Double -> Path -> Path
uScale = Acquire (Ptr Trsf) -> Path -> Path
fromTrsfPath (Acquire (Ptr Trsf) -> Path -> Path)
-> (Double -> Acquire (Ptr Trsf)) -> Double -> Path -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Acquire (Ptr Trsf)
uScaleTrsf

    rotate :: V3 Double -> Double -> Path -> Path
    rotate :: V3 Double -> Double -> Path -> Path
rotate V3 Double
axis Double
angle = Acquire (Ptr Trsf) -> Path -> Path
fromTrsfPath (V3 Double -> Double -> Acquire (Ptr Trsf)
rotateTrsf V3 Double
axis Double
angle)

    translate :: V3 Double -> Path -> Path
    translate :: V3 Double -> Path -> Path
translate = Acquire (Ptr Trsf) -> Path -> Path
fromTrsfPath (Acquire (Ptr Trsf) -> Path -> Path)
-> (V3 Double -> Acquire (Ptr Trsf)) -> V3 Double -> Path -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V3 Double -> Acquire (Ptr Trsf)
translateTrsf
    
    mirror :: V3 Double -> Path -> Path
    mirror :: V3 Double -> Path -> Path
mirror = Acquire (Ptr Trsf) -> Path -> Path
fromTrsfPath (Acquire (Ptr Trsf) -> Path -> Path)
-> (V3 Double -> Acquire (Ptr Trsf)) -> V3 Double -> Path -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V3 Double -> Acquire (Ptr Trsf)
mirrorTrsf

        
instance Transformable (V3 Double) where
    scale :: V3 Double -> V3 Double  -> V3 Double
    scale :: V3 Double -> V3 Double -> V3 Double
scale = V3 Double -> V3 Double -> V3 Double
forall a. Num a => a -> a -> a
(*)

    -- Uniform Scale
    uScale :: Double -> V3 Double -> V3 Double
    uScale :: Double -> V3 Double -> V3 Double
uScale = Double -> V3 Double -> V3 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
(*^)

    rotate :: V3 Double -> Double -> V3 Double -> V3 Double 
    rotate :: V3 Double -> Double -> V3 Double -> V3 Double
rotate V3 Double
axis Double
angle = Quaternion Double -> V3 Double -> V3 Double
forall a.
(Conjugate a, RealFloat a) =>
Quaternion a -> V3 a -> V3 a
Quaternion.rotate (V3 Double -> Double -> Quaternion Double
forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
Quaternion.axisAngle V3 Double
axis Double
angle)

    translate :: V3 Double -> V3 Double -> V3 Double 
    translate :: V3 Double -> V3 Double -> V3 Double
translate = V3 Double -> V3 Double -> V3 Double
forall a. Num a => a -> a -> a
(+)

    mirror :: V3 Double -> V3 Double -> V3 Double 
    mirror :: V3 Double -> V3 Double -> V3 Double
mirror V3 Double
mirrorVec V3 Double
toMirror = 
        let nm :: V3 Double
nm = V3 Double -> V3 Double
forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize V3 Double
mirrorVec
        in V3 Double
toMirror V3 Double -> V3 Double -> V3 Double
forall a. Num a => a -> a -> a
- (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (V3 Double
nm V3 Double -> V3 Double -> Double
forall a. Num a => V3 a -> V3 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` V3 Double
toMirror) Double -> V3 Double -> V3 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V3 Double
nm)