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

  , IsTransformable(..)
  , transformAllBy
  , transformPointFunctor

  , translation, scaling, uniformScaling

  , translateBy, scaleBy, scaleUniformlyBy

  , rotateTo

  , skewX, rotation, reflection, reflectionV, reflectionH

  , fitToBox
  , fitToBoxTransform
  ) where

import           Control.Lens
import           Data.Ext
import           Data.Geometry.Box.Internal (Rectangle, IsBoxable)
import qualified Data.Geometry.Box.Internal as Box
import           Data.Geometry.Properties
import           Data.Geometry.Point
import           Data.Geometry.Transformation.Internal
import           Data.Geometry.Vector
--------------------------------------------------------------------------------

-- | Given a rectangle r and a geometry g with its boundingbox,
-- transform the g to fit r.
fitToBox     :: forall g r q.
                ( IsTransformable g, IsBoxable g, NumType g ~ r, Dimension g ~ 2
                , Ord r, Fractional r
                ) => Rectangle q r -> g -> g
fitToBox :: Rectangle q r -> g -> g
fitToBox Rectangle q r
r g
g = Transformation (Dimension g) (NumType g) -> g -> g
forall g.
IsTransformable g =>
Transformation (Dimension g) (NumType g) -> g -> g
transformBy (Rectangle q r -> g -> Transformation 2 r
forall g r q.
(IsTransformable g, IsBoxable g, NumType g ~ r, Dimension g ~ 2,
 Ord r, Fractional r) =>
Rectangle q r -> g -> Transformation 2 r
fitToBoxTransform Rectangle q r
r g
g) g
g

-- | Given a rectangle r and a geometry g with its boundingbox,
-- compute a transformation can fit g to r.
fitToBoxTransform     :: forall g r q. ( IsTransformable g, IsBoxable g
                                       , NumType g ~ r, Dimension g ~ 2
                                       , Ord r, Fractional r
                      ) => Rectangle q r -> g -> Transformation 2 r
fitToBoxTransform :: Rectangle q r -> g -> Transformation 2 r
fitToBoxTransform Rectangle q r
r g
g = Vector 2 r -> Transformation 2 r
forall r (d :: Nat).
(Num r, Arity d, Arity (d + 1)) =>
Vector d r -> Transformation d r
translation Vector 2 r
v2 Transformation 2 r -> Transformation 2 r -> Transformation 2 r
forall r (d :: Nat).
(Num r, Arity (d + 1)) =>
Transformation d r -> Transformation d r -> Transformation d r
|.| r -> Transformation 2 r
forall r (d :: Nat).
(Num r, Arity d, Arity (d + 1)) =>
r -> Transformation d r
uniformScaling r
lam Transformation 2 r -> Transformation 2 r -> Transformation 2 r
forall r (d :: Nat).
(Num r, Arity (d + 1)) =>
Transformation d r -> Transformation d r -> Transformation d r
|.| Vector 2 r -> Transformation 2 r
forall r (d :: Nat).
(Num r, Arity d, Arity (d + 1)) =>
Vector d r -> Transformation d r
translation Vector 2 r
v1
  where
    b :: Box (Dimension g) () (NumType g)
b = g -> Box (Dimension g) () (NumType g)
forall g.
(IsBoxable g, Ord (NumType g)) =>
g -> Box (Dimension g) () (NumType g)
Box.boundingBox g
g
    v1  :: Vector 2 r
    v1 :: Vector 2 r
v1  = r -> r
forall a. Num a => a -> a
negate (r -> r) -> Vector 2 r -> Vector 2 r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Box 2 () r
Box (Dimension g) () (NumType g)
bBox 2 () r
-> Getting (Vector 2 r) (Box 2 () r) (Vector 2 r) -> Vector 2 r
forall s a. s -> Getting a s a -> a
^.(Box 2 () r -> Point 2 r :+ ())
-> Optic' (->) (Const (Vector 2 r)) (Box 2 () r) (Point 2 r :+ ())
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Box 2 () r -> Point 2 r :+ ()
forall (d :: Nat) p r. Box d p r -> Point d r :+ p
Box.minPointOptic' (->) (Const (Vector 2 r)) (Box 2 () r) (Point 2 r :+ ())
-> ((Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
    -> (Point 2 r :+ ()) -> Const (Vector 2 r) (Point 2 r :+ ()))
-> Getting (Vector 2 r) (Box 2 () r) (Vector 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Vector 2 r) (Point 2 r))
-> (Point 2 r :+ ()) -> Const (Vector 2 r) (Point 2 r :+ ())
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((Point 2 r -> Const (Vector 2 r) (Point 2 r))
 -> (Point 2 r :+ ()) -> Const (Vector 2 r) (Point 2 r :+ ()))
-> ((Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
    -> Point 2 r -> Const (Vector 2 r) (Point 2 r))
-> (Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
-> (Point 2 r :+ ())
-> Const (Vector 2 r) (Point 2 r :+ ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
-> Point 2 r -> Const (Vector 2 r) (Point 2 r)
forall (d :: Nat) r r'.
Lens (Point d r) (Point d r') (Vector d r) (Vector d r')
vector
    v2 :: Vector 2 r
v2  = Rectangle q r
rRectangle q r
-> Getting (Vector 2 r) (Rectangle q r) (Vector 2 r) -> Vector 2 r
forall s a. s -> Getting a s a -> a
^.(Rectangle q r -> Point 2 r :+ q)
-> Optic'
     (->) (Const (Vector 2 r)) (Rectangle q r) (Point 2 r :+ q)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Rectangle q r -> Point 2 r :+ q
forall (d :: Nat) p r. Box d p r -> Point d r :+ p
Box.minPointOptic' (->) (Const (Vector 2 r)) (Rectangle q r) (Point 2 r :+ q)
-> ((Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
    -> (Point 2 r :+ q) -> Const (Vector 2 r) (Point 2 r :+ q))
-> Getting (Vector 2 r) (Rectangle q r) (Vector 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Vector 2 r) (Point 2 r))
-> (Point 2 r :+ q) -> Const (Vector 2 r) (Point 2 r :+ q)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((Point 2 r -> Const (Vector 2 r) (Point 2 r))
 -> (Point 2 r :+ q) -> Const (Vector 2 r) (Point 2 r :+ q))
-> ((Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
    -> Point 2 r -> Const (Vector 2 r) (Point 2 r))
-> (Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
-> (Point 2 r :+ q)
-> Const (Vector 2 r) (Point 2 r :+ q)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
-> Point 2 r -> Const (Vector 2 r) (Point 2 r)
forall (d :: Nat) r r'.
Lens (Point d r) (Point d r') (Vector d r) (Vector d r')
vector
    lam :: r
lam = Vector 2 r -> r
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (Vector 2 r -> r) -> Vector 2 r -> r
forall a b. (a -> b) -> a -> b
$ r -> r -> r
forall a. Fractional a => a -> a -> a
(/) (r -> r -> r) -> Vector 2 r -> Vector 2 (r -> r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rectangle q r -> Vector 2 r
forall (d :: Nat) r p. (Arity d, Num r) => Box d p r -> Vector d r
Box.size Rectangle q r
r Vector 2 (r -> r) -> Vector 2 r -> Vector 2 r
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Box 2 () r -> Vector 2 r
forall (d :: Nat) r p. (Arity d, Num r) => Box d p r -> Vector d r
Box.size Box 2 () r
Box (Dimension g) () (NumType g)
b