{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}

module Geomancy.Transform
  ( Transform(..)
  , inverse

  , apply
  , (!.)

  , translate
  , translateV

  , rotateX
  , rotateY
  , rotateZ
  , rotateQ

  , scale
  , scaleX
  , scaleY
  , scaleZ
  , scaleXY
  , scale3

  , dirPos
  ) where

import Foreign (Storable(..))

import Geomancy.Mat4 (Mat4, colMajor, inverse)
import Geomancy.Quaternion (Quaternion, withQuaternion)
import Geomancy.Vec3 (Vec3, vec3, withVec3)
import Geomancy.Vec4 (fromVec3, withVec4)

import qualified Geomancy.Mat4 as Mat4

newtype Transform = Transform { Transform -> Mat4
unTransform :: Mat4 }
  deriving newtype (Int -> Transform -> ShowS
[Transform] -> ShowS
Transform -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transform] -> ShowS
$cshowList :: [Transform] -> ShowS
show :: Transform -> String
$cshow :: Transform -> String
showsPrec :: Int -> Transform -> ShowS
$cshowsPrec :: Int -> Transform -> ShowS
Show, NonEmpty Transform -> Transform
Transform -> Transform -> Transform
forall b. Integral b => b -> Transform -> Transform
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Transform -> Transform
$cstimes :: forall b. Integral b => b -> Transform -> Transform
sconcat :: NonEmpty Transform -> Transform
$csconcat :: NonEmpty Transform -> Transform
<> :: Transform -> Transform -> Transform
$c<> :: Transform -> Transform -> Transform
Semigroup, Semigroup Transform
Transform
[Transform] -> Transform
Transform -> Transform -> Transform
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Transform] -> Transform
$cmconcat :: [Transform] -> Transform
mappend :: Transform -> Transform -> Transform
$cmappend :: Transform -> Transform -> Transform
mempty :: Transform
$cmempty :: Transform
Monoid, Ptr Transform -> IO Transform
Ptr Transform -> Int -> IO Transform
Ptr Transform -> Int -> Transform -> IO ()
Ptr Transform -> Transform -> IO ()
Transform -> Int
forall b. Ptr b -> Int -> IO Transform
forall b. Ptr b -> Int -> Transform -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Transform -> Transform -> IO ()
$cpoke :: Ptr Transform -> Transform -> IO ()
peek :: Ptr Transform -> IO Transform
$cpeek :: Ptr Transform -> IO Transform
pokeByteOff :: forall b. Ptr b -> Int -> Transform -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Transform -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO Transform
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Transform
pokeElemOff :: Ptr Transform -> Int -> Transform -> IO ()
$cpokeElemOff :: Ptr Transform -> Int -> Transform -> IO ()
peekElemOff :: Ptr Transform -> Int -> IO Transform
$cpeekElemOff :: Ptr Transform -> Int -> IO Transform
alignment :: Transform -> Int
$calignment :: Transform -> Int
sizeOf :: Transform -> Int
$csizeOf :: Transform -> Int
Storable)

-- | Apply transformation to a vector, then normalize with perspective division
apply :: Vec3 -> Transform -> Vec3
apply :: Vec3 -> Transform -> Vec3
apply = forall a b c. (a -> b -> c) -> b -> a -> c
flip Transform -> Vec3 -> Vec3
(!.)

-- | Matrix - column vector multiplication with perspective division
(!.) :: Transform -> Vec3 -> Vec3
!. :: Transform -> Vec3 -> Vec3
(!.) Transform
mat Vec3
vec =
  forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
res \Float
x Float
y Float
z Float
w ->
    Float -> Float -> Float -> Vec3
vec3 (Float
x forall a. Fractional a => a -> a -> a
/ Float
w) (Float
y forall a. Fractional a => a -> a -> a
/ Float
w) (Float
z forall a. Fractional a => a -> a -> a
/ Float
w)
  where
    res :: Vec4
