{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
module Waterfall.Transforms
( Transformable
, scale
, uScale
, rotate
, translate
) where
import Waterfall.Internal.Solid (Solid(..))
import Linear.V3 (V3 (..))
import Linear ((*^))
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.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)
class Transformable a where
scale :: V3 Double -> a -> a
uScale :: Double -> a -> a
rotate :: V3 Double -> Double -> a -> a
translate :: V3 Double -> a -> a
fromTrsfSolid :: Acquire (Ptr GP.Trsf) -> Solid -> Solid
fromTrsfSolid :: Acquire (Ptr Trsf) -> Solid -> Solid
fromTrsfSolid Acquire (Ptr Trsf)
mkTrsf (Solid Acquire (Ptr Shape)
run) = Acquire (Ptr Shape) -> Solid
Solid (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ do
Ptr Shape
solid <- Acquire (Ptr Shape)
run
Ptr Trsf
trsf <- Acquire (Ptr Trsf)
mkTrsf
Ptr Shape -> Ptr Trsf -> Bool -> Acquire (Ptr Shape)
BRepBuilderAPI.Transform.transform Ptr Shape
solid Ptr Trsf
trsf Bool
True
fromGTrsfSolid :: Acquire (Ptr GP.GTrsf) -> Solid -> Solid
fromGTrsfSolid :: Acquire (Ptr GTrsf) -> Solid -> Solid
fromGTrsfSolid Acquire (Ptr GTrsf)
mkTrsf (Solid Acquire (Ptr Shape)
run) = Acquire (Ptr Shape) -> Solid
Solid (Acquire (Ptr Shape) -> Solid) -> Acquire (Ptr Shape) -> Solid
forall a b. (a -> b) -> a -> b
$ do
Ptr Shape
solid <- Acquire (Ptr Shape)
run
Ptr GTrsf
trsf <- Acquire (Ptr GTrsf)
mkTrsf
Ptr Shape -> Ptr GTrsf -> Bool -> Acquire (Ptr Shape)
BRepBuilderAPI.GTransform.gtransform Ptr Shape
solid Ptr GTrsf
trsf Bool
True
fromTrsfPath :: Acquire (Ptr GP.Trsf) -> Path -> Path
fromTrsfPath :: Acquire (Ptr Trsf) -> Path -> Path
fromTrsfPath Acquire (Ptr Trsf)
mkTrsf (Path Acquire (Ptr Wire)
run) = Acquire (Ptr Wire) -> Path
Path (Acquire (Ptr Wire) -> Path) -> Acquire (Ptr Wire) -> Path
forall a b. (a -> b) -> a -> b
$ do
Ptr Wire
path <- Acquire (Ptr Wire)
run
Ptr Trsf
trsf <- Acquire (Ptr Trsf)
mkTrsf
(IO (Ptr Wire) -> Acquire (Ptr Wire)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Wire) -> Acquire (Ptr Wire))
-> (Ptr Shape -> IO (Ptr Wire)) -> Ptr Shape -> Acquire (Ptr Wire)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Shape -> IO (Ptr Wire)
forall a b. DiscriminatedSubTypeOf a b => Ptr a -> IO (Ptr b)
unsafeDowncast) (Ptr Shape -> Acquire (Ptr Wire))
-> Acquire (Ptr Shape) -> Acquire (Ptr Wire)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Shape -> Ptr Trsf -> Bool -> Acquire (Ptr Shape)
BRepBuilderAPI.Transform.transform (Ptr Wire -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr Wire
path) Ptr Trsf
trsf Bool
True
fromGTrsfPath :: Acquire (Ptr GP.GTrsf) -> Path -> Path
fromGTrsfPath :: Acquire (Ptr GTrsf) -> Path -> Path
fromGTrsfPath Acquire (Ptr GTrsf)
mkTrsf (Path Acquire (Ptr Wire)
run) = Acquire (Ptr Wire) -> Path
Path (Acquire (Ptr Wire) -> Path) -> Acquire (Ptr Wire) -> Path
forall a b. (a -> b) -> a -> b
$ do
Ptr Wire
path <- Acquire (Ptr Wire)
run
Ptr GTrsf
trsf <- Acquire (Ptr GTrsf)
mkTrsf
(IO (Ptr Wire) -> Acquire (Ptr Wire)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Wire) -> Acquire (Ptr Wire))
-> (Ptr Shape -> IO (Ptr Wire)) -> Ptr Shape -> Acquire (Ptr Wire)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Shape -> IO (Ptr Wire)
forall a b. DiscriminatedSubTypeOf a b => Ptr a -> IO (Ptr b)
unsafeDowncast) (Ptr Shape -> Acquire (Ptr Wire))
-> Acquire (Ptr Shape) -> Acquire (Ptr Wire)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Shape -> Ptr GTrsf -> Bool -> Acquire (Ptr Shape)
BRepBuilderAPI.GTransform.gtransform (Ptr Wire -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr Wire
path) Ptr GTrsf
trsf Bool
True
scaleTrsf :: V3 Double -> Acquire (Ptr GP.GTrsf)
scaleTrsf :: V3 Double -> Acquire (Ptr GTrsf)
scaleTrsf (V3 Double
x Double
y Double
z ) = do
Ptr GTrsf
trsf <- Acquire (Ptr GTrsf)
GP.GTrsf.new
IO (Ptr GTrsf) -> Acquire (Ptr GTrsf)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr GTrsf) -> Acquire (Ptr GTrsf))
-> IO (Ptr GTrsf) -> Acquire (Ptr GTrsf)
forall a b. (a -> b) -> a -> b
$ do
Ptr GTrsf -> Int -> Int -> Double -> IO ()
GP.GTrsf.setValue Ptr GTrsf
trsf Int
1 Int
1 Double
x
Ptr GTrsf -> Int -> Int -> Double -> IO ()
GP.GTrsf.setValue Ptr GTrsf
trsf Int
2 Int
2 Double
y
Ptr GTrsf -> Int -> Int -> Double -> IO ()
GP.GTrsf.setValue Ptr GTrsf
trsf Int
3 Int
3 Double
z
Ptr GTrsf -> IO ()
GP.GTrsf.setForm Ptr GTrsf
trsf
Ptr GTrsf -> IO (Ptr GTrsf)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GTrsf
trsf
uScaleTrsf :: Double -> Acquire (Ptr GP.Trsf)
uScaleTrsf :: Double -> Acquire (Ptr Trsf)
uScaleTrsf Double
factor = do
Ptr Trsf
trsf <- Acquire (Ptr Trsf)
GP.Trsf.new
Ptr Pnt
o <- Acquire (Ptr Pnt)
GP.origin
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 Trsf -> Ptr Pnt -> Double -> IO ()
GP.Trsf.setScale Ptr Trsf
trsf Ptr Pnt
o Double
factor
Ptr Trsf -> Acquire (Ptr Trsf)
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Trsf
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
Ptr Trsf
trsf <- Acquire (Ptr Trsf)
GP.Trsf.new
Ptr Pnt
o <- Acquire (Ptr Pnt)
GP.origin
Ptr Dir
dir <- Double -> Double -> Double -> Acquire (Ptr Dir)
GP.Dir.new Double
ax Double
ay Double
az
Ptr Ax1
axis <- Ptr Pnt -> Ptr Dir -> Acquire (Ptr Ax1)
GP.Ax1.new Ptr Pnt
o Ptr Dir
dir
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 Trsf -> Ptr Ax1 -> Double -> IO ()
GP.Trsf.setRotationAboutAxisAngle Ptr Trsf
trsf Ptr Ax1
axis Double
angle
Ptr Trsf -> Acquire (Ptr Trsf)
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Trsf
trsf
translateTrsf :: V3 Double -> Acquire (Ptr GP.Trsf)
translateTrsf :: V3 Double -> Acquire (Ptr Trsf)
translateTrsf (V3 Double
x Double
y Double
z) = do
Ptr Trsf
trsf <- Acquire (Ptr Trsf)
GP.Trsf.new
Ptr Vec
vec <- Double -> Double -> Double -> Acquire (Ptr Vec)
GP.Vec.new Double
x Double
y Double
z
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 Trsf -> Ptr Vec -> IO ()
GP.Trsf.setTranslation Ptr Trsf
trsf Ptr Vec
vec
Ptr Trsf -> Acquire (Ptr Trsf)
forall a. a -> Acquire a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Trsf
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
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
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
(*)
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
(+)