{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
module Waterfall.TwoD.Transforms
( Transformable2D
, matTransform2D
, rotate2D
, scale2D
, uScale2D
, translate2D
, mirror2D
) where

import Waterfall.TwoD.Internal.Path2D (Path2D (..))
import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire)
import Linear ((*^), normalize, dot, V3 (..), V2 (..), (!*), _xy, _z, unit, M23)
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 OpenCascade.Inheritance (upcast, unsafeDowncast)
import Control.Monad.IO.Class (liftIO)
import Data.Acquire
import Foreign.Ptr
import Waterfall.TwoD.Internal.Shape (Shape(..))
import Data.Function ((&))
import Control.Lens ((.~), (%~))
import Control.Monad (forM)
import Waterfall.Internal.Path.Common (RawPath(..))
import Waterfall.Internal.Diagram (RawDiagram (..))

-- | Typeclass for objects that can be manipulated in 2D space
class Transformable2D a where
    -- | Directly transform with a transformation matrix
    matTransform2D :: M23 Double -> a -> a
    -- | Rotate by an angle (in radians) about the origin
    rotate2D :: Double -> a -> a
    -- | Scale by different amounts along the x and y axes
    scale2D :: V2 Double -> a -> a
    -- | Scale uniformally along both axes
    uScale2D :: Double -> a -> a
    -- | Translate by a distance in 2D space
    translate2D :: V2 Double -> a -> a
    -- | Mirror in the line, which passes through the origin, tangent to the specified vector
    -- 
    -- Note that in order to maintain consistency with 'Waterfall.Transforms.Transformable',
    -- the mirror is in the line / tangent / to the vector, not in the line / parallel / to the vector
    mirror2D :: V2 Double -> a -> a

fromTrsfPath :: (V2 Double -> V2 Double) -> Acquire (Ptr GP.Trsf) -> Path2D -> Path2D
fromTrsfPath :: (V2 Double -> V2 Double) -> Acquire (Ptr Trsf) -> Path2D -> Path2D
fromTrsfPath V2 Double -> V2 Double
_ Acquire (Ptr Trsf)
mkTrsf (Path2D (ComplexRawPath Ptr Wire
p)) = RawPath -> Path2D
Path2D (RawPath -> Path2D)
-> (Acquire (Ptr Wire) -> RawPath) -> Acquire (Ptr Wire) -> Path2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Wire -> RawPath
ComplexRawPath (Ptr Wire -> RawPath)
-> (Acquire (Ptr Wire) -> Ptr Wire)
-> Acquire (Ptr Wire)
-> RawPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr Wire) -> Ptr Wire
forall a. Acquire a -> a
unsafeFromAcquire (Acquire (Ptr Wire) -> Path2D) -> Acquire (Ptr Wire) -> Path2D
forall a b. (a -> b) -> a -> b
$ do 
    Ptr Wire
path <- Ptr Wire -> Acquire (Ptr Wire)
forall a. a -> Acquire a
toAcquire Ptr Wire
p
    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 
fromTrsfPath V2 Double -> V2 Double
f Acquire (Ptr Trsf)
_ (Path2D (SinglePointRawPath V3 Double
v)) = RawPath -> Path2D
Path2D (RawPath -> Path2D)
-> (V3 Double -> RawPath) -> V3 Double -> Path2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V3 Double -> RawPath
SinglePointRawPath (V3 Double -> Path2D) -> V3 Double -> Path2D
forall a b. (a -> b) -> a -> b
$ (V3 Double
v V3 Double -> (V3 Double -> V3 Double) -> V3 Double
forall a b. a -> (a -> b) -> b
& (V2 Double -> Identity (V2 Double))
-> V3 Double -> Identity (V3 Double)
forall a. Lens' (V3 a) (V2 a)
forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy ((V2 Double -> Identity (V2 Double))
 -> V3 Double -> Identity (V3 Double))
-> (V2 Double -> V2 Double) -> V3 Double -> V3 Double
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ V2 Double -> V2 Double
f)
fromTrsfPath V2 Double -> V2 Double
_ Acquire (Ptr Trsf)
_ (Path2D RawPath
EmptyRawPath) = RawPath -> Path2D
Path2D RawPath
EmptyRawPath

