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

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

  , apply
  , (!.)

  , translate
  , translateV

  , rotateX
  , rotateY
  , rotateZ
  , rotateQ

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

  , dirPos
  ) where

import Foreign (Storable(..))
import Foreign.Ptr.Diff (peekDiffOff, pokeDiffOff)

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
import Graphics.Gl.Block (Block(..))

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)

instance Block Transform where
  type PackedSize Transform = 64
  alignment140 :: forall (proxy :: * -> *). proxy Transform -> Int
alignment140 proxy Transform
_  = Int
16
  sizeOf140 :: forall (proxy :: * -> *). proxy Transform -> Int
sizeOf140       = forall b (proxy :: * -> *). Block b => proxy b -> Int
sizeOfPacked
  alignment430 :: forall (proxy :: * -> *). proxy Transform -> Int
alignment430    = forall b (proxy :: * -> *). Block b => proxy b -> Int
alignment140
  sizeOf430 :: forall (proxy :: * -> *). proxy Transform -> Int
sizeOf430       = forall b (proxy :: * -> *). Block b => proxy b -> Int
sizeOf140
  isStruct :: forall (proxy :: * -> *). proxy Transform -> Bool
isStruct proxy Transform
_      = Bool
False
  read140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Transform -> m Transform
read140     = forall (m :: * -> *) b a.
(MonadIO m, Storable b) =>
Ptr a -> Diff a b -> m b
peekDiffOff
  write140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Transform -> Transform -> m ()
write140    = forall (m :: * -> *) b a.
(MonadIO m, Storable b) =>
Ptr a -> Diff a b -> b -> m ()
pokeDiffOff
  read430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Transform -> m Transform
read430     = forall b (m :: * -> *) a.
(Block b, MonadIO m) =>
Ptr a -> Diff a b -> m b
read140
  write430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Transform -> Transform -> m ()
write430    = forall b (m :: * -> *) a.
(Block b, MonadIO m) =>
Ptr a -> Diff a b -> b -> m ()
write140
  readPacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Transform -> m Transform
readPacked  = forall b (m :: * -> *) a.
(Block b, MonadIO m) =>
Ptr a -> Diff a b -> m b
read140
  writePacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Transform -> Transform -> m ()
writePacked = forall b (m :: * -> *) a.
(Block b, MonadIO m) =>
Ptr a -> Diff a b -> b -> m ()
write140
  {-# INLINE alignment140 #-}
  {-# INLINE sizeOf140 #-}
  {-# INLINE alignment430 #-}
  {-# INLINE sizeOf430 #-}
  {-# INLINE isStruct #-}
  {-# INLINE read140 #-}
  {-# INLINE write140 #-}
  {-# INLINE read430 #-}
  {-# INLINE write430 #-}
  {-# INLINE readPacked #-}
  {-# INLINE writePacked #-}

-- | 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