{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
module Waterfall.TwoD.Transforms
( Transformable2D
, rotate2D
, scale2D
, uScale2D
, translate2D
) where
import Waterfall.TwoD.Internal.Path2D (Path2D (..))
import Linear.V2 (V2 (..))
import Linear ((*^))
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 OpenCascade.Inheritance (upcast, unsafeDowncast)
import Control.Monad.IO.Class (liftIO)
import Data.Acquire
import Foreign.Ptr
import Waterfall.TwoD.Internal.Shape (Shape(..))
class Transformable2D a where
rotate2D :: Double -> a -> a
scale2D :: V2 Double -> a -> a
uScale2D :: Double -> a -> a
translate2D :: V2 Double -> a -> a
fromTrsfPath :: Acquire (Ptr GP.Trsf) -> Path2D -> Path2D
fromTrsfPath :: Acquire (Ptr Trsf) -> Path2D -> Path2D
fromTrsfPath Acquire (Ptr Trsf)
mkTrsf (Path2D Acquire (Ptr Wire)
run) = Acquire (Ptr Wire) -> Path2D
Path2D (Acquire (Ptr Wire) -> Path2D) -> Acquire (Ptr Wire) -> Path2D
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
fromTrsfShape :: Acquire (Ptr GP.Trsf) -> Shape -> Shape
fromTrsfShape :: Acquire (Ptr Trsf) -> Shape -> Shape
fromTrsfShape Acquire (Ptr Trsf)
mkTrsf (Shape Acquire (Ptr Shape)
run) = Acquire (Ptr Shape) -> Shape
Shape (Acquire (Ptr Shape) -> Shape) -> Acquire (Ptr Shape) -> Shape
forall a b. (a -> b) -> a -> b
$ do
Ptr Shape
shape <- Acquire (Ptr Shape)
run
Ptr Trsf
trsf <- Acquire (Ptr Trsf)
mkTrsf
Ptr Shape -> Ptr Trsf -> Bool -> Acquire (Ptr Shape)
BRepBuilderAPI.Transform.transform Ptr Shape
shape Ptr Trsf
trsf Bool
True
fromGTrsfPath :: Acquire (Ptr GP.GTrsf) -> Path2D -> Path2D
fromGTrsfPath :: Acquire (Ptr GTrsf) -> Path2D -> Path2D
fromGTrsfPath Acquire (Ptr GTrsf)
mkTrsf (Path2D Acquire (Ptr Wire)
run) = Acquire (Ptr Wire) -> Path2D
Path2D (Acquire (Ptr Wire) -> Path2D) -> Acquire (Ptr Wire) -> Path2D
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
fromGTrsfShape :: Acquire (Ptr GP.GTrsf) -> Shape -> Shape
fromGTrsfShape :: Acquire (Ptr GTrsf) -> Shape -> Shape
fromGTrsfShape Acquire (Ptr GTrsf)
mkTrsf (Shape Acquire (Ptr Shape)
run) = Acquire (Ptr Shape) -> Shape
Shape (Acquire (Ptr Shape) -> Shape) -> Acquire (Ptr Shape) -> Shape
forall a b. (a -> b) -> a -> b
$ do
Ptr Shape
shape <- Acquire (Ptr Shape)
run
Ptr GTrsf
trsf <- Acquire (Ptr GTrsf)
mkTrsf
Ptr Shape -> Ptr GTrsf -> Bool -> Acquire (Ptr Shape)
BRepBuilderAPI.GTransform.gtransform Ptr Shape
shape Ptr GTrsf
trsf Bool
True
rotateTrsf :: Double -> Acquire (Ptr GP.Trsf)
rotateTrsf :: Double -> Acquire (Ptr Trsf)
rotateTrsf 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
0 Double
0 Double
1
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
scaleGTrsf :: V2 Double -> Acquire (Ptr GP.GTrsf)
scaleGTrsf :: V2 Double -> Acquire (Ptr GTrsf)
scaleGTrsf (V2 Double
x Double
y) = 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
1
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
translateTrsf :: V2 Double -> Acquire (Ptr GP.Trsf)
translateTrsf :: V2 Double -> Acquire (Ptr Trsf)
translateTrsf (V2 Double
x Double
y) = 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
0
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 Transformable2D Path2D where
rotate2D :: Double -> Path2D -> Path2D
rotate2D :: Double -> Path2D -> Path2D
rotate2D = Acquire (Ptr Trsf) -> Path2D -> Path2D
fromTrsfPath (Acquire (Ptr Trsf) -> Path2D -> Path2D)
-> (Double -> Acquire (Ptr Trsf)) -> Double -> Path2D -> Path2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Acquire (Ptr Trsf)
rotateTrsf
scale2D :: V2 Double -> Path2D -> Path2D
scale2D :: V2 Double -> Path2D -> Path2D
scale2D = Acquire (Ptr GTrsf) -> Path2D -> Path2D
fromGTrsfPath (Acquire (Ptr GTrsf) -> Path2D -> Path2D)
-> (V2 Double -> Acquire (Ptr GTrsf))
-> V2 Double
-> Path2D
-> Path2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 Double -> Acquire (Ptr GTrsf)
scaleGTrsf
uScale2D :: Double -> Path2D -> Path2D
uScale2D :: Double -> Path2D -> Path2D
uScale2D = Acquire (Ptr Trsf) -> Path2D -> Path2D
fromTrsfPath (Acquire (Ptr Trsf) -> Path2D -> Path2D)
-> (Double -> Acquire (Ptr Trsf)) -> Double -> Path2D -> Path2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Acquire (Ptr Trsf)
uScaleTrsf
translate2D :: V2 Double -> Path2D -> Path2D
translate2D :: V2 Double -> Path2D -> Path2D
translate2D = Acquire (Ptr Trsf) -> Path2D -> Path2D
fromTrsfPath (Acquire (Ptr Trsf) -> Path2D -> Path2D)
-> (V2 Double -> Acquire (Ptr Trsf))
-> V2 Double
-> Path2D
-> Path2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
.V2 Double -> Acquire (Ptr Trsf)
translateTrsf
instance Transformable2D Shape where
rotate2D :: Double -> Shape -> Shape
rotate2D :: Double -> Shape -> Shape
rotate2D = Acquire (Ptr Trsf) -> Shape -> Shape
fromTrsfShape (Acquire (Ptr Trsf) -> Shape -> Shape)
-> (Double -> Acquire (Ptr Trsf)) -> Double -> Shape -> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Acquire (Ptr Trsf)
rotateTrsf
scale2D :: V2 Double -> Shape -> Shape
scale2D :: V2 Double -> Shape -> Shape
scale2D = Acquire (Ptr GTrsf) -> Shape -> Shape
fromGTrsfShape (Acquire (Ptr GTrsf) -> Shape -> Shape)
-> (V2 Double -> Acquire (Ptr GTrsf))
-> V2 Double
-> Shape
-> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 Double -> Acquire (Ptr GTrsf)
scaleGTrsf
uScale2D :: Double -> Shape -> Shape
uScale2D :: Double -> Shape -> Shape
uScale2D = Acquire (Ptr Trsf) -> Shape -> Shape
fromTrsfShape (Acquire (Ptr Trsf) -> Shape -> Shape)
-> (Double -> Acquire (Ptr Trsf)) -> Double -> Shape -> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Acquire (Ptr Trsf)
uScaleTrsf
translate2D :: V2 Double -> Shape -> Shape
translate2D :: V2 Double -> Shape -> Shape
translate2D = Acquire (Ptr Trsf) -> Shape -> Shape
fromTrsfShape (Acquire (Ptr Trsf) -> Shape -> Shape)
-> (V2 Double -> Acquire (Ptr Trsf)) -> V2 Double -> Shape -> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
.V2 Double -> Acquire (Ptr Trsf)
translateTrsf
instance Transformable2D (V2 Double) where
scale2D :: V2 Double -> V2 Double -> V2 Double
scale2D :: V2 Double -> V2 Double -> V2 Double
scale2D = V2 Double -> V2 Double -> V2 Double
forall a. Num a => a -> a -> a
(*)
uScale2D :: Double -> V2 Double -> V2 Double
uScale2D :: Double -> V2 Double -> V2 Double
uScale2D = Double -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
(*^)
rotate2D :: Double -> V2 Double -> V2 Double
rotate2D :: Double -> V2 Double -> V2 Double
rotate2D Double
angle (V2 Double
x Double
y) =
let c :: Double
c = Double -> Double
forall a. Floating a => a -> a
cos Double
angle
s :: Double
s = Double -> Double
forall a. Floating a => a -> a
sin Double
angle
in Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s) (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
c)
translate2D :: V2 Double -> V2 Double -> V2 Double
translate2D :: V2 Double -> V2 Double -> V2 Double
translate2D = V2 Double -> V2 Double -> V2 Double
forall a. Num a => a -> a -> a
(+)