fromTrsfShape :: Acquire (Ptr GP.Trsf) -> Shape -> Shape
fromTrsfShape :: Acquire (Ptr Trsf) -> Shape -> Shape
fromTrsfShape Acquire (Ptr Trsf)
mkTrsf (Shape Ptr Shape
theRawShape) = 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 Shape
shape <- Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
toAcquire Ptr Shape
theRawShape
    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 :: (V2 Double -> V2 Double) -> Acquire (Maybe (Ptr GP.GTrsf)) -> Path2D -> Path2D
fromGTrsfPath :: (V2 Double -> V2 Double)
-> Acquire (Maybe (Ptr GTrsf)) -> Path2D -> Path2D
fromGTrsfPath V2 Double -> V2 Double
_ Acquire (Maybe (Ptr GTrsf))
mkTrsf (Path2D (ComplexRawPath Ptr Wire
p)) = RawPath -> Path2D
Path2D (RawPath -> Path2D)
-> (Acquire (Ptr Wire) -> RawPath) -> Acquire (Ptr Wire) -> Path2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Wire -> RawPath
ComplexRawPath (Ptr Wire -> RawPath)
-> (Acquire (Ptr Wire) -> Ptr Wire)
-> Acquire (Ptr Wire)
-> RawPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire (Ptr Wire) -> Ptr Wire
forall a. Acquire a -> a
unsafeFromAcquire  (Acquire (Ptr Wire) -> Path2D) -> Acquire (Ptr Wire) -> Path2D
forall a b. (a -> b) -> a -> b
$ do 
    Ptr Wire
path <- Ptr Wire -> Acquire (Ptr Wire)
forall a. a -> Acquire a
toAcquire Ptr Wire
p
    Maybe (Ptr GTrsf)
trsfMay <- Acquire (Maybe (Ptr GTrsf))
mkTrsf 
    case Maybe (Ptr GTrsf)
trsfMay of
        Just Ptr GTrsf
trsf -> (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 
        Maybe (Ptr GTrsf)
Nothing -> Ptr Wire -> Acquire (Ptr Wire)
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr Wire
path
fromGTrsfPath V2 Double -> V2 Double
f Acquire (Maybe (Ptr GTrsf))
_ (Path2D (SinglePointRawPath V3 Double
v)) = RawPath -> Path2D
Path2D (RawPath -> Path2D)
-> (V3 Double -> RawPath) -> V3 Double -> Path2D
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V3 Double -> RawPath
SinglePointRawPath (V3 Double -> Path2D) -> V3 Double -> Path2D
forall a b. (a -> b) -> a -> b
$ (V3 Double
v V3 Double -> (V3 Double -> V3 Double) -> V3 Double
forall a b. a -> (a -> b) -> b
& (V2 Double -> Identity (V2 Double))
-> V3 Double -> Identity (V3 Double)
forall a. Lens' (V3 a) (V2 a)
forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy ((V2 Double -> Identity (V2 Double))
 -> V3 Double -> Identity (V3 Double))
-> (V2 Double -> V2 Double) -> V3 Double -> V3 Double
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ V2 Double -> V2 Double
f)
fromGTrsfPath V2 Double -> V2 Double
_ Acquire (Maybe (Ptr GTrsf))
_ (Path2D RawPath
EmptyRawPath) = RawPath -> Path2D
Path2D RawPath
EmptyRawPath

fromGTrsfShape :: Acquire (Maybe (Ptr GP.GTrsf)) -> Shape -> Shape
fromGTrsfShape :: Acquire (Maybe (Ptr GTrsf)) -> Shape -> Shape
fromGTrsfShape Acquire (Maybe (Ptr GTrsf))
mkTrsf (Shape Ptr Shape
theRawShape) = 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 Shape
shape <- Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
toAcquire Ptr Shape
theRawShape 
    Maybe (Ptr GTrsf)
trsfMay <- Acquire (Maybe (Ptr GTrsf))
mkTrsf 
    case Maybe (Ptr GTrsf)
trsfMay of
        Just Ptr GTrsf
trsf -> Ptr Shape -> Ptr GTrsf -> Bool -> Acquire (Ptr Shape)
BRepBuilderAPI.GTransform.gtransform Ptr Shape
shape Ptr GTrsf
trsf Bool
True 
        Maybe (Ptr GTrsf)
Nothing -> Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr Shape
shape

fromTrsfDiagram :: Acquire (Ptr GP.Trsf) -> RawDiagram -> RawDiagram
fromTrsfDiagram :: Acquire (Ptr Trsf) -> RawDiagram -> RawDiagram
fromTrsfDiagram Acquire (Ptr Trsf)
mkTrsf (RawDiagram TypeOfResultingEdge -> Bool -> Bool -> Acquire [Ptr Edge]
runTheDiagram) = (TypeOfResultingEdge -> Bool -> Bool -> Acquire [Ptr Edge])
-> RawDiagram
RawDiagram ((TypeOfResultingEdge -> Bool -> Bool -> Acquire [Ptr Edge])
 -> RawDiagram)
-> (TypeOfResultingEdge -> Bool -> Bool -> Acquire [Ptr Edge])
-> RawDiagram
forall a b. (a -> b) -> a -> b
$ \TypeOfResultingEdge
lt Bool
v Bool
is3D -> do 
    [Ptr Edge]
edges <- TypeOfResultingEdge -> Bool -> Bool -> Acquire [Ptr Edge]
runTheDiagram TypeOfResultingEdge
lt Bool
v Bool
is3D
    Ptr Trsf
trsf <- Acquire (Ptr Trsf)
mkTrsf 
    [Ptr Edge]
-> (Ptr Edge -> Acquire (Ptr Edge)) -> Acquire [Ptr Edge]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Ptr Edge]
edges ((Ptr Edge -> Acquire (Ptr Edge)) -> Acquire [Ptr Edge])
-> (Ptr Edge -> Acquire (Ptr Edge)) -> Acquire [Ptr Edge]
forall a b. (a -> b) -> a -> b
$ \Ptr Edge
s -> (IO (Ptr Edge) -> Acquire (Ptr Edge)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Edge) -> Acquire (Ptr Edge))
-> (Ptr Shape -> IO (Ptr Edge)) -> Ptr Shape -> Acquire (Ptr Edge)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Shape -> IO (Ptr Edge)
forall a b. DiscriminatedSubTypeOf a b => Ptr a -> IO (Ptr b)
unsafeDowncast) (Ptr Shape -> Acquire (Ptr Edge))
-> Acquire (Ptr Shape) -> Acquire (Ptr Edge)
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 Edge -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr Edge
s) Ptr Trsf
trsf Bool
True

