{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
module Geomancy.Vec4
( Vec4
, vec4
, withVec4
, pattern WithVec4
, fromVec2
, fromVec22
, fromVec3
, fromTuple
, (^*)
, (^/)
, lerp
, dot
, normalize
) where
import Control.DeepSeq (NFData(rnf))
import Data.Coerce (Coercible, coerce)
import Foreign (Storable(..), castPtr)
import Geomancy.Vec2 (Vec2, withVec2)
import Geomancy.Vec3 (Vec3, withVec3)
data Vec4 = Vec4
{-# UNPACK #-} !Float
{-# UNPACK #-} !Float
{-# UNPACK #-} !Float
{-# UNPACK #-} !Float
deriving (Vec4 -> Vec4 -> Bool
(Vec4 -> Vec4 -> Bool) -> (Vec4 -> Vec4 -> Bool) -> Eq Vec4
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vec4 -> Vec4 -> Bool
$c/= :: Vec4 -> Vec4 -> Bool
== :: Vec4 -> Vec4 -> Bool
$c== :: Vec4 -> Vec4 -> Bool
Eq, Eq Vec4
Eq Vec4
-> (Vec4 -> Vec4 -> Ordering)
-> (Vec4 -> Vec4 -> Bool)
-> (Vec4 -> Vec4 -> Bool)
-> (Vec4 -> Vec4 -> Bool)
-> (Vec4 -> Vec4 -> Bool)
-> (Vec4 -> Vec4 -> Vec4)
-> (Vec4 -> Vec4 -> Vec4)
-> Ord Vec4
Vec4 -> Vec4 -> Bool
Vec4 -> Vec4 -> Ordering
Vec4 -> Vec4 -> Vec4
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Vec4 -> Vec4 -> Vec4
$cmin :: Vec4 -> Vec4 -> Vec4
max :: Vec4 -> Vec4 -> Vec4
$cmax :: Vec4 -> Vec4 -> Vec4
>= :: Vec4 -> Vec4 -> Bool
$c>= :: Vec4 -> Vec4 -> Bool
> :: Vec4 -> Vec4 -> Bool
$c> :: Vec4 -> Vec4 -> Bool
<= :: Vec4 -> Vec4 -> Bool
$c<= :: Vec4 -> Vec4 -> Bool
< :: Vec4 -> Vec4 -> Bool
$c< :: Vec4 -> Vec4 -> Bool
compare :: Vec4 -> Vec4 -> Ordering
$ccompare :: Vec4 -> Vec4 -> Ordering
$cp1Ord :: Eq Vec4
Ord, Int -> Vec4 -> ShowS
[Vec4] -> ShowS
Vec4 -> String
(Int -> Vec4 -> ShowS)
-> (Vec4 -> String) -> ([Vec4] -> ShowS) -> Show Vec4
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vec4] -> ShowS
$cshowList :: [Vec4] -> ShowS
show :: Vec4 -> String
$cshow :: Vec4 -> String
showsPrec :: Int -> Vec4 -> ShowS
$cshowsPrec :: Int -> Vec4 -> ShowS
Show)
{-# INLINE vec4 #-}
vec4 :: Float -> Float -> Float -> Float -> Vec4
vec4 :: Float -> Float -> Float -> Float -> Vec4
vec4 = Float -> Float -> Float -> Float -> Vec4
Vec4
{-# INLINE withVec4 #-}
withVec4
:: Vec4
-> (Float -> Float -> Float -> Float -> r)
-> r
withVec4 :: Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 (Vec4 Float
a Float
b Float
c Float
d) Float -> Float -> Float -> Float -> r
f = Float -> Float -> Float -> Float -> r
f Float
a Float
b Float
c Float
d
pattern WithVec4 :: Float -> Float -> Float -> Float -> Vec4
pattern $mWithVec4 :: forall r.
Vec4
-> (Float -> Float -> Float -> Float -> r) -> (Void# -> r) -> r
WithVec4 a b c d <- ((`withVec4` (,,,)) -> (a, b, c, d))
{-# COMPLETE WithVec4 #-}
{-# INLINE fromVec2 #-}
fromVec2 :: Vec2 -> Float -> Float -> Vec4
fromVec2 :: Vec2 -> Float -> Float -> Vec4
fromVec2 Vec2
xy Float
z Float
w =
Vec2 -> (Float -> Float -> Vec4) -> Vec4
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
xy \Float
x Float
y ->
Float -> Float -> Float -> Float -> Vec4
vec4 Float
x Float
y Float
z Float
w
{-# INLINE fromVec22 #-}
fromVec22 :: Vec2 -> Vec2 -> Vec4
fromVec22 :: Vec2 -> Vec2 -> Vec4
fromVec22 Vec2
xy Vec2
zw =
Vec2 -> (Float -> Float -> Vec4) -> Vec4
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
xy \Float
x Float
y ->
Vec2 -> (Float -> Float -> Vec4) -> Vec4
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
zw \Float
z Float
w ->
Float -> Float -> Float -> Float -> Vec4
vec4 Float
x Float
y Float
z Float
w
{-# INLINE fromVec3 #-}
fromVec3 :: Coercible a Vec3 => a -> Float -> Vec4
fromVec3 :: a -> Float -> Vec4
fromVec3 a
xyz Float
w =
Vec3 -> (Float -> Float -> Float -> Vec4) -> Vec4
forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 (a -> Vec3
coerce a
xyz) \Float
x Float
y Float
z ->
Float -> Float -> Float -> Float -> Vec4
vec4 Float
x Float
y Float
z Float
w
{-# INLINE fromTuple #-}
fromTuple :: (Float, Float, Float, Float) -> Vec4
fromTuple :: (Float, Float, Float, Float) -> Vec4
fromTuple (Float
x, Float
y, Float
z, Float
w) = Float -> Float -> Float -> Float -> Vec4
vec4 Float
x Float
y Float
z Float
w
instance NFData Vec4 where
rnf :: Vec4 -> ()
rnf Vec4{} = ()
instance Num Vec4 where
{-# INLINE (+) #-}
Vec4 Float
l1 Float
l2 Float
l3 Float
l4 + :: Vec4 -> Vec4 -> Vec4
+ Vec4 Float
r1 Float
r2 Float
r3 Float
r4 =
Float -> Float -> Float -> Float -> Vec4
Vec4
(Float
l1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
r1)
(Float
l2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
r2)
(Float
l3 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
r3)
(Float
l4 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
r4)
{-# INLINE (-) #-}
Vec4 Float
l1 Float
l2 Float
l3 Float
l4 - :: Vec4 -> Vec4 -> Vec4
- Vec4 Float
r1 Float
r2 Float
r3 Float
r4 =
Float -> Float -> Float -> Float -> Vec4
Vec4
(Float
l1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
r1)
(Float
l2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
r2)
(Float
l3 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
r3)
(Float
l4 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
r4)
{-# INLINE (*) #-}
Vec4 Float
l1 Float
l2 Float
l3 Float
l4 * :: Vec4 -> Vec4 -> Vec4
* Vec4 Float
r1 Float
r2 Float
r3 Float
r4 =
Float -> Float -> Float -> Float -> Vec4
Vec4
(Float
l1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r1)
(Float
l2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r2)
(Float
l3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r3)
(Float
l4 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r4)
{-# INLINE abs #-}
abs :: Vec4 -> Vec4
abs (Vec4 Float
a Float
b Float
c Float
d) =
Float -> Float -> Float -> Float -> Vec4
Vec4 (Float -> Float
forall a. Num a => a -> a
abs Float
a) (Float -> Float
forall a. Num a => a -> a
abs Float
b) (Float -> Float
forall a. Num a => a -> a
abs Float
c) (Float -> Float
forall a. Num a => a -> a
abs Float
d)
{-# INLINE signum #-}
signum :: Vec4 -> Vec4
signum (Vec4 Float
a Float
b Float
c Float
d) =
Float -> Float -> Float -> Float -> Vec4
Vec4 (Float -> Float
forall a. Num a => a -> a
signum Float
a) (Float -> Float
forall a. Num a => a -> a
signum Float
b) (Float -> Float
forall a. Num a => a -> a
signum Float
c) (Float -> Float
forall a. Num a => a -> a
signum Float
d)
{-# INLINE fromInteger #-}
fromInteger :: Integer -> Vec4
fromInteger Integer
x = Float -> Float -> Float -> Float -> Vec4
Vec4 Float
x' Float
x' Float
x' Float
x'
where
x' :: Float
x' = Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
x
instance Fractional Vec4 where
{-# INLINE (/) #-}
Vec4 Float
l1 Float
l2 Float
l3 Float
l4 / :: Vec4 -> Vec4 -> Vec4
/ Vec4 Float
r1 Float
r2 Float
r3 Float
r4 =
Float -> Float -> Float -> Float -> Vec4
Vec4 (Float
l1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
r1) (Float
l2 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
r2) (Float
l3 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
r3) (Float
l4 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
r4)
{-# INLINE recip #-}
recip :: Vec4 -> Vec4
recip (Vec4 Float
a Float
b Float
c Float
d) =
Float -> Float -> Float -> Float -> Vec4
Vec4 (Float -> Float
forall a. Fractional a => a -> a
recip Float
a) (Float -> Float
forall a. Fractional a => a -> a
recip Float
b) (Float -> Float
forall a. Fractional a => a -> a
recip Float
c) (Float -> Float
forall a. Fractional a => a -> a
recip Float
d)
{-# INLINE fromRational #-}
fromRational :: Rational -> Vec4
fromRational Rational
x = Float -> Float -> Float -> Float -> Vec4
Vec4 Float
x' Float
x' Float
x' Float
x'
where
x' :: Float
x' = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
x
instance Storable Vec4 where
{-# INLINE sizeOf #-}
sizeOf :: Vec4 -> Int
sizeOf Vec4
_ = Int
16
{-# INLINE alignment #-}
alignment :: Vec4 -> Int
alignment Vec4
_ = Int
16
{-# INLINE poke #-}
poke :: Ptr Vec4 -> Vec4 -> IO ()
poke Ptr Vec4
ptr Vec4
v4 =
Vec4 -> (Float -> Float -> Float -> Float -> IO ()) -> IO ()
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
v4 \Float
a Float
b Float
c Float
d -> do
Ptr Float -> Float -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Float
forall b. Ptr b
ptr' Float
a
Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
forall b. Ptr b
ptr' Int
1 Float
b
Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
forall b. Ptr b
ptr' Int
2 Float
c
Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
forall b. Ptr b
ptr' Int
3 Float
d
where
ptr' :: Ptr b
ptr' = Ptr Vec4 -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr Vec4
ptr
{-# INLINE peek #-}
peek :: Ptr Vec4 -> IO Vec4
peek Ptr Vec4
ptr = Float -> Float -> Float -> Float -> Vec4
vec4
(Float -> Float -> Float -> Float -> Vec4)
-> IO Float -> IO (Float -> Float -> Float -> Vec4)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Float -> IO Float
forall a. Storable a => Ptr a -> IO a
peek Ptr Float
forall b. Ptr b
ptr'
IO (Float -> Float -> Float -> Vec4)
-> IO Float -> IO (Float -> Float -> Vec4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
ptr' Int
1
IO (Float -> Float -> Vec4) -> IO Float -> IO (Float -> Vec4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
ptr' Int
2
IO (Float -> Vec4) -> IO Float -> IO Vec4
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
ptr' Int
3
where
ptr' :: Ptr b
ptr' = Ptr Vec4 -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr Vec4
ptr
{-# INLINE (^*) #-}
(^*) :: Vec4 -> Float -> Vec4
Vec4 Float
a Float
b Float
c Float
d ^* :: Vec4 -> Float -> Vec4
^* Float
x =
Float -> Float -> Float -> Float -> Vec4
Vec4
(Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x)
(Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x)
(Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x)
(Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x)
{-# INLINE (^/) #-}
(^/) :: Vec4 -> Float -> Vec4
Vec4 Float
a Float
b Float
c Float
d ^/ :: Vec4 -> Float -> Vec4
^/ Float
x =
Float -> Float -> Float -> Float -> Vec4
Vec4
(Float
a Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x)
(Float
b Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x)
(Float
c Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x)
(Float
d Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x)
{-# INLINE lerp #-}
lerp :: Float -> Vec4 -> Vec4 -> Vec4
lerp :: Float -> Vec4 -> Vec4 -> Vec4
lerp Float
alpha Vec4
u Vec4
v = Vec4
u Vec4 -> Float -> Vec4
^* Float
alpha Vec4 -> Vec4 -> Vec4
forall a. Num a => a -> a -> a
+ Vec4
v Vec4 -> Float -> Vec4
^* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
alpha)
{-# INLINE dot #-}
dot :: Vec4 -> Vec4 -> Float
dot :: Vec4 -> Vec4 -> Float
dot (Vec4 Float
l1 Float
l2 Float
l3 Float
l4) (Vec4 Float
r1 Float
r2 Float
r3 Float
r4) =
Float
l1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+
Float
l2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+
Float
l3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r3 Float -> Float -> Float
forall a. Num a => a -> a -> a
+
Float
l4 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r4
{-# INLINE normalize #-}
normalize :: Vec4 -> Vec4
normalize :: Vec4 -> Vec4
normalize Vec4
v =
if Float -> Bool
forall a. (Ord a, Fractional a) => a -> Bool
nearZero Float
q Bool -> Bool -> Bool
|| Float -> Bool
forall a. (Ord a, Fractional a) => a -> Bool
nearZero (Float
1Float -> Float -> Float
forall a. Num a => a -> a -> a
-Float
q) then
Vec4
v
else
let
Vec4 Float
x Float
y Float
z Float
w = Vec4
v
in
Float -> Float -> Float -> Float -> Vec4
Vec4 (Float
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
l) (Float
y Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
l) (Float
z Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
l) (Float
w Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
l)
where
q :: Float
q = Vec4 -> Vec4 -> Float
dot Vec4
v Vec4
v
l :: Float
l = Float -> Float
forall a. Floating a => a -> a
sqrt Float
q
nearZero :: a -> Bool
nearZero a
a = a -> a
forall a. Num a => a -> a
abs a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1e-6