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

import Waterfall.TwoD.Internal.Path2D (Path2D (..))
import Waterfall.Internal.Finalizers (toAcquire, unsafeFromAcquire)
import Linear.V2 (V2 (..))
import Linear ((*^), normalize, dot)
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(..))

-- | Typeclass for objects that can be manipulated in 2D space
class Transformable2D a where
    -- | 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 :: Acquire (Ptr GP.Trsf) -> Path2D -> Path2D
fromTrsfPath :: Acquire (Ptr Trsf) -> Path2D -> Path2D
fromTrsfPath Acquire (Ptr Trsf)
mkTrsf (Path2D Ptr Wire
p) = Ptr Wire -> Path2D
Path2D (Ptr Wire -> Path2D)
-> (Acquire (Ptr Wire) -> Ptr Wire) -> Acquire (Ptr Wire) -> Path2D
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 
    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 

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 
    shape <- Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
toAcquire Ptr Shape
theRawShape
    trsf <- mkTrsf 
    BRepBuilderAPI.Transform.transform shape trsf True 

    
fromGTrsfPath :: Acquire (Ptr GP.GTrsf) -> Path2D -> Path2D
fromGTrsfPath :: Acquire (Ptr GTrsf) -> Path2D -> Path2D
fromGTrsfPath Acquire (Ptr GTrsf)
mkTrsf (Path2D Ptr Wire
p) = Ptr Wire -> Path2D
Path2D (Ptr Wire -> Path2D)
-> (Acquire (Ptr Wire) -> Ptr Wire) -> Acquire (Ptr Wire) -> Path2D
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 
    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 

fromGTrsfShape :: Acquire (Ptr GP.GTrsf) -> Shape -> Shape
fromGTrsfShape :: Acquire (Ptr GTrsf) -> Shape -> Shape
fromGTrsfShape Acquire (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 
    shape <- Ptr Shape -> Acquire (Ptr Shape)
forall a. a -> Acquire a
toAcquire Ptr Shape
theRawShape 
    trsf <- mkTrsf 
    BRepBuilderAPI.GTransform.gtransform shape trsf True 

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

scaleGTrsf :: V2 Double -> Acquire (Ptr GP.GTrsf)
scaleGTrsf :: V2 Double -> Acquire (Ptr GTrsf)
scaleGTrsf (V2 Double
x Double
y) = 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 1
        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

translateTrsf :: V2 Double -> Acquire (Ptr GP.Trsf)
translateTrsf :: V2 Double -> Acquire (Ptr Trsf)
translateTrsf (V2 Double
x Double
y) = do 
    trsf <- Acquire (Ptr Trsf)
GP.Trsf.new
    vec <- GP.Vec.new x y 0
    liftIO $ GP.Trsf.setTranslation trsf vec
    return trsf
    
mirrorTrsf :: V2 Double -> Acquire (Ptr GP.Trsf)
mirrorTrsf :: V2 Double -> Acquire (Ptr Trsf)
mirrorTrsf (V2 Double
x Double
y) = do 
    trsf <- Acquire (Ptr Trsf)
GP.Trsf.new
    dir <- GP.Dir.new x y 0
    axis <- GP.xoy
    liftIO $ do
        GP.Ax2.setDirection axis dir
        GP.Trsf.setMirrorAboutAx2 trsf axis
    return 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

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


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

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

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