{-# 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, withColMajor, inverse)
import Geomancy.Quaternion (Quaternion, withQuaternion)
import Geomancy.Vec3 (Vec3, vec3, withVec3)

newtype Transform = Transform { Transform -> Mat4
unTransform :: Mat4 }
  deriving newtype (Int -> Transform -> ShowS
[Transform] -> ShowS
Transform -> String
(Int -> Transform -> ShowS)
-> (Transform -> String)
-> ([Transform] -> ShowS)
-> Show Transform
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, b -> Transform -> Transform
NonEmpty Transform -> Transform
Transform -> Transform -> Transform
(Transform -> Transform -> Transform)
-> (NonEmpty Transform -> Transform)
-> (forall b. Integral b => b -> Transform -> Transform)
-> Semigroup 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 :: 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
Semigroup Transform
-> Transform
-> (Transform -> Transform -> Transform)
-> ([Transform] -> Transform)
-> Monoid 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
$cp1Monoid :: Semigroup Transform
Monoid, Ptr b -> Int -> IO Transform
Ptr b -> Int -> Transform -> IO ()
Ptr Transform -> IO Transform
Ptr Transform -> Int -> IO Transform
Ptr Transform -> Int -> Transform -> IO ()
Ptr Transform -> Transform -> IO ()
Transform -> Int
(Transform -> Int)
-> (Transform -> Int)
-> (Ptr Transform -> Int -> IO Transform)
-> (Ptr Transform -> Int -> Transform -> IO ())
-> (forall b. Ptr b -> Int -> IO Transform)
-> (forall b. Ptr b -> Int -> Transform -> IO ())
-> (Ptr Transform -> IO Transform)
-> (Ptr Transform -> Transform -> IO ())
-> Storable Transform
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 :: Ptr b -> Int -> Transform -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Transform -> IO ()
peekByteOff :: 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 = (Transform -> Vec3 -> Vec3) -> Vec3 -> Transform -> Vec3
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 =
  Vec3 -> (Float -> Float -> Float -> Vec3) -> Vec3
forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
vec \Float
v1 Float
v2 Float
v3 ->
    Transform
-> (Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Vec3)
-> Vec3
forall a r.
Coercible a Mat4 =>
a
-> (Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> Float
    -> r)
-> r
withColMajor Transform
mat
      \ Float
m11 Float
m12 Float
m13 Float
m14
        Float
m21 Float
m22 Float
m23 Float
m24
        Float
m31 Float
m32 Float
m33 Float
m34
        Float
m41 Float
m42 Float
m43 Float
m44 ->
          let
            px :: Float
px = Float
m11 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
v1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m12 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
v2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m13 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
v3 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m14
            py :: Float
py = Float
m21 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
v1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m22 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
v2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m23 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
v3 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m24
            pz :: Float
pz = Float
m31 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
v1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m32 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
v2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m33 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
v3 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m34
            p :: Float
p  = Float
m41 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
v1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m42 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
v2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m43 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
v3 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m44
          in
            Float -> Float -> Float -> Vec3
vec3 (Float
px Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
p) (Float
py Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
p) (Float
pz Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
p)

-- ** Translation

{-# INLINE translate #-}
translate :: Float -> Float -> Float -> Transform
translate :: Float -> Float -> Float -> Transform
translate Float
x Float
y Float
z = Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Transform
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 = Vec3 -> (Float -> Float -> Float -> Transform) -> Transform
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 = Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Transform
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 = Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Transform
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 = Float -> Float
forall a. Floating a => a -> a
cos Float
rads
    sint :: Float
sint = Float -> Float
forall a. Floating a => a -> a
sin Float
rads

{-# INLINE rotateY #-}
rotateY :: Float -> Transform
rotateY :: Float -> Transform
rotateY Float
rads = Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Transform
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 = Float -> Float
forall a. Floating a => a -> a
cos Float
rads
    sint :: Float
sint = Float -> Float
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 = Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Transform
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 = Float -> Float
forall a. Floating a => a -> a
cos Float
rads
   sint :: Float
sint = Float -> Float
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 =
  Quaternion
-> (Float -> Float -> Float -> Float -> Transform) -> Transform
forall r.
Quaternion -> (Float -> Float -> Float -> Float -> r) -> r
withQuaternion Quaternion
rs \Float
w Float
x Float
y Float
z ->
  Vec3 -> (Float -> Float -> Float -> Transform) -> Transform
forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
t \Float
tx Float
ty Float
tz ->
    let
      x2 :: Float
x2 = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x
      y2 :: Float
y2 = Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
y
      z2 :: Float
z2 = Float
z Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
z
      xy :: Float
xy = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
y
      xz :: Float
xz = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
z
      xw :: Float
xw = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
w
      yz :: Float
yz = Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
z
      yw :: Float
yw = Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
w
      zw :: Float
zw = Float
z Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
w
    in
      Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Transform
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 -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
y2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
z2)) (    Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
xy Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
zw)) (    Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
xz Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
yw)) Float
tx
        (    Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
xy Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
zw)) (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
x2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
z2)) (    Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
yz Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
xw)) Float
ty
        (    Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
xz Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
yw)) (    Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
yz Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
xw)) (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
x2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
y2)) Float
tz
         Float
0                   Float
0                   Float
0                  Float
1