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

-- | Specialized and inlined @V2 Int32@.

module Geomancy.IVec2
  ( IVec2
  , ivec2
  , withIVec2
  , pattern WithIVec2
  , fromTuple
  ) where

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

import Geomancy.Elementwise (Elementwise(..))

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

{-# INLINE ivec2 #-}
ivec2 :: Int32 -> Int32 -> IVec2
ivec2 :: Int32 -> Int32 -> IVec2
ivec2 = Int32 -> Int32 -> IVec2
IVec2

{-# INLINE withIVec2 #-}
withIVec2
  :: IVec2
  -> (Int32 -> Int32 -> r)
  -> r
withIVec2 :: forall r. IVec2 -> (Int32 -> Int32 -> r) -> r
withIVec2 (IVec2 Int32
a Int32
b) Int32 -> Int32 -> r
f = Int32 -> Int32 -> r
f Int32
a Int32
b

pattern WithIVec2 :: Int32 -> Int32 -> IVec2
pattern $mWithIVec2 :: forall {r}. IVec2 -> (Int32 -> Int32 -> r) -> ((# #) -> r) -> r
WithIVec2 a b <- ((`withIVec2` (,)) -> (a, b))
{-# COMPLETE WithIVec2 #-}

{-# INLINE fromTuple #-}
fromTuple :: (Int32, Int32) -> IVec2
fromTuple :: (Int32, Int32) -> IVec2
fromTuple (Int32
x, Int32
y) = Int32 -> Int32 -> IVec2
ivec2 Int32
x Int32
y

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

type instance Element IVec2 = Int32

instance MonoFunctor IVec2 where
  {-# INLINE omap #-}
  omap :: (Element IVec2 -> Element IVec2) -> IVec2 -> IVec2
omap Element IVec2 -> Element IVec2
f IVec2
v =
    forall r. IVec2 -> (Int32 -> Int32 -> r) -> r
withIVec2 IVec2
v \Int32
x Int32
y ->
      Int32 -> Int32 -> IVec2
ivec2 (Element IVec2 -> Element IVec2
f Int32
x) (Element IVec2 -> Element IVec2
f Int32
y)

instance MonoPointed IVec2 where
  {-# INLINE opoint #-}
  opoint :: Element IVec2 -> IVec2
opoint Element IVec2
x = Int32 -> Int32 -> IVec2
ivec2 Element IVec2
x Element IVec2
x

instance Elementwise IVec2 where
  {-# INLINE emap2 #-}
  emap2 :: (Element IVec2 -> Element IVec2 -> Element IVec2)
-> IVec2 -> IVec2 -> IVec2
emap2 Element IVec2 -> Element IVec2 -> Element IVec2
f IVec2
p0 IVec2
p1 =
    forall r. IVec2 -> (Int32 -> Int32 -> r) -> r
withIVec2 IVec2
p0 \Int32
x0 Int32
y0 ->
    forall r. IVec2 -> (Int32 -> Int32 -> r) -> r
withIVec2 IVec2
p1 \Int32
x1 Int32
y1 ->
      Int32 -> Int32 -> IVec2
ivec2
        (Element IVec2 -> Element IVec2 -> Element IVec2
f Int32
x0 Int32
x1)
        (Element IVec2 -> Element IVec2 -> Element IVec2
f Int32
y0 Int32
y1)

  {-# INLINE emap3 #-}
  emap3 :: (Element IVec2 -> Element IVec2 -> Element IVec2 -> Element IVec2)
-> IVec2 -> IVec2 -> IVec2 -> IVec2
emap3 Element IVec2 -> Element IVec2 -> Element IVec2 -> Element IVec2
f IVec2
p0 IVec2
p1 IVec2
p2 =
    forall r. IVec2 -> (Int32 -> Int32 -> r) -> r
withIVec2 IVec2
p0 \Int32
x0 Int32
y0 ->
    forall r. IVec2 -> (Int32 -> Int32 -> r) -> r
withIVec2 IVec2
p1 \Int32
x1 Int32
y1 ->
    forall r. IVec2 -> (Int32 -> Int32 -> r) -> r
withIVec2 IVec2
p2 \Int32
x2 Int32
y2 ->
      Int32 -> Int32 -> IVec2
ivec2
        (Element IVec2 -> Element IVec2 -> Element IVec2 -> Element IVec2
f Int32
x0 Int32
x1 Int32
x2)
        (Element IVec2 -> Element IVec2 -> Element IVec2 -> Element IVec2
f Int32
y0 Int32
y1 Int32
y2)

  {-# INLINE emap4 #-}
  emap4 :: (Element IVec2
 -> Element IVec2
 -> Element IVec2
 -> Element IVec2
 -> Element IVec2)
-> IVec2 -> IVec2 -> IVec2 -> IVec2 -> IVec2
emap4 Element IVec2
-> Element IVec2 -> Element IVec2 -> Element IVec2 -> Element IVec2
f IVec2
p0 IVec2
p1 IVec2
p2 IVec2
p3 =
    forall r. IVec2 -> (Int32 -> Int32 -> r) -> r
withIVec2 IVec2
p0 \Int32
x0 Int32
y0 ->
    forall r. IVec2 -> (Int32 -> Int32 -> r) -> r
withIVec2 IVec2
p1 \Int32
x1 Int32
y1 ->
    forall r. IVec2 -> (Int32 -> Int32 -> r) -> r
withIVec2 IVec2
p2 \Int32
x2 Int32
y2 ->
    forall r. IVec2 -> (Int32 -> Int32 -> r) -> r
withIVec2 IVec2
p3 \Int32
x3 Int32
y3 ->
      Int32 -> Int32 -> IVec2
ivec2
        (Element IVec2
-> Element IVec2 -> Element IVec2 -> Element IVec2 -> Element IVec2
f Int32
x0 Int32
x1 Int32
x2 Int32
x3)
        (Element IVec2
-> Element IVec2 -> Element IVec2 -> Element IVec2 -> Element IVec2
f Int32
y0 Int32
y1 Int32
y2 Int32
y3)

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

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

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

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

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

  {-# INLINE signum #-}
  signum :: IVec2 -> IVec2
signum IVec2
v2 = forall r. IVec2 -> (Int32 -> Int32 -> r) -> r
withIVec2 IVec2
v2 \Int32
a Int32
b ->
    Int32 -> Int32 -> IVec2
ivec2 (forall a. Num a => a -> a
signum Int32
a) (forall a. Num a => a -> a
signum Int32
b)

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

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

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

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

  {-# INLINE peek #-}
  peek :: Ptr IVec2 -> IO IVec2
peek Ptr IVec2
ptr = Int32 -> Int32 -> IVec2
ivec2
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr IVec2
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 IVec2
ptr Int
4