fromGTrsfDiagram :: Acquire (Maybe (Ptr GP.GTrsf)) -> RawDiagram -> RawDiagram
fromGTrsfDiagram :: Acquire (Maybe (Ptr GTrsf)) -> RawDiagram -> RawDiagram
fromGTrsfDiagram Acquire (Maybe (Ptr GTrsf))
mkTrsf (RawDiagram TypeOfResultingEdge -> Bool -> Bool -> Acquire [Ptr Edge]
runTheDiagram) = (TypeOfResultingEdge -> Bool -> Bool -> Acquire [Ptr Edge])
-> RawDiagram
RawDiagram ((TypeOfResultingEdge -> Bool -> Bool -> Acquire [Ptr Edge])
 -> RawDiagram)
-> (TypeOfResultingEdge -> Bool -> Bool -> Acquire [Ptr Edge])
-> RawDiagram
forall a b. (a -> b) -> a -> b
$ \TypeOfResultingEdge
lt Bool
v Bool
is3D -> do 
    [Ptr Edge]
edges <- TypeOfResultingEdge -> Bool -> Bool -> Acquire [Ptr Edge]
runTheDiagram TypeOfResultingEdge
lt Bool
v Bool
is3D
    Maybe (Ptr GTrsf)
trsfMay <- Acquire (Maybe (Ptr GTrsf))
mkTrsf 
    case Maybe (Ptr GTrsf)
trsfMay of
        Just Ptr GTrsf
trsf -> [Ptr Edge]
-> (Ptr Edge -> Acquire (Ptr Edge)) -> Acquire [Ptr Edge]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Ptr Edge]
edges ((Ptr Edge -> Acquire (Ptr Edge)) -> Acquire [Ptr Edge])
-> (Ptr Edge -> Acquire (Ptr Edge)) -> Acquire [Ptr Edge]
forall a b. (a -> b) -> a -> b
$ \Ptr Edge
s -> (IO (Ptr Edge) -> Acquire (Ptr Edge)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Edge) -> Acquire (Ptr Edge))
-> (Ptr Shape -> IO (Ptr Edge)) -> Ptr Shape -> Acquire (Ptr Edge)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Shape -> IO (Ptr Edge)
forall a b. DiscriminatedSubTypeOf a b => Ptr a -> IO (Ptr b)
unsafeDowncast) (Ptr Shape -> Acquire (Ptr Edge))
-> Acquire (Ptr Shape) -> Acquire (Ptr Edge)
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 Edge -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast Ptr Edge
s) Ptr GTrsf
trsf Bool
True 
        Maybe (Ptr GTrsf)
