{-# 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 :: Vec3 -> Transform -> Vec3
apply :: Vec3 -> Transform -> Vec3
apply = forall a b c. (a -> b -> c) -> b -> a -> c
flip Transform -> Vec3 -> Vec3
(!.)
(!.) :: 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
{-# 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
{-# 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
{-# 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