-- | This module provide some helpers in order

-- to perform basic geometric transformation on

-- the drawable primitives.

--

-- You can combine the transformation is `mappend` or

-- the `(\<\>)` operator from "Data.Monoid" .

module Graphics.Rasterific.Transformations
    ( Transformation( .. )
    , applyTransformation
    , applyVectorTransformation
    , translate
    , scale
    , rotate
    , rotateCenter
    , skewX
    , skewY
    , toNewXBase
    , inverseTransformation
    ) where

import Graphics.Rasterific.Types
import Graphics.Rasterific.Linear( V2( .. ), normalize )

-- | Represent a 3*3 matrix for homogenous coordinates.

--

-- > | A C E |

-- > | B D F |

-- > | 0 0 1 |

--

data Transformation = Transformation
    { Transformation -> Float
_transformA :: {-# UNPACK #-} !Float
    , Transformation -> Float
_transformC :: {-# UNPACK #-} !Float
    , Transformation -> Float
_transformE :: {-# UNPACK #-} !Float -- ^ X translation


    , Transformation -> Float
_transformB :: {-# UNPACK #-} !Float
    , Transformation -> Float
_transformD :: {-# UNPACK #-} !Float
    , Transformation -> Float
_transformF :: {-# UNPACK #-} !Float -- ^ Y translation

    }
    deriving (Transformation -> Transformation -> Bool
(Transformation -> Transformation -> Bool)
-> (Transformation -> Transformation -> Bool) -> Eq Transformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transformation -> Transformation -> Bool
$c/= :: Transformation -> Transformation -> Bool
== :: Transformation -> Transformation -> Bool
$c== :: Transformation -> Transformation -> Bool
Eq, Int -> Transformation -> ShowS
[Transformation] -> ShowS
Transformation -> String
(Int -> Transformation -> ShowS)
-> (Transformation -> String)
-> ([Transformation] -> ShowS)
-> Show Transformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transformation] -> ShowS
$cshowList :: [Transformation] -> ShowS
show :: Transformation -> String
$cshow :: Transformation -> String
showsPrec :: Int -> Transformation -> ShowS
$cshowsPrec :: Int -> Transformation -> ShowS
Show)

transformCombine :: Transformation -> Transformation -> Transformation
transformCombine :: Transformation -> Transformation -> Transformation
transformCombine (Transformation Float
a Float
c Float
e
                                 Float
b Float
d Float
f)

                 (Transformation Float
a' Float
c' Float
e'
                                 Float
b' Float
d' Float
f') =
    Float
-> Float -> Float -> Float -> Float -> Float -> Transformation
Transformation (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
a' Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b' {- below b' is zero -})
              (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
c' Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
d' {- below d' is zero -})
              (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
e' Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
f' Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
e {- below f' is one -})

              (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
a' Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b' {- below b' is zero -})
              (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
c' Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
d' {- below d' is zero -})
              (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
e' Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
f' Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
f {- below f' is one -})

instance Semigroup Transformation where
    <> :: Transformation -> Transformation -> Transformation
(<>) = Transformation -> Transformation -> Transformation
transformCombine

instance Monoid Transformation where
    mappend :: Transformation -> Transformation -> Transformation
mappend = Transformation -> Transformation -> Transformation
forall a. Semigroup a => a -> a -> a
(<>)
    mempty :: Transformation
mempty = Float
-> Float -> Float -> Float -> Float -> Float -> Transformation
Transformation Float
1 Float
0 Float
0
                            Float
0 Float
1 Float
0

-- | Effectively transform a point given a transformation.

applyTransformation :: Transformation -> Point -> Point
applyTransformation :: Transformation -> Point -> Point
applyTransformation (Transformation Float
a Float
c Float
e
                                    Float
b Float
d Float
f) (V2 Float
x Float
y) =
    Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
e) (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
f)

-- | Effectively transform a vector given a transformation.

-- The translation part won't be applied.

applyVectorTransformation :: Transformation -> Vector -> Vector
applyVectorTransformation :: Transformation -> Point -> Point
applyVectorTransformation
    (Transformation Float
a Float
c Float
_e
                    Float
b Float
d Float
_f) (V2 Float
x Float
y) =
    Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
c) (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
y)


-- | Create a transformation representing a rotation

-- on the plane.

--

-- > fill . transform (applyTransformation $ rotate 0.2)

-- >      $ rectangle (V2 40 40) 120 120

--

-- <<docimages/transform_rotate.png>>

--

rotate :: Float  -- ^ Rotation angle in radian.

       -> Transformation
rotate :: Float -> Transformation
rotate Float
angle = Float
-> Float -> Float -> Float -> Float -> Float -> Transformation
Transformation Float
ca (-Float
sa) Float
0
                              Float
sa   Float
ca  Float
0
  where ca :: Float
ca = Float -> Float
forall a. Floating a => a -> a
cos Float
angle
        sa :: Float
sa = Float -> Float
forall a. Floating a => a -> a
sin Float
angle

-- | Create a transformation representing a rotation

-- on the plane. The rotation center is given in parameter

--

-- > fill . transform (applyTransformation $ rotateCenter 0.2 (V2 200 200))

-- >      $ rectangle (V2 40 40) 120 120

--

-- <<docimages/transform_rotate_center.png>>

--

rotateCenter :: Float -- ^ Rotation angle in radian

             -> Point -- ^ Rotation center

             -> Transformation
rotateCenter :: Float -> Point -> Transformation
rotateCenter Float
angle Point
p =
    Point -> Transformation
translate Point
p Transformation -> Transformation -> Transformation
forall a. Semigroup a => a -> a -> a
<> Float -> Transformation
rotate Float
angle Transformation -> Transformation -> Transformation
forall a. Semigroup a => a -> a -> a
<> Point -> Transformation
translate (Point -> Point
forall a. Num a => a -> a
negate Point
p)


-- | Perform a scaling of the given primitives.

--

-- > fill . transform (applyTransformation $ scale 2 2)

-- >      $ rectangle (V2 40 40) 40 40

--

-- <<docimages/transform_scale.png>>

--

scale :: Float -> Float -> Transformation
scale :: Float -> Float -> Transformation
scale Float
scaleX Float
scaleY =
    Float
-> Float -> Float -> Float -> Float -> Float -> Transformation
Transformation Float
scaleX      Float
0 Float
0
                        Float
0 Float
scaleY Float
0

-- | Perform a translation of the given primitives.

--

-- > fill . transform (applyTransformation $ translate (V2 100 100))

-- >      $ rectangle (V2 40 40) 40 40

--

-- <<docimages/transform_translate.png>>

--

translate :: Vector -> Transformation
translate :: Point -> Transformation
translate (V2 Float
x Float
y) =
    Float
-> Float -> Float -> Float -> Float -> Float -> Transformation
Transformation Float
1 Float
0 Float
x
                   Float
0 Float
1 Float
y

-- | Skew transformation along the

-- X axis.

--

-- > fill . transform (applyTransformation $ skewX 0.3)

-- >      $ rectangle (V2 50 50) 80 80

--

-- <<docimages/transform_skewx.png>>

--

skewX :: Float -> Transformation
skewX :: Float -> Transformation
skewX Float
v =
    Float
-> Float -> Float -> Float -> Float -> Float -> Transformation
Transformation Float
1 Float
t Float
0
                   Float
0 Float
1 Float
0
  where t :: Float
t = Float -> Float
forall a. Floating a => a -> a
tan Float
v

-- | Skew transformation along the Y axis.

--

-- > fill . transform (applyTransformation $ skewY 0.3)

-- >      $ rectangle (V2 50 50) 80 80

--

-- <<docimages/transform_skewy.png>>

--

skewY :: Float -> Transformation
skewY :: Float -> Transformation
skewY Float
v =
    Float
-> Float -> Float -> Float -> Float -> Float -> Transformation
Transformation Float
1 Float
0 Float
0
                   Float
t Float
1 Float
0
  where t :: Float
t = Float -> Float
forall a. Floating a => a -> a
tan Float
v

-- | Given a new X-acis vector, create a rotation matrix

-- to get into this new base, assuming an Y basis orthonormal

-- to the X one.

toNewXBase :: Vector -> Transformation
toNewXBase :: Point -> Transformation
toNewXBase Point
vec =
    Float
-> Float -> Float -> Float -> Float -> Float -> Transformation
Transformation Float
dx (-Float
dy) Float
0
                   Float
dy   Float
dx  Float
0
  where V2 Float
dx Float
dy = Point -> Point
forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize Point
vec

transformationDeterminant :: Transformation -> Float
transformationDeterminant :: Transformation -> Float
transformationDeterminant (Transformation Float
a Float
c Float
_e
                                          Float
b Float
d Float
_f) = Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b

-- | Inverse a transformation (if possible)

inverseTransformation :: Transformation -> Maybe Transformation
inverseTransformation :: Transformation -> Maybe Transformation
inverseTransformation Transformation
trans
    | Transformation -> Float
transformationDeterminant Transformation
trans Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 = Maybe Transformation
forall a. Maybe a
Nothing
inverseTransformation (Transformation Float
a Float
c Float
e
                                      Float
b Float
d Float
f) =
    Transformation -> Maybe Transformation
forall a. a -> Maybe a
Just (Transformation -> Maybe Transformation)
-> Transformation -> Maybe Transformation
forall a b. (a -> b) -> a -> b
$ Float
-> Float -> Float -> Float -> Float -> Float -> Transformation
Transformation Float
a' Float
c' Float
e' Float
b' Float
d' Float
f'
  where det :: Float
det = Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
c
        a' :: Float
a' = Float
d Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
det
        c' :: Float
c' = (- Float
c) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
det
        e' :: Float
e' = (Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
e Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
d) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
det

        b' :: Float
b' = (- Float
b) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
det
        d' :: Float
d' = Float
a Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
det
        f' :: Float
f' = (Float
e Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
f) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
det