res = Transform
mat forall a. Coercible a Mat4 => a -> Vec4 -> Vec4
Mat4.!* forall a. Coercible a Vec3 => a -> Float -> Vec4
fromVec3 Vec3
vec Float
1.0

-- ** Translation

{-# INLINE translate #-}
translate :: Float -> Float -> Float -> Transform
translate :: Float -> Float -> Float -> Transform
translate Float
x Float
y Float
z = forall a.
Coercible Mat4 a =>
Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> a
colMajor
  Float
1 Float
0 Float
0 Float
x
  Float
0 Float
1 Float
0 Float
y
  Float
0 Float
0 Float
1 Float
z
  Float
0 Float
0 Float
0 Float
1

{-# INLINE translateV #-}
translateV :: Vec3 -> Transform
translateV :: Vec3 -> Transform
translateV Vec3
vec = forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
vec Float -> Float -> Float -> Transform
translate

-- ** Scaling

{-# INLINE scale3 #-}
scale3 :: Float -> Float -> Float -> Transform
scale3 :: Float -> Float -> Float -> Transform
scale3 Float
x Float
y Float
z = forall a.
Coercible Mat4 a =>
Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> a
colMajor
  Float
x Float
0 Float
0 Float
0
  Float
0 Float
y Float
0 Float
0
  Float
0 Float
0 Float
z Float
0
  Float
0 Float
0 Float
0 Float
1

{-# INLINE scale #-}
scale :: Float -> Transform
scale :: Float -> Transform
scale Float
s = Float -> Float -> Float -> Transform
scale3 Float
s Float
s Float
s

{-# INLINE scaleX #-}
scaleX :: Float -> Transform
scaleX :: Float -> Transform
scaleX Float
x = Float -> Float -> Float -> Transform
scale3 Float
x Float
1 Float
1

{-# INLINE scaleY #-}
scaleY :: Float -> Transform
scaleY :: Float -> Transform
scaleY Float
y = Float -> Float -> Float -> Transform
scale3 Float
1 Float
y Float
1

{-# INLINE scaleZ #-}
scaleZ :: Float -> Transform
scaleZ :: Float -> Transform
scaleZ Float
z = Float -> Float -> Float -> Transform
scale3 Float
1 Float
1 Float
z

{-# INLINE scaleXY #-}
scaleXY :: Float -> Float -> Transform
scaleXY :: Float -> Float -> Transform
scaleXY Float
x Float
y = Float -> Float -> Float -> Transform
scale3 Float
x Float
y Float
1

-- ** Euler angle rotations

{-# INLINE rotateX #-}
rotateX :: Float -> Transform
rotateX :: Float -> Transform
rotateX Float
rads = forall a.
Coercible Mat4 a =>
Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> a
colMajor
  Float
1 Float
0   Float
0   Float
0
  Float
0 Float
t11 Float
t21 Float
0
  Float
0 Float
t12 Float
t22 Float
0
  Float
0 Float
0   Float
0   Float
1
  where
    t11 :: Float
t11 = Float
cost
    t12 :: Float
t12 = -Float
sint
    t21 :: Float
t21 = Float
sint
    t22 :: Float
t22 = Float
cost

    cost :: Float
cost = forall a. Floating a => a -> a
cos Float
rads
    sint :: Float
sint = forall a. Floating a => a -> a
sin Float
rads

{-# INLINE rotateY #-}
rotateY :: Float -> Transform
rotateY :: Float -> Transform
rotateY Float
rads = forall a.
Coercible Mat4 a =>
Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> a
colMajor
  Float
t00 Float
0 Float
t20 Float
0
  Float
0   Float
1 Float
0   Float
0
  Float
t02 Float
0 Float
t22 Float
0
  Float
0   Float
0 Float
0   Float
1
  where
    cost :: Float
cost = forall a. Floating a => a -> a
cos Float
rads
    sint :: Float
sint = forall a. Floating a => a -> a
sin Float
rads

    t00 :: Float
t00 = Float
cost
    t02 :: Float
t02 = Float
sint
    t20 :: Float
t20 = -Float
sint
    t22 :: Float
t22 = Float
cost

{-# INLINE rotateZ #-}
rotateZ :: Float -> Transform
rotateZ :: Float -> Transform
rotateZ Float
rads = forall a.
Coercible Mat4 a =>
Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> a
colMajor
  Float
t00 Float
t10 Float
0 Float
0
  Float
t01 Float
t11 Float
0 Float
0
  Float
0   Float
0   Float
1 Float
0
  Float
0   Float
0   Float
0 Float
1
  where
   t00 :: Float
t00 = Float
cost
   t01 :: Float
t01 = -Float
sint
   t10 :: Float
t10 = Float
sint
   t11 :: Float
t11 = Float
cost

   cost :: Float
cost = forall a. Floating a => a -> a
cos Float
rads
   sint :: Float
sint = forall a. Floating a => a -> a
sin Float
rads

{-# INLINE rotateQ #-}
rotateQ :: Quaternion -> Transform
rotateQ :: Quaternion -> Transform
rotateQ Quaternion
dir = Quaternion -> Vec3 -> Transform
dirPos Quaternion
dir Vec3
0

{-# INLINE dirPos #-}
dirPos :: Quaternion -> Vec3 -> Transform
dirPos :: Quaternion -> Vec3 -> Transform
dirPos Quaternion
rs Vec3
t =
  forall r.
Quaternion -> (Float -> Float -> Float -> Float -> r) -> r
withQuaternion Quaternion
rs \Float
w Float
x Float
y Float
z ->
  forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
t \Float
tx Float
ty Float
tz ->
    let
      x2 :: Float
x2 = Float
x forall a. Num a => a -> a -> a
* Float
x
      y2 :: Float
y2 = Float
y forall a. Num a => a -> a -> a
* Float
y
      z2 :: Float
z2 = Float
z forall a. Num a => a -> a -> a
* Float
z
      xy :: Float
xy = Float
x forall a. Num a => a -> a -> a
* Float
y
      xz :: Float
xz = Float
x forall a. Num a => a -> a -> a
* Float
z
      xw :: Float
xw = Float
x forall a. Num a => a -> a -> a
* Float
w
      yz :: Float
yz = Float
y forall a. Num a => a -> a -> a
* Float
z
      yw :: Float
yw = Float
y forall a. Num a => a -> a -> a
* Float
w
      zw :: Float
zw = Float
z forall a. Num a => a -> a -> a
* Float
w
    in
      forall a.
Coercible Mat4 a =>
Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> a
colMajor
        (Float
1 forall a. Num a => a -> a -> a
- Float
2 forall a. Num a => a -> a -> a
* (Float
y2 forall a. Num a => a -> a -> a
+ Float
z2)) (    Float
2 forall a. Num a => a -> a -> a
* (Float
xy forall a. Num a => a -> a -> a
- Float
zw)) (    Float
2 forall a. Num a => a -> a -> a
* (Float
xz forall a. Num a => a -> a -> a
+ Float
yw)) Float
tx
        (    Float
2 forall a. Num a => a -> a -> a
* (Float
xy forall a. Num a => a -> a -> a
+ Float
zw)) (Float
1 forall a. Num a => a -> a -> a
- Float
2 forall a. Num a => a -> a -> a
* (Float
x2 forall a. Num a => a -> a -> a
+ Float
z2)) (    Float
2 forall a. Num a => a -> a -> a
* (Float
yz forall a. Num a => a -> a -> a
- Float
xw)) Float
ty
        (    Float
2 forall a. Num a => a -> a -> a
* (Float
xz forall a. Num a => a -> a -> a
- Float
yw)) (    Float
2 forall a. Num a => a -> a -> a
* (Float
yz forall a. Num a => a -> a -> a
+ Float
xw)) (Float
1 forall a. Num a => a -> a -> a
- Float
2 forall a. Num a => a -> a -> a
* (Float
x2 forall a. Num a => a -> a -> a
+ Float
y2)) Float
tz
         Float
0                   Float
0                   Float
0                  Float
1