{-# LINE 1 "src/SFML/System/Vector2.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# LINE 2 "src/SFML/System/Vector2.hsc" #-}
module SFML.System.Vector2
(
    Vec2i(..)
,   Vec2u(..)
,   Vec2f(..)
)
where


import Control.Applicative ((<$>), (<*>))
import Data.Word
import Foreign.C.Types
import Foreign.Storable


{-# LINE 17 "src/SFML/System/Vector2.hsc" #-}


sizeFloat = (4)
{-# LINE 20 "src/SFML/System/Vector2.hsc" #-}
sizeInt   = (4)
{-# LINE 21 "src/SFML/System/Vector2.hsc" #-}


data Vec2i = Vec2i {-# UNPACK #-} !Int {-# UNPACK #-} !Int deriving Show


instance Storable Vec2i where
    sizeOf _ = 2*sizeInt
    alignment _ = alignment (undefined :: CInt)

    peek ptr = Vec2i
            <$> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 0) ptr :: IO CInt)
{-# LINE 32 "src/SFML/System/Vector2.hsc" #-}
            <*> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO CInt)
{-# LINE 33 "src/SFML/System/Vector2.hsc" #-}

    poke ptr (Vec2i x y) = do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (fromIntegral x :: CInt)
{-# LINE 36 "src/SFML/System/Vector2.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr (fromIntegral y :: CInt)
{-# LINE 37 "src/SFML/System/Vector2.hsc" #-}


instance Num Vec2i where
    Vec2i ax ay + Vec2i bx by = Vec2i (ax + bx) (ay + by)
    Vec2i ax ay - Vec2i bx by = Vec2i (ax - bx) (ay - by)
    Vec2i ax ay * Vec2i bx by = Vec2i (ax * bx) (ay * by)
    abs (Vec2i ax ay) = Vec2i (abs ax) (abs ay)
    signum (Vec2i ax ay) = Vec2i (signum ax) (signum ay)
    fromInteger i = Vec2i i' i' where i' = fromInteger i


data Vec2u = Vec2u {-# UNPACK #-} !Word {-# UNPACK #-} !Word deriving Show


instance Storable Vec2u where
    sizeOf _ = 2*sizeInt
    alignment _ = alignment (undefined :: CUInt)

    peek ptr = Vec2u
            <$> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 0) ptr :: IO CUInt)
{-# LINE 57 "src/SFML/System/Vector2.hsc" #-}
            <*> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO CUInt)
{-# LINE 58 "src/SFML/System/Vector2.hsc" #-}

    poke ptr (Vec2u x y) = do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (fromIntegral x :: CUInt)
{-# LINE 61 "src/SFML/System/Vector2.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr (fromIntegral y :: CUInt)
{-# LINE 62 "src/SFML/System/Vector2.hsc" #-}


instance Num Vec2u where
    Vec2u ax ay + Vec2u bx by = Vec2u (ax + bx) (ay + by)
    Vec2u ax ay - Vec2u bx by = Vec2u (ax - bx) (ay - by)
    Vec2u ax ay * Vec2u bx by = Vec2u (ax * bx) (ay * by)
    abs (Vec2u ax ay) = Vec2u (abs ax) (abs ay)
    signum (Vec2u ax ay) = Vec2u (signum ax) (signum ay)
    fromInteger i = Vec2u i' i' where i' = fromInteger i


data Vec2f = Vec2f {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving Show


instance Storable Vec2f where
    sizeOf _ = 2*sizeFloat
    alignment _ = alignment (undefined :: CFloat)

    peek ptr = Vec2f
            <$> fmap realToFrac ((\hsc_ptr -> peekByteOff hsc_ptr 0) ptr :: IO CFloat)
{-# LINE 82 "src/SFML/System/Vector2.hsc" #-}
            <*> fmap realToFrac ((\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO CFloat)
{-# LINE 83 "src/SFML/System/Vector2.hsc" #-}

    poke ptr (Vec2f x y) = do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (realToFrac x :: CFloat)
{-# LINE 86 "src/SFML/System/Vector2.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr (realToFrac y :: CFloat)
{-# LINE 87 "src/SFML/System/Vector2.hsc" #-}


instance Num Vec2f where
    Vec2f ax ay + Vec2f bx by = Vec2f (ax + bx) (ay + by)
    Vec2f ax ay - Vec2f bx by = Vec2f (ax - bx) (ay - by)
    Vec2f ax ay * Vec2f bx by = Vec2f (ax * bx) (ay * by)
    abs (Vec2f ax ay) = Vec2f (abs ax) (abs ay)
    signum (Vec2f ax ay) = Vec2f (signum ax) (signum ay)
    fromInteger i = Vec2f i' i' where i' = fromInteger i


instance Fractional Vec2f where
    Vec2f ax ay / Vec2f bx by = Vec2f (ax / bx) (ay / by)
    fromRational r = Vec2f r' r' where r' = fromRational r