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

-- | Specialized and inlined @V2 Word32@.

module Geomancy.UVec2
  ( UVec2
  , uvec2
  , withUVec2
  , pattern WithUVec2
  , fromTuple
  ) where

import Control.DeepSeq (NFData(rnf))
import Data.Word (Word32)
import Data.MonoTraversable (Element, MonoFunctor(..), MonoPointed(..))
import Foreign (Storable(..))

import Geomancy.Elementwise (Elementwise(..))

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

{-# INLINE uvec2 #-}
uvec2 :: Word32 -> Word32 -> UVec2
uvec2 :: Word32 -> Word32 -> UVec2
uvec2 = Word32 -> Word32 -> UVec2
UVec2

{-# INLINE withUVec2 #-}
withUVec2
  :: UVec2
  -> (Word32 -> Word32 -> r)
  -> r
withUVec2 :: forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 (UVec2 Word32
a Word32
b) Word32 -> Word32 -> r
f = Word32 -> Word32 -> r
f Word32
a Word32
b

pattern WithUVec2 :: Word32 -> Word32 -> UVec2
pattern $mWithUVec2 :: forall {r}. UVec2 -> (Word32 -> Word32 -> r) -> ((# #) -> r) -> r
WithUVec2 a b <- ((`withUVec2` (,)) -> (a, b))
{-# COMPLETE WithUVec2 #-}

{-# INLINE fromTuple #-}
fromTuple :: (Word32, Word32) -> UVec2
fromTuple :: (Word32, Word32) -> UVec2
fromTuple (Word32
x, Word32
y) = Word32 -> Word32 -> UVec2
uvec2 Word32
x Word32
y

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

type instance Element UVec2 = Word32

instance MonoFunctor UVec2 where
  {-# INLINE omap #-}
  omap :: (Element UVec2 -> Element UVec2) -> UVec2 -> UVec2
omap Element UVec2 -> Element UVec2
f UVec2
v =
    forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
v \Word32
x Word32
y ->
      Word32 -> Word32 -> UVec2
uvec2 (Element UVec2 -> Element UVec2
f Word32
x) (Element UVec2 -> Element UVec2
f Word32
y)

instance MonoPointed UVec2 where
  {-# INLINE opoint #-}
  opoint :: Element UVec2 -> UVec2
opoint Element UVec2
x = Word32 -> Word32 -> UVec2
uvec2 Element UVec2
x Element UVec2
x

instance Elementwise UVec2 where
  {-# INLINE emap2 #-}
  emap2 :: (Element UVec2 -> Element UVec2 -> Element UVec2)
-> UVec2 -> UVec2 -> UVec2
emap2 Element UVec2 -> Element UVec2 -> Element UVec2
f UVec2
p0 UVec2
p1 =
    forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
p0 \Word32
x0 Word32
y0 ->
    forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
p1 \Word32
x1 Word32
y1 ->
      Word32 -> Word32 -> UVec2
uvec2
        (Element UVec2 -> Element UVec2 -> Element UVec2
f Word32
x0 Word32
x1)
        (Element UVec2 -> Element UVec2 -> Element UVec2
f Word32
y0 Word32
y1)

  {-# INLINE emap3 #-}
  emap3 :: (Element UVec2 -> Element UVec2 -> Element UVec2 -> Element UVec2)
-> UVec2 -> UVec2 -> UVec2 -> UVec2
emap3 Element UVec2 -> Element UVec2 -> Element UVec2 -> Element UVec2
f UVec2
p0 UVec2
p1 UVec2
p2 =
    forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
p0 \Word32
x0 Word32
y0 ->
    forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
p1 \Word32
x1 Word32
y1 ->
    forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
p2 \Word32
x2 Word32
y2 ->
      Word32 -> Word32 -> UVec2
uvec2
        (Element UVec2 -> Element UVec2 -> Element UVec2 -> Element UVec2
f Word32
x0 Word32
x1 Word32
x2)
        (Element UVec2 -> Element UVec2 -> Element UVec2 -> Element UVec2
f Word32
y0 Word32
y1 Word32
y2)

  {-# INLINE emap4 #-}
  emap4 :: (Element UVec2
 -> Element UVec2
 -> Element UVec2
 -> Element UVec2
 -> Element UVec2)
-> UVec2 -> UVec2 -> UVec2 -> UVec2 -> UVec2
emap4 Element UVec2
-> Element UVec2 -> Element UVec2 -> Element UVec2 -> Element UVec2
f UVec2
p0 UVec2
p1 UVec2
p2 UVec2
p3 =
    forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
p0 \Word32
x0 Word32
y0 ->
    forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
p1 \Word32
x1 Word32
y1 ->
    forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
p2 \Word32
x2 Word32
y2 ->
    forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
p3 \Word32
x3 Word32
y3 ->
      Word32 -> Word32 -> UVec2
uvec2
        (Element UVec2
-> Element UVec2 -> Element UVec2 -> Element UVec2 -> Element UVec2
f Word32
x0 Word32
x1 Word32
x2 Word32
x3)
        (Element UVec2
-> Element UVec2 -> Element UVec2 -> Element UVec2 -> Element UVec2
f Word32
y0 Word32
y1 Word32
y2 Word32
y3)

  {-# INLINE emap5 #-}
  emap5 :: (Element UVec2
 -> Element UVec2
 -> Element UVec2
 -> Element UVec2
 -> Element UVec2
 -> Element UVec2)
-> UVec2 -> UVec2 -> UVec2 -> UVec2 -> UVec2 -> UVec2
emap5 Element UVec2
-> Element UVec2
-> Element UVec2
-> Element UVec2
-> Element UVec2
-> Element UVec2
f UVec2
p0 UVec2
p1 UVec2
p2 UVec2
p3 UVec2
p4 =
    forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
p0 \Word32
x0 Word32
y0 ->
    forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
p1 \Word32
x1 Word32
y1 ->
    forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
p2 \Word32
x2 Word32
y2 ->
    forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
p3 \Word32
x3 Word32
y3 ->
    forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
p4 \Word32
x4 Word32
y4 ->
      Word32 -> Word32 -> UVec2
uvec2
        (Element UVec2
-> Element UVec2
-> Element UVec2
-> Element UVec2
-> Element UVec2
-> Element UVec2
f Word32
x0 Word32
x1 Word32
x2 Word32
x3 Word32
x4)
        (Element UVec2
-> Element UVec2
-> Element UVec2
-> Element UVec2
-> Element UVec2
-> Element UVec2
f Word32
y0 Word32
y1 Word32
y2 Word32
y3 Word32
y4)

-- XXX: That's one nasty instance...
instance Num UVec2 where
  {-# INLINE (+) #-}
  UVec2 Word32
l1 Word32
l2 + :: UVec2 -> UVec2 -> UVec2
+ UVec2 Word32
r1 Word32
r2 =
    Word32 -> Word32 -> UVec2
UVec2
      (Word32
l1 forall a. Num a => a -> a -> a
+ Word32
r1)
      (Word32
l2 forall a. Num a => a -> a -> a
+ Word32
r2)

  {-# INLINE (-) #-}
  UVec2 Word32
l1 Word32
l2 - :: UVec2 -> UVec2 -> UVec2
- UVec2 Word32
r1 Word32
r2 =
    Word32 -> Word32 -> UVec2
UVec2
      (Word32
l1 forall a. Num a => a -> a -> a
- Word32
r1)
      (Word32
l2 forall a. Num a => a -> a -> a
- Word32
r2)

  {-# INLINE (*) #-}
  UVec2 Word32
l1 Word32
l2 * :: UVec2 -> UVec2 -> UVec2
* UVec2 Word32
r1 Word32
r2 =
    Word32 -> Word32 -> UVec2
UVec2
      (Word32
l1 forall a. Num a => a -> a -> a
* Word32
r1)
      (Word32
l2 forall a. Num a => a -> a -> a
* Word32
r2)

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

  {-# INLINE signum #-}
  signum :: UVec2 -> UVec2
signum UVec2
v2 = forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
v2 \Word32
a Word32
b ->
    Word32 -> Word32 -> UVec2
uvec2 (forall a. Num a => a -> a
signum Word32
a) (forall a. Num a => a -> a
signum Word32
b)

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

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

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

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

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