{-# 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 :: 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