Nothing -> [Ptr Edge] -> Acquire [Ptr Edge]
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Ptr Edge]
edges

matrixGTrsf :: M23 Double -> Acquire (Maybe (Ptr GP.GTrsf))
matrixGTrsf :: M23 Double -> Acquire (Maybe (Ptr GTrsf))
matrixGTrsf (V2 (V3 Double
1 Double
0 Double
0) (V3 Double
0 Double
1 Double
0)) = Maybe (Ptr GTrsf) -> Acquire (Maybe (Ptr GTrsf))
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Ptr GTrsf)
forall a. Maybe a
Nothing
matrixGTrsf (V2 (V3 Double
v11 Double
v12 Double
v13) (V3 Double
v21 Double
v22 Double
v23)) = do
    Ptr GTrsf
trsf <- Acquire (Ptr GTrsf)
GP.GTrsf.new
    IO (Maybe (Ptr GTrsf)) -> Acquire (Maybe (Ptr GTrsf))
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Ptr GTrsf)) -> Acquire (Maybe (Ptr GTrsf)))
-> IO (Maybe (Ptr GTrsf)) -> Acquire (Maybe (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
v11
        Ptr GTrsf -> Int -> Int -> Double -> IO ()
GP.GTrsf.setValue Ptr GTrsf
trsf Int
1 Int
2 Double
v12
        Ptr GTrsf -> Int -> Int -> Double -> IO ()
GP.GTrsf.setValue Ptr GTrsf
trsf Int
1 Int
4 Double
v13
        Ptr GTrsf -> Int -> Int -> Double -> IO ()
GP.GTrsf.setValue Ptr GTrsf
trsf Int
2 Int
1 Double
v21
        Ptr GTrsf -> Int -> Int -> Double -> IO ()
GP.GTrsf.setValue Ptr GTrsf
trsf Int
2 Int
2 Double
v22
        Ptr GTrsf -> Int -> Int -> Double -> IO ()
GP.GTrsf.setValue Ptr GTrsf
trsf Int
2 Int
4 Double
v23
        Ptr GTrsf -> IO ()
GP.GTrsf.setForm Ptr GTrsf
trsf
        Maybe (Ptr GTrsf) -> IO (Maybe (Ptr GTrsf))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ptr GTrsf) -> IO (Maybe (Ptr GTrsf)))
-> (Ptr GTrsf -> Maybe (Ptr GTrsf))
-> Ptr GTrsf
-> IO (Maybe (Ptr GTrsf))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr GTrsf -> Maybe (Ptr GTrsf)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr GTrsf -> IO (Maybe (Ptr GTrsf)))
-> Ptr GTrsf -> IO (Maybe (Ptr GTrsf))
forall a b. (a -> b) -> a -> b
$ Ptr GTrsf
trsf

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 (Maybe (Ptr GP.GTrsf))
scaleGTrsf :: V2 Double -> Acquire (Maybe (Ptr GTrsf))
scaleGTrsf v :: V2 Double
v@(V2 Double
x Double
y) = 
    if V2 Double
v V2 Double -> V2 Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 Double
1 Double
1 
        then Maybe (Ptr GTrsf) -> Acquire (Maybe (Ptr GTrsf))
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Ptr GTrsf)
forall a. Maybe a
Nothing
        else do
            Ptr GTrsf
trsf <- Acquire (Ptr GTrsf)
GP.GTrsf.new 
            IO (Maybe (Ptr GTrsf)) -> Acquire (Maybe (Ptr GTrsf))
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Ptr GTrsf)) -> Acquire (Maybe (Ptr GTrsf)))
-> IO (Maybe (Ptr GTrsf)) -> Acquire (Maybe (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
                Maybe (Ptr GTrsf) -> IO (Maybe (Ptr GTrsf))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ptr GTrsf) -> IO (Maybe (Ptr GTrsf)))
-> (Ptr GTrsf -> Maybe (Ptr GTrsf))
-> Ptr GTrsf
-> IO (Maybe (Ptr GTrsf))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr GTrsf -> Maybe (Ptr GTrsf)
forall a. a -> Maybe a
Just (Ptr GTrsf -> IO (Maybe (Ptr GTrsf)))
-> Ptr GTrsf -> IO (Maybe (Ptr GTrsf))
forall a b. (a -> b) -> a -> b
$ 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
    
