{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE ViewPatterns #-}

-- | Specialized and inlined @V4 Float@.

module Geomancy.Vec4
  ( Vec4(..)
  , vec4
  , withVec4
  , pattern WithVec4
  , fromVec2
  , fromVec22
  , fromVec3
  , fromTuple

  , (^*)
  , (^/)
  , lerp

  , dot
  , normalize

  , unsafeNewVec4
  ) where

import GHC.Exts hiding (VecCount(..), toList)

import Control.DeepSeq (NFData(rnf))
import Foreign (Storable(..))
import GHC.IO (IO(..))
-- import System.IO.Unsafe (unsafePerformIO)
import Text.Printf (printf)

import Geomancy.Vec2 (Vec2, withVec2)
import Geomancy.Vec3 (Vec3, withVec3)

data Vec4 = Vec4 ByteArray#

{-# INLINE vec4 #-}
vec4 :: Float -> Float -> Float -> Float -> Vec4
vec4 :: Float -> Float -> Float -> Float -> Vec4
vec4 (F# Float#
v0) (F# Float#
v1) (F# Float#
v2) (F# Float#
v3) =
  (State# RealWorld -> Vec4) -> Vec4
forall o. (State# RealWorld -> o) -> o
runRW# \State# RealWorld
world ->
    let
      !(# State# RealWorld
world_, MutableByteArray# RealWorld
arr #) = Int#
-> Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d.
Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newAlignedPinnedByteArray# Int#
16# Int#
16# State# RealWorld
world

      world0 :: State# RealWorld
world0 = MutableByteArray# RealWorld
-> Int# -> Float# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Float# -> State# d -> State# d
writeFloatArray# MutableByteArray# RealWorld
arr Int#
0x0# Float#
v0 State# RealWorld
world_
      world1 :: State# RealWorld
world1 = MutableByteArray# RealWorld
-> Int# -> Float# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Float# -> State# d -> State# d
writeFloatArray# MutableByteArray# RealWorld
arr Int#
0x1# Float#
v1 State# RealWorld
world0
      world2 :: State# RealWorld
world2 = MutableByteArray# RealWorld
-> Int# -> Float# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Float# -> State# d -> State# d
writeFloatArray# MutableByteArray# RealWorld
arr Int#
0x2# Float#
v2 State# RealWorld
world1
      world3 :: State# RealWorld
world3 = MutableByteArray# RealWorld
-> Int# -> Float# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Float# -> State# d -> State# d
writeFloatArray# MutableByteArray# RealWorld
arr Int#
0x3# Float#
v3 State# RealWorld
world2
      !(# State# RealWorld
_world', ByteArray#
arr' #) = MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
arr State# RealWorld
world3
    in
      ByteArray# -> Vec4
Vec4 ByteArray#
arr'

{-# INLINE withVec4 #-}
withVec4
  :: Vec4
  -> (Float -> Float -> Float -> Float -> r)
  -> r
withVec4 :: Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 (Vec4 ByteArray#
arr) Float -> Float -> Float -> Float -> r
f =
  Float -> Float -> Float -> Float -> r
f
    (Float# -> Float
F# (ByteArray# -> Int# -> Float#
indexFloatArray# ByteArray#
arr Int#
0x0#))
    (Float# -> Float
F# (ByteArray# -> Int# -> Float#
indexFloatArray# ByteArray#
arr Int#
0x1#))
    (Float# -> Float
F# (ByteArray# -> Int# -> Float#
indexFloatArray# ByteArray#
arr Int#
0x2#))
    (Float# -> Float
F# (ByteArray# -> Int# -> Float#
indexFloatArray# ByteArray#
arr Int#
0x3#))

{-# INLINE compareVec4 #-}
compareVec4 :: Vec4 -> Vec4 -> Ordering
compareVec4 :: Vec4 -> Vec4 -> Ordering
compareVec4 (Vec4 ByteArray#
src1) (Vec4 ByteArray#
src2) =
  Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int# -> Int
I# (ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
compareByteArrays# ByteArray#
src1 Int#
0# ByteArray#
src2 Int#
0# Int#
16#)) Int
0

instance Eq Vec4 where
  == :: Vec4 -> Vec4 -> Bool
(==) Vec4
a Vec4
b =
    case Vec4 -> Vec4 -> Ordering
compareVec4 Vec4
a Vec4
b of
      Ordering
EQ -> Bool
True
      Ordering
_  -> Bool
False

  /= :: Vec4 -> Vec4 -> Bool
(/=) Vec4
a Vec4
b =
    case Vec4 -> Vec4 -> Ordering
compareVec4 Vec4
a Vec4
b of
      Ordering
EQ -> Bool
False
      Ordering
_  -> Bool
True

instance Ord Vec4 where
  compare :: Vec4 -> Vec4 -> Ordering
compare = Vec4 -> Vec4 -> Ordering
compareVec4

instance Show Vec4 where
  show :: Vec4 -> String
show Vec4
v =
    Vec4 -> (Float -> Float -> Float -> Float -> String) -> String
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
v ((Float -> Float -> Float -> Float -> String) -> String)
-> (Float -> Float -> Float -> Float -> String) -> String
forall a b. (a -> b) -> a -> b
$
      String -> Float -> Float -> Float -> Float -> String
forall r. PrintfType r => String -> r
printf String
"Vec4 %.4f %.4f %.4f %.4f"

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 -> Vec4 -> Vec4
(+) Vec4
l Vec4
r =
    Vec4 -> (Float -> Float -> Float -> Float -> Vec4) -> Vec4
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
l \Float
l1 Float
l2 Float
l3 Float
l4 ->
      Vec4 -> (Float -> Float -> Float -> Float -> Vec4) -> Vec4
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
r \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
l Vec4
r =
    Vec4 -> (Float -> Float -> Float -> Float -> Vec4) -> Vec4
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
l \Float
l1 Float
l2 Float
l3 Float
l4 ->
      Vec4 -> (Float -> Float -> Float -> Float -> Vec4) -> Vec4
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
r \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 -> Vec4 -> Vec4
(*) Vec4
l Vec4
r =
    Vec4 -> (Float -> Float -> Float -> Float -> Vec4) -> Vec4
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
l \Float
l1 Float
l2 Float
l3 Float
l4 ->
      Vec4 -> (Float -> Float -> Float -> Float -> Vec4) -> Vec4
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
r \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
v =
    Vec4 -> (Float -> Float -> Float -> Float -> Vec4) -> Vec4
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
v \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
v =
    Vec4 -> (Float -> Float -> Float -> Float -> Vec4) -> Vec4
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
v \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 -> Vec4 -> Vec4
(/) Vec4
l Vec4
r =
    Vec4 -> (Float -> Float -> Float -> Float -> Vec4) -> Vec4
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
l \Float
l1 Float
l2 Float
l3 Float
l4 ->
      Vec4 -> (Float -> Float -> Float -> Float -> Vec4) -> Vec4
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
r \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
v =
    Vec4 -> (Float -> Float -> Float -> Float -> Vec4) -> Vec4
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
v \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 Addr#
addr) (Vec4 ByteArray#
arr) = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO \State# RealWorld
world ->
    let
      world' :: State# RealWorld
world' = ByteArray#
-> Int# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
arr Int#
0# Addr#
addr Int#
16# State# RealWorld
world
    in
      (# State# RealWorld
world', () #)

  {-# INLINE peek #-}
  peek :: Ptr Vec4 -> IO Vec4
peek (Ptr Addr#
addr) = (State# RealWorld -> (# State# RealWorld, Vec4 #)) -> IO Vec4
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO \State# RealWorld
world ->
    let
      !(# State# RealWorld
world0, MutableByteArray# RealWorld
arr #)  = Int#
-> Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d.
Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newAlignedPinnedByteArray# Int#
16# Int#
16# State# RealWorld
world
      world1 :: State# RealWorld
world1              = Addr#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
addr MutableByteArray# RealWorld
arr Int#
0# Int#
16# State# RealWorld
world0
      !(# State# RealWorld
world', ByteArray#
arr' #) = MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
arr State# RealWorld
world1
    in
      (# State# RealWorld
world', ByteArray# -> Vec4
Vec4 ByteArray#
arr' #)

-- TODO: SIMD
{-# INLINE (^*) #-}
(^*) :: Vec4 -> Float -> Vec4
^* :: Vec4 -> Float -> Vec4
(^*) Vec4
v Float
x =
  Vec4 -> (Float -> Float -> Float -> Float -> Vec4) -> Vec4
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
v \Float
a Float
b Float
c Float
d ->
    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
v ^/ :: Vec4 -> Float -> Vec4
^/ Float
x = Vec4
v Vec4 -> Float -> Vec4
^* Float -> Float
forall a. Fractional a => a -> a
recip 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)

-- TODO: SIMD
{-# INLINE dot #-}
dot :: Vec4 -> Vec4 -> Float
dot :: Vec4 -> Vec4 -> Float
dot Vec4
a Vec4
b =
  Vec4 -> (Float -> Float -> Float -> Float -> Float) -> Float
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
a \Float
a1 Float
a2 Float
a3 Float
a4 ->
    Vec4 -> (Float -> Float -> Float -> Float -> Float) -> Float
forall r. Vec4 -> (Float -> Float -> Float -> Float -> r) -> r
withVec4 Vec4
b \Float
b1 Float
b2 Float
b3 Float
b4 ->
      Float
a1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+
      Float
a2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+
      Float
a3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b3 Float -> Float -> Float
forall a. Num a => a -> a -> a
+
      Float
a4 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b4

{-# 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
    Vec4
v Vec4 -> Float -> Vec4
^/ 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

{-# INLINE unsafeNewVec4 #-}
unsafeNewVec4 :: IO Vec4
unsafeNewVec4 :: IO Vec4
unsafeNewVec4 =
  (State# RealWorld -> (# State# RealWorld, Vec4 #)) -> IO Vec4
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO \State# RealWorld
world ->
    let
      !(# State# RealWorld
world_, MutableByteArray# RealWorld
arr_ #) = Int#
-> Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d.
Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newAlignedPinnedByteArray# Int#
16# Int#
16# State# RealWorld
world
      !(# State# RealWorld
_world', ByteArray#
arr #) = MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
arr_ State# RealWorld
world_
    in
      (# State# RealWorld
world, ByteArray# -> Vec4
Vec4 ByteArray#
arr #)