module SFML.Window.VideoMode
(
VideoMode(..)
, getDesktopMode
, getFullscreenModes
, isValid
)
where
import Control.Applicative ((<$>), (<*>), (*>), liftA2)
import Foreign.C.Types
import Foreign.Ptr
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray)
import Foreign.Marshal.Utils (with)
import Foreign.Storable
sizeInt = (4)
data VideoMode = VideoMode
{ windowWidth :: Int
, windowHeight :: Int
, windowBPP :: Int
}
deriving (Show)
instance Storable VideoMode where
sizeOf _ = 3*sizeInt
alignment _ = alignment (undefined :: CInt)
peek ptr = VideoMode
<$> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 0) ptr :: IO CUInt)
<*> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO CUInt)
<*> fmap fromIntegral ((\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CUInt)
poke ptr (VideoMode w h b) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (fromIntegral w :: CUInt)
(\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr (fromIntegral h :: CUInt)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (fromIntegral b :: CUInt)
getDesktopMode = alloca $ liftA2 (*>) sfVideoMode_getDesktopMode_helper peek
foreign import ccall unsafe "sfVideoMode_getDesktopMode_helper"
sfVideoMode_getDesktopMode_helper :: Ptr VideoMode -> IO ()
getFullscreenModes :: IO [VideoMode]
getFullscreenModes = do
alloca $ \countPtr -> do
ptrVM <- sfVideoMode_getFullscreenModes countPtr
count <- peek countPtr
peekArray (fromIntegral count) ptrVM
foreign import ccall unsafe "sfVideoMode_getFullscreenModes"
sfVideoMode_getFullscreenModes :: Ptr CUInt -> IO (Ptr VideoMode)
isValid :: VideoMode -> IO Bool
isValid vm = with vm $ \ptrVm -> sfVideoMode_isValid_helper ptrVm >>= return . (/=0)
foreign import ccall unsafe "sfVideoMode_isValid_helper"
sfVideoMode_isValid_helper :: Ptr VideoMode -> IO CChar