mirrorTrsf :: V2 Double -> Acquire (Ptr GP.Trsf)
mirrorTrsf :: V2 Double -> Acquire (Ptr Trsf)
mirrorTrsf (V2 Double
x Double
y) = do 
    Ptr Trsf
trsf <- Acquire (Ptr Trsf)
GP.Trsf.new
    Ptr Dir
dir <- Double -> Double -> Double -> Acquire (Ptr Dir)
GP.Dir.new Double
x Double
y Double
0
    Ptr Ax2
axis <- Acquire (Ptr Ax2)
GP.xoy
    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 Ax2 -> Ptr Dir -> IO ()
GP.Ax2.setDirection Ptr Ax2
axis Ptr Dir
dir
        Ptr Trsf -> Ptr Ax2 -> IO ()
GP.Trsf.setMirrorAboutAx2 Ptr Trsf
trsf Ptr Ax2
axis
    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
    matTransform2D :: M23 Double -> Path2D -> Path2D
    matTransform2D :: M23 Double -> Path2D -> Path2D
matTransform2D M23 Double
m = (V2 Double -> V2 Double)
-> Acquire (Maybe (Ptr GTrsf)) -> Path2D -> Path2D
fromGTrsfPath (M23 Double -> V2 Double -> V2 Double
forall a. Transformable2D a => M23 Double -> a -> a
matTransform2D M23 Double
m) (M23 Double -> Acquire (Maybe (Ptr GTrsf))
matrixGTrsf M23 Double
m)

    rotate2D :: Double -> Path2D -> Path2D
    rotate2D :: Double -> Path2D -> Path2D
rotate2D Double
a = (V2 Double -> V2 Double) -> Acquire (Ptr Trsf) -> Path2D -> Path2D
fromTrsfPath (Double -> V2 Double -> V2 Double
forall a. Transformable2D a => Double -> a -> a
rotate2D Double
a) (Double -> Acquire (Ptr Trsf)
rotateTrsf Double
a)
    
    scale2D :: V2 Double -> Path2D -> Path2D
    scale2D :: V2 Double -> Path2D -> Path2D
scale2D V2 Double
s = (V2 Double -> V2 Double)
-> Acquire (Maybe (Ptr GTrsf)) -> Path2D -> Path2D
fromGTrsfPath (V2 Double -> V2 Double -> V2 Double
forall a. Transformable2D a => V2 Double -> a -> a
scale2D V2 Double
s) (V2 Double -> Acquire (Maybe (Ptr GTrsf))
scaleGTrsf V2 Double
s)

    uScale2D :: Double -> Path2D -> Path2D
    uScale2D :: Double -> Path2D -> Path2D
uScale2D Double
s = (V2 Double -> V2 Double) -> Acquire (Ptr Trsf) -> Path2D -> Path2D
fromTrsfPath (Double -> V2 Double -> V2 Double
forall a. Transformable2D a => Double -> a -> a
uScale2D Double
s) (Double -> Acquire (Ptr Trsf)
uScaleTrsf Double
s)

    translate2D :: V2 Double -> Path2D -> Path2D
    translate2D :: V2 Double -> Path2D -> Path2D
translate2D V2 Double
v = (V2 Double -> V2 Double) -> Acquire (Ptr Trsf) -> Path2D -> Path2D
fromTrsfPath (V2 Double -> V2 Double -> V2 Double
forall a. Transformable2D a => V2 Double -> a -> a
translate2D V2 Double
v) (V2 Double -> Acquire (Ptr Trsf)
translateTrsf V2 Double
v)

    mirror2D :: V2 Double -> Path2D -> Path2D
    mirror2D :: V2 Double -> Path2D -> Path2D
mirror2D V2 Double
v = (V2 Double -> V2 Double) -> Acquire (Ptr Trsf) -> Path2D -> Path2D
fromTrsfPath (V2 Double -> V2 Double -> V2 Double
forall a. Transformable2D a => V2 Double -> a -> a
mirror2D V2 Double
v) (V2 Double -> Acquire (Ptr Trsf)
mirrorTrsf V2 Double
v)

instance Transformable2D Shape where
    matTransform2D :: M23 Double -> Shape -> Shape
    matTransform2D :: M23 Double -> Shape -> Shape
