--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Transformation
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module HGeometry.Transformation
  ( Transformation(Transformation)
  , transformationMatrix
  , (|.|), identity, inverseOf

  , IsTransformable(..)
  , TransformationConstraints
  , DefaultTransformByConstraints
  , OptMatrix_

  , translation, scaling, uniformScaling

  , translateBy, scaleBy, scaleUniformlyBy

  , rotateTo
  , rotateXYZ, rotateX, rotateY, rotateZ

  , skewX, rotation, reflection, reflectionV, reflectionH

  , fitToBox
  , fitToBoxTransform
  ) where

import           Control.Lens hiding ((<.>))
import           Data.Semialign
import           HGeometry.Box.Boxable
import           HGeometry.Box.Class
import qualified HGeometry.Box.Class as Box
import           HGeometry.Matrix
import           HGeometry.Point
import           HGeometry.Properties
import           HGeometry.Transformation.Internal
import           HGeometry.Vector
import           GHC.TypeNats

--------------------------------------------------------------------------------

-- | Given a box r and a geometry g with its boundingbox,
-- transform the g to fit r.
fitToBox     :: forall box d g point r.
                ( NumType g ~ r, Dimension g ~ d
                , IsTransformable g
                , IsBoxable g
                , Box_ box point
                , Point_ point d r
                , Ord r, Fractional r
                , TransformationConstraints d r
                , Functor (Vector d), Zip (Vector d)
                , d <= (d + 1) - 1
                ) => box -> g -> g
fitToBox :: forall box (d :: Nat) g point r.
(NumType g ~ r, Dimension g ~ d, IsTransformable g, IsBoxable g,
 Box_ box point, Point_ point d r, Ord r, Fractional r,
 TransformationConstraints d r, Functor (Vector d), Zip (Vector d),
 d <= ((d + 1) - 1)) =>
