{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}

-- | Specialized and inlined @V4 Float@.

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