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

-- | Specialized and inlined @V2 Float@.

module Geomancy.Vec2
  ( Vec2
  , vec2
  , withVec2
  , pattern WithVec2
  , fromTuple

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

  , dot
  , normalize
  ) where

import Control.DeepSeq (NFData(rnf))
import Foreign (Storable(..))

data Vec2 = Vec2
  {-# UNPACK #-} !Float
  {-# UNPACK #-} !Float
  deriving (Vec2 -> Vec2 -> Bool
(Vec2 -> Vec2 -> Bool) -> (Vec2 -> Vec2 -> Bool) -> Eq Vec2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vec2 -> Vec2 -> Bool
$c/= :: Vec2 -> Vec2 -> Bool
== :: Vec2 -> Vec2 -> Bool
$c== :: Vec2 -> Vec2 -> Bool
Eq, Eq Vec2
Eq Vec2
-> (Vec2 -> Vec2 -> Ordering)
-> (Vec2 -> Vec2 -> Bool)
-> (Vec2 -> Vec2 -> Bool)
-> (Vec2 -> Vec2 -> Bool)
-> (Vec2 -> Vec2 -> Bool)
-> (Vec2 -> Vec2 -> Vec2)
-> (Vec2 -> Vec2 -> Vec2)
-> Ord Vec2
Vec2 -> Vec2 -> Bool
Vec2 -> Vec2 -> Ordering
Vec2 -> Vec2 -> Vec2
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 :: Vec2 -> Vec2 -> Vec2
$cmin :: Vec2 -> Vec2 -> Vec2
max :: Vec2 -> Vec2 -> Vec2
$cmax :: Vec2 -> Vec2 -> Vec2
>= :: Vec2 -> Vec2 -> Bool
$c>= :: Vec2 -> Vec2 -> Bool
> :: Vec2 -> Vec2 -> Bool
$c> :: Vec2 -> Vec2 -> Bool
<= :: Vec2 -> Vec2 -> Bool
$c<= :: Vec2 -> Vec2 -> Bool
< :: Vec2 -> Vec2 -> Bool
$c< :: Vec2 -> Vec2 -> Bool
compare :: Vec2 -> Vec2 -> Ordering
$ccompare :: Vec2 -> Vec2 -> Ordering
$cp1Ord :: Eq Vec2
Ord, Int -> Vec2 -> ShowS
[Vec2] -> ShowS
Vec2 -> String
(Int -> Vec2 -> ShowS)
-> (Vec2 -> String) -> ([Vec2] -> ShowS) -> Show Vec2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vec2] -> ShowS
$cshowList :: [Vec2] -> ShowS
show :: Vec2 -> String
$cshow :: Vec2 -> String
showsPrec :: Int -> Vec2 -> ShowS
$cshowsPrec :: Int -> Vec2 -> ShowS
Show)

{-# INLINE vec2 #-}
vec2 :: Float -> Float -> Vec2
vec2 :: Float -> Float -> Vec2
vec2 = Float -> Float -> Vec2
Vec2

{-# INLINE withVec2 #-}
withVec2
  :: Vec2
  -> (Float -> Float -> r)
  -> r
withVec2 :: Vec2 -> (Float -> Float -> r) -> r
withVec2 (Vec2 Float
a Float
b) Float -> Float -> r
f = Float -> Float -> r
f Float
a Float
b

pattern WithVec2 :: Float -> Float -> Vec2
pattern $mWithVec2 :: forall r. Vec2 -> (Float -> Float -> r) -> (Void# -> r) -> r
WithVec2 a b <- ((`withVec2` (,)) -> (a, b))
{-# COMPLETE WithVec2 #-}

{-# INLINE fromTuple #-}
fromTuple :: (Float, Float) -> Vec2
fromTuple :: (Float, Float) -> Vec2
fromTuple (Float
x, Float
y) = Float -> Float -> Vec2
vec2 Float
x Float
y

instance NFData Vec2 where
  rnf :: Vec2 -> ()
rnf Vec2{} = ()

instance Num Vec2 where
  {-# INLINE (+) #-}
  Vec2 Float
l1 Float
l2 + :: Vec2 -> Vec2 -> Vec2
+ Vec2 Float
r1 Float
r2 =
    Float -> Float -> Vec2
Vec2
      (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)

  {-# INLINE (-) #-}
  Vec2 Float
l1 Float
l2 - :: Vec2 -> Vec2 -> Vec2
- Vec2 Float
r1 Float
r2 =
    Float -> Float -> Vec2
Vec2
      (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)

  {-# INLINE (*) #-}
  Vec2 Float
l1 Float
l2 * :: Vec2 -> Vec2 -> Vec2
* Vec2 Float
r1 Float
r2 =
    Float -> Float -> Vec2
Vec2
      (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)

  {-# INLINE abs #-}
  abs :: Vec2 -> Vec2
abs (Vec2 Float
a Float
b) =
    Float -> Float -> Vec2
Vec2 (Float -> Float
forall a. Num a => a -> a
abs Float
a) (Float -> Float
forall a. Num a => a -> a
abs Float
b)

  {-# INLINE signum #-}
  signum :: Vec2 -> Vec2
signum (Vec2 Float
a Float
b) =
    Float -> Float -> Vec2
Vec2 (Float -> Float
forall a. Num a => a -> a
signum Float
a) (Float -> Float
forall a. Num a => a -> a
signum Float
b)

  {-# INLINE fromInteger #-}
  fromInteger :: Integer -> Vec2
fromInteger Integer
x = Float -> Float -> Vec2
Vec2 Float
x' Float
x'
    where
      x' :: Float
x' = Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
x

instance Fractional Vec2 where
  {-# INLINE (/) #-}
  Vec2 Float
l1 Float
l2 / :: Vec2 -> Vec2 -> Vec2
/ Vec2 Float
r1 Float
r2 =
    Float -> Float -> Vec2
Vec2 (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)

  {-# INLINE recip #-}
  recip :: Vec2 -> Vec2
recip (Vec2 Float
a Float
b) =
    Float -> Float -> Vec2
Vec2 (Float -> Float
forall a. Fractional a => a -> a
recip Float
a) (Float -> Float
forall a. Fractional a => a -> a
recip Float
b)

  {-# INLINE fromRational #-}
  fromRational :: Rational -> Vec2
fromRational Rational
x = Float -> Float -> Vec2
Vec2 Float
x' Float
x'
    where
      x' :: Float
x' = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
x

{-# INLINE (^*) #-}
(^*) :: Vec2 -> Float -> Vec2
Vec2 Float
a Float
b ^* :: Vec2 -> Float -> Vec2
^* Float
x =
  Float -> Float -> Vec2
Vec2
    (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)

{-# INLINE (^/) #-}
(^/) :: Vec2 -> Float -> Vec2
Vec2 Float
a Float
b ^/ :: Vec2 -> Float -> Vec2
^/ Float
x =
  Float -> Float -> Vec2
Vec2
    (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)

{-# INLINE lerp #-}
lerp :: Float -> Vec2 -> Vec2 -> Vec2
lerp :: Float -> Vec2 -> Vec2 -> Vec2
lerp Float
alpha Vec2
u Vec2
v = Vec2
u Vec2 -> Float -> Vec2
^* Float
alpha Vec2 -> Vec2 -> Vec2
forall a. Num a => a -> a -> a
+ Vec2
v Vec2 -> Float -> Vec2
^* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
alpha)

{-# INLINE dot #-}
dot :: Vec2 -> Vec2 -> Float
dot :: Vec2 -> Vec2 -> Float
dot (Vec2 Float
l1 Float
l2) (Vec2 Float
r1 Float
r2) =
  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

{-# INLINE normalize #-}
normalize :: Vec2 -> Vec2
normalize :: Vec2 -> Vec2
normalize Vec2
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
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
q) then
    Vec2
v
  else
    let
      Vec2 Float
x Float
y = Vec2
v
    in
      Float -> Float -> Vec2
Vec2 (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)

  where
    q :: Float
q = Vec2 -> Vec2 -> Float
dot Vec2
v Vec2
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

instance Storable Vec2 where
  {-# INLINE sizeOf #-}
  sizeOf :: Vec2 -> Int
sizeOf Vec2
_ = Int
8

  {-# INLINE alignment #-}
  alignment :: Vec2 -> Int
alignment Vec2
_ = Int
8

  {-# INLINE poke #-}
  poke :: Ptr Vec2 -> Vec2 -> IO ()
poke Ptr Vec2
ptr Vec2
v4 =
    Vec2 -> (Float -> Float -> IO ()) -> IO ()
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
v4 \Float
a Float
b -> do
      Ptr Vec2 -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Vec2
ptr Int
0 Float
a
      Ptr Vec2 -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Vec2
ptr Int
4 Float
b

  {-# INLINE peek #-}
  peek :: Ptr Vec2 -> IO Vec2
peek Ptr Vec2
ptr = Float -> Float -> Vec2
vec2
    (Float -> Float -> Vec2) -> IO Float -> IO (Float -> Vec2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Vec2 -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Vec2
ptr Int
0
    IO (Float -> Vec2) -> IO Float -> IO Vec2
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Vec2 -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Vec2
ptr Int
4