box -> g -> g
fitToBox box
r g
g = Transformation (Dimension g) (NumType g) -> g -> g
forall g.
IsTransformable g =>
Transformation (Dimension g) (NumType g) -> g -> g
transformBy (box -> g -> Transformation d r
forall box (d :: Nat) g point r.
(NumType g ~ r, Dimension g ~ d, IsTransformable g, IsBoxable g,
 Box_ box point, Point_ point d r, Ord r, Fractional r,
 TransformationConstraints d r, Functor (Vector d), Zip (Vector d),
 d <= ((d + 1) - 1)) =>
box -> g -> Transformation d r
fitToBoxTransform box
r g
g) g
g
{-# INLINE fitToBox #-}

-- | Given a box r and a geometry g with its boundingbox,
-- compute a transformation can fit g to r.
fitToBoxTransform     :: forall box d g point r.
                         ( NumType g ~ r, Dimension g ~ d
                         , IsTransformable g
                         , IsBoxable g
                         , Box_ box point
                         , Point_ point d r
                         , Ord r, Fractional r
                         , TransformationConstraints d r
                         , Functor (Vector d), Zip (Vector d)
                         , d <= (d + 1) - 1
                         ) => box -> g -> Transformation d r
fitToBoxTransform :: forall box (d :: Nat) g point r.
(NumType g ~ r, Dimension g ~ d, IsTransformable g, IsBoxable g,
 Box_ box point, Point_ point d r, Ord r, Fractional r,
 TransformationConstraints d r, Functor (Vector d), Zip (Vector d),
 d <= ((d + 1) - 1)) =>
box -> g -> Transformation d r
fitToBoxTransform box
r g
g = Vector (Dimension point) (NumType point) -> Transformation d r
forall (d :: Nat) r vector.
(Num r, Vector_ vector d r, TransformationConstraints d r,
 d <= ((d + 1) - 1)) =>
vector -> Transformation d r
translation Vector (Dimension point) (NumType point)
v2 Transformation d r -> Transformation d r -> Transformation d r
forall r (d :: Nat).
(Num r, OptMatrix_ (d + 1) r) =>
Transformation d r -> Transformation d r -> Transformation d r
|.| r -> Transformation d r
forall (d :: Nat) r.
(Num r, TransformationConstraints d r) =>
r -> Transformation d r
uniformScaling r
lam Transformation d r -> Transformation d r -> Transformation d r
forall r (d :: Nat).
(Num r, OptMatrix_ (d + 1) r) =>
Transformation d r -> Transformation d r -> Transformation d r
|.| Vector d r -> Transformation d r
forall (d :: Nat) r vector.
(Num r, Vector_ vector d r, TransformationConstraints d r,
 d <= ((d + 1) - 1)) =>
vector -> Transformation d r
translation Vector d r
v1
  where
    b :: Box (Point d r)
b = g -> Box (Point d r)
forall (d :: Nat) r.
(d ~ Dimension g, r ~ NumType g, Ord r) =>
g -> Box (Point d r)
forall g (d :: Nat) r.
(IsBoxable g, d ~ Dimension g, r ~ NumType g, Ord r) =>
g -> Box (Point d r)
boundingBox g
g
    v1  :: Vector d r
    v1 :: Vector d r
v1  = Vector d r -> Vector d r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> vector
negated (Vector d r -> Vector d r) -> Vector d r -> Vector d r
forall a b. (a -> b) -> a -> b
$ Box (Point d r)
bBox (Point d r)
-> Getting (Vector d r) (Box (Point d r)) (Vector d r)
-> Vector d r
forall s a. s -> Getting a s a -> a
^.(Point d r -> Const (Vector d r) (Point d r))
-> Box (Point d r) -> Const (Vector d r) (Box (Point d r))
forall box point. HasMinPoint box point => Lens' box point
Lens' (Box (Point d r)) (Point d r)
minPoint((Point d r -> Const (Vector d r) (Point d r))
 -> Box (Point d r) -> Const (Vector d r) (Box (Point d r)))
-> ((Vector d r -> Const (Vector d r) (Vector d r))
    -> Point d r -> Const (Vector d r) (Point d r))
-> Getting (Vector d r) (Box (Point d r)) (Vector d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector d r -> Const (Vector d r) (Vector d r))
-> Point d r -> Const (Vector d r) (Point d r)
forall (d :: Nat) r s.
(Dimension (Point d r) ~ d, NumType (Point d r) ~ r,
 Dimension (Point d r) ~ d, NumType (Point d r) ~ s) =>
Lens (Point d r) (Point d r) (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens (Point d r) (Point d r) (Vector d r) (Vector d r)
vector
    v2 :: Vector (Dimension point) (NumType point)
v2  = box
rbox
-> Getting
     (Vector (Dimension point) (NumType point))
     box
     (Vector (Dimension point) (NumType point))
-> Vector (Dimension point) (NumType point)
forall s a. s -> Getting a s a -> a
^.(point -> Const (Vector (Dimension point) (NumType point)) point)
-> box -> Const (Vector (Dimension point) (NumType point)) box
forall box point. HasMinPoint box point => Lens' box point
Lens' box point
minPoint((point -> Const (Vector (Dimension point) (NumType point)) point)
 -> box -> Const (Vector (Dimension point) (NumType point)) box)
-> ((Vector (Dimension point) (NumType point)
     -> Const
          (Vector (Dimension point) (NumType point))
          (Vector (Dimension point) (NumType point)))
    -> point -> Const (Vector (Dimension point) (NumType point)) point)
-> Getting
     (Vector (Dimension point) (NumType point))
     box
     (Vector (Dimension point) (NumType point))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector (Dimension point) (NumType point)
 -> Const
      (Vector (Dimension point) (NumType point))
      (Vector (Dimension point) (NumType point)))
-> point -> Const (Vector (Dimension point) (NumType point)) point
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens
  point
  point
  (Vector (Dimension point) (NumType point))
  (Vector (Dimension point) (NumType point))
vector
    lam :: r
lam = Getting (Min r) (Vector d r) r -> Vector d r -> r
forall a s. Ord a => Getting (Min a) s a -> s -> a
minimum1Of Getting (Min r) (Vector d r) r
(IxValue (Vector d r) -> Const (Min r) (IxValue (Vector d r)))
-> Vector d r -> Const (Min r) (Vector d r)
forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
IndexedTraversal1
  Int
  (Vector d r)
  (Vector d r)
  (IxValue (Vector d r))
  (IxValue (Vector d r))
components (Vector d r -> r) -> Vector d r -> r
forall a b. (a -> b) -> a -> b
$ (r -> r -> r) -> Vector d r -> Vector d r -> Vector d r
forall vector (d :: Nat) r.
Additive_ vector d r =>
(r -> r -> r) -> vector -> vector -> vector
liftI2 r -> r -> r
forall a. Fractional a => a -> a -> a
(/) (box -> Vector d r
forall box (d :: Nat) point r.
(Box_ box point, Point_ point d r, Num r, Functor (Vector d)) =>
box -> Vector d r
Box.size box
r) (Box (Point d r) -> Vector d r
forall box (d :: Nat) point r.
(Box_ box point, Point_ point d r, Num r, Functor (Vector d)) =>
box -> Vector d r
Box.size Box (Point d r)
b)
{-# INLINE fitToBoxTransform #-}