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

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

  , apply
  , (!.)

  , translate
  , translateV

  , rotateX
  , rotateY
  , rotateZ
  , rotateQ

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

  , dirPos
  , node
  ) where

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

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

import Graphics.Gl.Block (Block(..))

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
$cshowsPrec :: Int -> Transform -> ShowS
showsPrec :: Int -> Transform -> ShowS
$cshow :: Transform -> String
show :: Transform -> String
$cshowList :: [Transform] -> ShowS
showList :: [Transform] -> ShowS
Show, 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
$c<> :: Transform -> Transform -> Transform
<> :: Transform -> Transform -> Transform
$csconcat :: NonEmpty Transform -> Transform
sconcat :: NonEmpty Transform -> Transform
$cstimes :: forall b. Integral b => b -> Transform -> Transform
stimes :: forall b. Integral b => b -> 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
$cmempty :: Transform
mempty :: Transform
$cmappend :: Transform -> Transform -> Transform
mappend :: Transform -> Transform -> Transform
$cmconcat :: [Transform] -> Transform
mconcat :: [Transform] -> Transform
Monoid, 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
$csizeOf :: Transform -> Int
sizeOf :: Transform -> Int
$calignment :: Transform -> Int
alignment :: Transform -> Int
$cpeekElemOff :: Ptr Transform -> Int -> IO Transform
peekElemOff :: Ptr Transform -> Int -> IO Transform
$cpokeElemOff :: Ptr Transform -> Int -> Transform -> IO ()
pokeElemOff :: Ptr Transform -> Int -> Transform -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Transform
peekByteOff :: forall b. Ptr b -> Int -> IO Transform
$cpokeByteOff :: forall b. Ptr b -> Int -> Transform -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Transform -> IO ()
$cpeek :: Ptr Transform -> IO Transform
peek :: Ptr Transform -> IO Transform
$cpoke :: Ptr Transform -> Transform -> IO ()
poke :: Ptr Transform -> Transform -> IO ()
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       = proxy Transform -> Int
forall b (proxy :: * -> *). Block b => proxy b -> Int
forall (proxy :: * -> *). proxy Transform -> Int
sizeOfPacked
  alignment430 :: forall (proxy :: * -> *). proxy Transform -> Int
alignment430    = proxy Transform -> Int
forall b (proxy :: * -> *). Block b => proxy b -> Int
forall (proxy :: * -> *). proxy Transform -> Int
alignment140
  sizeOf430 :: forall (proxy :: * -> *). proxy Transform -> Int
sizeOf430       = proxy Transform -> Int
forall b (proxy :: * -> *). Block b => proxy b -> Int
forall (proxy :: * -> *). proxy Transform -> 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     = Ptr a -> Diff a Transform -> m Transform
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    = Ptr a -> Diff a Transform -> Transform -> m ()
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     = Ptr a -> Diff a Transform -> m Transform
forall b (m :: * -> *) a.
(Block b, MonadIO m) =>
Ptr a -> Diff a b -> m b
forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Transform -> m Transform
read140
  write430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Transform -> Transform -> m ()
write430    = Ptr a -> Diff a Transform -> Transform -> m ()
forall b (m :: * -> *) a.
(Block b, MonadIO m) =>
Ptr a -> Diff a b -> b -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Transform -> Transform -> m ()
write140
  readPacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Transform -> m Transform
readPacked  = Ptr a -> Diff a Transform -> m Transform
forall b (m :: * -> *) a.
(Block b, MonadIO m) =>
Ptr a -> Diff a b -> m b
forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Transform -> m Transform
read140
  writePacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Transform -> Transform -> m ()
writePacked = Ptr a -> Diff a Transform -> Transform -> m ()
forall b (m :: * -> *) a.
(Block b, MonadIO m) =>
Ptr a -> Diff a b -> b -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a Transform -> Transform -> 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 = (Transform -> Vec3 -> Vec3) -> Vec3 -> Transform -> Vec3
forall a b c. (a -> b -> c) -> b -> a -> c
flip Transform -> Vec3 -> Vec3
(!.)

{- | Matrix - row vector multiplication with perspective division

@
vOut = pv <> translate !. vIn
@
-}
(!.) :: Transform -> Vec3 -> Vec3
!. :: Transform -> Vec3 -> Vec3
(!.) Transform
mat Vec3
vec =
  Vec4 -> (Float -> Float -> Float -> Float -> Vec3) -> Vec3
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 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
w) (Float
y Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
w) (Float
z Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
w)
  where
    res :: Vec4
res = Transform
mat Transform -> Vec4 -> Vec4
forall a. Coercible a Mat4 => a -> Vec4 -> Vec4
Mat4.!* Vec3 -> Float -> Vec4
forall a. Coercible a Vec3 => a -> Float -> Vec4
fromVec3 Vec3
vec Float
1.0

infixr 5 !.

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

{-# INLINE scaleV #-}
scaleV :: Vec3 -> Transform
scaleV :: Vec3 -> Transform
scaleV Vec3
s = Vec3 -> (Float -> Float -> Float -> Transform) -> Transform
forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
s Float -> Float -> Float -> Transform
scale3

-- ** Rotation

{- | Clockwise rotation around positive X axis.

Matches @\a -> rotateQ (axisAngle (vec3 1 0 0) a)@.
-}
{-# 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
c (-Float
s) Float
0
    Float
0 Float
s   Float
c  Float
0
    Float
0 Float
0   Float
0  Float
1
  where
    c :: Float
c = Float -> Float
forall a. Floating a => a -> a
cos Float
rads
    s :: Float
s = Float -> Float
forall a. Floating a => a -> a
sin Float
rads

{- | Clockwise rotation around positive Y axis.

Matches @\a -> rotateQ (axisAngle (vec3 0 1 0) a)@.
-}
{-# 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
c  Float
0 Float
s Float
0
    Float
0  Float
1 Float
0 Float
0
  (-Float
s) Float
0 Float
c Float
0
    Float
0  Float
0 Float
0 Float
1
  where
    c :: Float
c = Float -> Float
forall a. Floating a => a -> a
cos Float
rads
    s :: Float
s = Float -> Float
forall a. Floating a => a -> a
sin Float
rads

{- | Clockwise rotation around positive Z axis.

Can be used for 2D rotation in the XY plane.
Matches @\a -> rotateQ (axisAngle (vec3 0 0 1) a)@.

In the right-handed "window coordinates" (e.g. top-left corner is 0,0) "right" becomes "down" after 90deg turn.
-}
{-# 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
c (-Float
s) Float
0 Float
0
    Float
s   Float
c  Float
0 Float
0
    Float
0   Float
0  Float
1 Float
0
    Float
0   Float
0  Float
0 Float
1
  where
   c :: Float
c = Float -> Float
forall a. Floating a => a -> a
cos Float
rads
   s :: Float
s = 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

node :: Vec3 -> Quaternion -> Vec3 -> Transform
node :: Vec3 -> Quaternion -> Vec3 -> Transform
node Vec3
t Quaternion
r Vec3
s
 | Vec3
s Vec3 -> Vec3 -> Bool
forall a. Eq a => a -> a -> Bool
== Vec3
1.0 = Quaternion -> Vec3 -> Transform
dirPos Quaternion
r Vec3
t
 | Bool
otherwise = Quaternion -> Vec3 -> Transform
dirPos Quaternion
r Vec3
t Transform -> Transform -> Transform
forall a. Semigroup a => a -> a -> a
<> Vec3 -> Transform
scaleV Vec3
s -- TODO: finish derivation