matTransform2D = Acquire (Maybe (Ptr GTrsf)) -> Shape -> Shape
fromGTrsfShape (Acquire (Maybe (Ptr GTrsf)) -> Shape -> Shape)
-> (M23 Double -> Acquire (Maybe (Ptr GTrsf)))
-> M23 Double
-> Shape
-> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M23 Double -> Acquire (Maybe (Ptr GTrsf))
matrixGTrsf

    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 (Maybe (Ptr GTrsf)) -> Shape -> Shape
fromGTrsfShape (Acquire (Maybe (Ptr GTrsf)) -> Shape -> Shape)
-> (V2 Double -> Acquire (Maybe (Ptr GTrsf)))
-> V2 Double
-> Shape
-> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 Double -> Acquire (Maybe (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

    mirror2D :: V2 Double -> Shape -> Shape
    mirror2D :: V2 Double -> Shape -> Shape
mirror2D = 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)
mirrorTrsf

instance Transformable2D RawDiagram where
    matTransform2D :: M23 Double -> RawDiagram -> RawDiagram
    matTransform2D :: M23 Double -> RawDiagram -> RawDiagram
matTransform2D M23 Double
m = Acquire (Maybe (Ptr GTrsf)) -> RawDiagram -> RawDiagram
fromGTrsfDiagram (M23 Double -> Acquire (Maybe (Ptr GTrsf))
matrixGTrsf M23 Double
m)

    rotate2D :: Double -> RawDiagram -> RawDiagram
    rotate2D :: Double -> RawDiagram -> RawDiagram
rotate2D Double
a = Acquire (Ptr Trsf) -> RawDiagram -> RawDiagram
fromTrsfDiagram (Double -> Acquire (Ptr Trsf)
rotateTrsf Double
a)
    
    scale2D :: V2 Double -> RawDiagram -> RawDiagram
    scale2D :: V2 Double -> RawDiagram -> RawDiagram
scale2D V2 Double
s = Acquire (Maybe (Ptr GTrsf)) -> RawDiagram -> RawDiagram
fromGTrsfDiagram (V2 Double -> Acquire (Maybe (Ptr GTrsf))
scaleGTrsf V2 Double
s)

    uScale2D :: Double -> RawDiagram -> RawDiagram
    uScale2D :: Double -> RawDiagram -> RawDiagram
uScale2D Double
s = Acquire (Ptr Trsf) -> RawDiagram -> RawDiagram
fromTrsfDiagram (Double -> Acquire (Ptr Trsf)
uScaleTrsf Double
s)

    translate2D :: V2 Double -> RawDiagram -> RawDiagram
    translate2D :: V2 Double -> RawDiagram -> RawDiagram
translate2D V2 Double
v = Acquire (Ptr Trsf) -> RawDiagram -> RawDiagram
fromTrsfDiagram (V2 Double -> Acquire (Ptr Trsf)
translateTrsf V2 Double
v)

    mirror2D :: V2 Double -> RawDiagram -> RawDiagram
    mirror2D :: V2 Double -> RawDiagram -> RawDiagram
mirror2D V2 Double
v = Acquire (Ptr Trsf) -> RawDiagram -> RawDiagram
fromTrsfDiagram (V2 Double -> Acquire (Ptr Trsf)
mirrorTrsf V2 Double
v)

instance Transformable2D (V2 Double) where
    matTransform2D :: M23 Double -> V2 Double -> V2 Double
    matTransform2D :: M23 Double -> V2 Double -> V2 Double
matTransform2D M23 Double
m V2 Double
v = M23 Double
m M23 Double -> V3 Double -> V2 Double
forall (m :: * -> *) (r :: * -> *) a.
(Functor m, Foldable r, Additive r, Num a) =>
m (r a) -> r a -> m a
!* (ASetter' (V3 Double) Double -> V3 Double
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (V3 Double) Double
forall a. Lens' (V3 a) a
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z V3 Double -> (V3 Double -> V3 Double) -> V3 Double
forall a b. a -> (a -> b) -> b
& (V2 Double -> Identity (V2 Double))
-> V3 Double -> Identity (V3 Double)
forall a. Lens' (V3 a) (V2 a)
forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy ((V2 Double -> Identity (V2 Double))
 -> V3 Double -> Identity (V3 Double))
-> V2 Double -> V3 Double -> V3 Double
forall s t a b. ASetter s t a b -> b -> s -> t
.~ V2 Double
v)

    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
(*)

    -- Uniform Scale
    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
(+)

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