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


import Foreign.C.Types
import Foreign.Storable



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


sizeInt = (4)
{-# LINE 17 "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
    }
    deriving (Show)


instance Storable ContextSettings where
    sizeOf _ = 5*sizeInt
    alignment _ = alignment (undefined :: CUInt)
    
    peek ptr = do
        db <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr :: IO CInt
{-# LINE 35 "src/SFML/Window/ContextSettings.hsc" #-}
        sb <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO CInt
{-# LINE 36 "src/SFML/Window/ContextSettings.hsc" #-}
        al <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CInt
{-# LINE 37 "src/SFML/Window/ContextSettings.hsc" #-}
        ma <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr :: IO CInt
{-# LINE 38 "src/SFML/Window/ContextSettings.hsc" #-}
        mi <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr :: IO CInt
{-# LINE 39 "src/SFML/Window/ContextSettings.hsc" #-}
        return $ ContextSettings (fromIntegral db) (fromIntegral sb) (fromIntegral al)
            (fromIntegral ma) (fromIntegral mi)
    
    poke ptr (ContextSettings db sb al ma mi) = do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (fromIntegral db :: CInt)
{-# LINE 44 "src/SFML/Window/ContextSettings.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr (fromIntegral sb :: CInt)
{-# LINE 45 "src/SFML/Window/ContextSettings.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (fromIntegral al :: CInt)
{-# LINE 46 "src/SFML/Window/ContextSettings.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 12) ptr (fromIntegral ma :: CInt)
{-# LINE 47 "src/SFML/Window/ContextSettings.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr (fromIntegral mi :: CInt)
{-# LINE 48 "src/SFML/Window/ContextSettings.hsc" #-}