{-# LINE 1 "src/SFML/Window/ContextSettings.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# LINE 2 "src/SFML/Window/ContextSettings.hsc" #-}
module SFML.Window.ContextSettings
(
    ContextSettings(..)
,   ContextAttribute(..)
)
where


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



{-# LINE 17 "src/SFML/Window/ContextSettings.hsc" #-}



{-# LINE 20 "src/SFML/Window/ContextSettings.hsc" #-}


data ContextSettings = ContextSettings
    { depthBits         :: Int -- ^ Bits of the depth buffer
    , stencilBits       :: Int -- ^ Bits of the stencil buffer
    , antialiasingLevel :: Int -- ^ Level of antialiasing
    , majorVersion      :: Int -- ^ Major number of the context version to create
    , minorVersion      :: Int -- ^ Minor number of the context version to create
    , attributeFlags    :: [ContextAttribute] -- ^ The attribute flags to create the context with
    }
    deriving (Show)


instance Storable ContextSettings where
    sizeOf _ = (24)
{-# LINE 35 "src/SFML/Window/ContextSettings.hsc" #-}
    alignment _ = 4
{-# LINE 36 "src/SFML/Window/ContextSettings.hsc" #-}

    peek ptr = ContextSettings
            <$> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 0) ptr :: IO CInt)
{-# LINE 39 "src/SFML/Window/ContextSettings.hsc" #-}
            <*> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO CInt)
{-# LINE 40 "src/SFML/Window/ContextSettings.hsc" #-}
            <*> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CInt)
{-# LINE 41 "src/SFML/Window/ContextSettings.hsc" #-}
            <*> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 12) ptr :: IO CInt)
{-# LINE 42 "src/SFML/Window/ContextSettings.hsc" #-}
            <*> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 16) ptr :: IO CInt)
{-# LINE 43 "src/SFML/Window/ContextSettings.hsc" #-}
            <*> fmap (toFlags . fromIntegral) ((\hsc_ptr -> peekByteOff hsc_ptr 20) ptr :: IO Word32)
{-# LINE 44 "src/SFML/Window/ContextSettings.hsc" #-}

    poke ptr (ContextSettings db sb al ma mi af) = do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (fromIntegral db :: CInt)
{-# LINE 47 "src/SFML/Window/ContextSettings.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr (fromIntegral sb :: CInt)
{-# LINE 48 "src/SFML/Window/ContextSettings.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (fromIntegral al :: CInt)
{-# LINE 49 "src/SFML/Window/ContextSettings.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 12) ptr (fromIntegral ma :: CInt)
{-# LINE 50 "src/SFML/Window/ContextSettings.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr (fromIntegral mi :: CInt)
{-# LINE 51 "src/SFML/Window/ContextSettings.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 20) ptr ((fromIntegral . fromFlags) af :: Word32)
{-# LINE 52 "src/SFML/Window/ContextSettings.hsc" #-}


data ContextAttribute
    = ContextDefault -- ^ Non-debug, compatibility context (this and the core attribute are mutually exclusive)
    | ContextCore    -- ^ Core attribute
    | ContextDebug   -- ^ Debug attribute
    deriving (Eq, Show)


instance Enum ContextAttribute where

    fromEnum ContextDefault = 0
    fromEnum ContextCore    = 1
    fromEnum ContextDebug   = 2

    toEnum 0 = ContextDefault
    toEnum 1 = ContextCore
    toEnum 2 = ContextDebug

fromFlags :: [ContextAttribute] -> Int
fromFlags = sum . map fromEnum

toFlags :: Int -> [ContextAttribute]
toFlags = return . toEnum