{-# LINE 1 "Graphics/UI/SDL/Video.hsc" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.SDL.Video
-- Copyright   :  (c) David Himmelstrup 2005
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-----------------------------------------------------------------------------
module Graphics.UI.SDL.Video
    ( Palette
    , Toggle (..)
    , fromToggle
    , toToggle
    , tryGetVideoSurface
    , getVideoSurface
    , tryVideoDriverName
    , videoDriverName
    , getVideoInfo
    , ListModes(..)
    , listModes
    , videoModeOK
    , trySetVideoMode
    , setVideoMode
    , updateRect
    , updateRects
    , tryFlip
    , flip
    , setColors
    , setPalette
    , setGamma
    , tryGetGammaRamp
    , getGammaRamp
    , trySetGammaRamp
    , setGammaRamp
    , mapRGB
    , mapRGBA
    , getRGB
    , getRGBA
    , tryCreateRGBSurface
    , createRGBSurface
    , tryCreateRGBSurfaceEndian
    , createRGBSurfaceEndian
    , tryCreateRGBSurfaceFrom
    , createRGBSurfaceFrom
    , freeSurface
    , lockSurface
    , unlockSurface
    , loadBMP
    , saveBMP
    , setColorKey
    , setAlpha
    , setClipRect
    , getClipRect
    , withClipRect
    , tryConvertSurface
    , convertSurface
    , blitSurface
    , fillRect
    , tryDisplayFormat
    , displayFormat
    , tryDisplayFormatAlpha
    , displayFormatAlpha
    , warpMouse
    , showCursor
    , queryCursorState
    , GLAttr, GLValue
    , glRedSize, glGreenSize, glBlueSize, glAlphaSize, glBufferSize, glDoubleBuffer
    , glDepthSize, glStencilSize, glAccumRedSize, glAccumGreenSize, glAccumBlueSize
    , glAccumAlphaSize, glStereo, glMultiSampleBuffers, glMultiSampleSamples
    , tryGLGetAttribute, glGetAttribute
    , tryGLSetAttribute, glSetAttribute
    , glSwapBuffers
    , mkFinalizedSurface
    ) where



{-# LINE 83 "Graphics/UI/SDL/Video.hsc" #-}

import Foreign (Ptr, FunPtr, Storable(peek), castPtr, plusPtr, nullPtr, newForeignPtr_,
               finalizeForeignPtr, alloca, withForeignPtr, newForeignPtr)
import Foreign.C (peekCString, CString, CInt(..))
import Foreign.Marshal.Array (withArrayLen, peekArray0, peekArray, allocaArray)
import Foreign.Marshal.Utils (with, toBool, maybeWith, maybePeek, fromBool)
import Control.Exception (bracket)
import Data.Word (Word8, Word16, Word32)
import Data.Int (Int32)

import Graphics.UI.SDL.Utilities (Enum(..), intToBool, toBitmask, fromCInt, toCInt)
import Graphics.UI.SDL.General (unwrapMaybe, unwrapBool)
import Graphics.UI.SDL.Rect (Rect(rectY, rectX, rectW, rectH))
import Graphics.UI.SDL.Color (Pixel(..), Color)
import Graphics.UI.SDL.Types (SurfaceFlag, PixelFormat, PixelFormatStruct, RWops,
                              RWopsStruct, VideoInfo, VideoInfoStruct, Surface, SurfaceStruct)
import qualified Graphics.UI.SDL.RWOps as RW

import Prelude hiding (flip,Enum(..))

--import Foreign.HacanonLight.Generate
--import Foreign.HacanonLight.DIS (foreignPtr,mkOut,word8)

data Palette
    = Logical
    | Physical
      deriving (Int -> Palette -> ShowS
[Palette] -> ShowS
Palette -> String
(Int -> Palette -> ShowS)
-> (Palette -> String) -> ([Palette] -> ShowS) -> Show Palette
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Palette -> ShowS
showsPrec :: Int -> Palette -> ShowS
$cshow :: Palette -> String
show :: Palette -> String
$cshowList :: [Palette] -> ShowS
showList :: [Palette] -> ShowS
Show,Palette -> Palette -> Bool
(Palette -> Palette -> Bool)
-> (Palette -> Palette -> Bool) -> Eq Palette
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Palette -> Palette -> Bool
== :: Palette -> Palette -> Bool
$c/= :: Palette -> Palette -> Bool
/= :: Palette -> Palette -> Bool
Eq,Eq Palette
Eq Palette
-> (Palette -> Palette -> Ordering)
-> (Palette -> Palette -> Bool)
-> (Palette -> Palette -> Bool)
-> (Palette -> Palette -> Bool)
-> (Palette -> Palette -> Bool)
-> (Palette -> Palette -> Palette)
-> (Palette -> Palette -> Palette)
-> Ord Palette
Palette -> Palette -> Bool
Palette -> Palette -> Ordering
Palette -> Palette -> Palette
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
$ccompare :: Palette -> Palette -> Ordering
compare :: Palette -> Palette -> Ordering
$c< :: Palette -> Palette -> Bool
< :: Palette -> Palette -> Bool
$c<= :: Palette -> Palette -> Bool
<= :: Palette -> Palette -> Bool
$c> :: Palette -> Palette -> Bool
> :: Palette -> Palette -> Bool
$c>= :: Palette -> Palette -> Bool
>= :: Palette -> Palette -> Bool
$cmax :: Palette -> Palette -> Palette
max :: Palette -> Palette -> Palette
$cmin :: Palette -> Palette -> Palette
min :: Palette -> Palette -> Palette
Ord)

instance Bounded Palette where
    minBound :: Palette
minBound = Palette
Logical
    maxBound :: Palette
maxBound = Palette
Physical

instance Enum Palette Int where
    fromEnum :: Palette -> Int
fromEnum Palette
Logical = Int
1
{-# LINE 117 "Graphics/UI/SDL/Video.hsc" #-}
    fromEnum Physical = 2
{-# LINE 118 "Graphics/UI/SDL/Video.hsc" #-}
    toEnum 1 = Logical
{-# LINE 119 "Graphics/UI/SDL/Video.hsc" #-}
    toEnum 2 = Physical
{-# LINE 120 "Graphics/UI/SDL/Video.hsc" #-}
    toEnum _ = error "Graphics.UI.SDL.Video.toEnum: bad argument"
    succ :: Palette -> Palette
succ Palette
Logical = Palette
Physical
    succ Palette
_ = String -> Palette
forall a. HasCallStack => String -> a
error String
"Graphics.UI.SDL.Video.succ: bad argument"
    pred :: Palette -> Palette
pred Palette
Physical = Palette
Logical
    pred Palette
_ = String -> Palette
forall a. HasCallStack => String -> a
error String
"Graphics.UI.SDL.Video.pred: bad argument"
    enumFromTo :: Palette -> Palette -> [Palette]
enumFromTo Palette
x Palette
y | Palette
x Palette -> Palette -> Bool
forall a. Ord a => a -> a -> Bool
> Palette
y = []
                   | Palette
x Palette -> Palette -> Bool
forall a. Eq a => a -> a -> Bool
== Palette
y = [Palette
y]
                   | Bool
True = Palette
x Palette -> [Palette] -> [Palette]
forall a. a -> [a] -> [a]
: Palette -> Palette -> [Palette]
forall a b. Enum a b => a -> a -> [a]
enumFromTo (Palette -> Palette
forall a b. Enum a b => a -> a
succ Palette
x) Palette
y


data Toggle = Disable | Enable | Query
    deriving (Toggle -> Toggle -> Bool
(Toggle -> Toggle -> Bool)
-> (Toggle -> Toggle -> Bool) -> Eq Toggle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Toggle -> Toggle -> Bool
== :: Toggle -> Toggle -> Bool
$c/= :: Toggle -> Toggle -> Bool
/= :: Toggle -> Toggle -> Bool
Eq, Eq Toggle
Eq Toggle
-> (Toggle -> Toggle -> Ordering)
-> (Toggle -> Toggle -> Bool)
-> (Toggle -> Toggle -> Bool)
-> (Toggle -> Toggle -> Bool)
-> (Toggle -> Toggle -> Bool)
-> (Toggle -> Toggle -> Toggle)
-> (Toggle -> Toggle -> Toggle)
-> Ord Toggle
Toggle -> Toggle -> Bool
Toggle -> Toggle -> Ordering
Toggle -> Toggle -> Toggle
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
$ccompare :: Toggle -> Toggle -> Ordering
compare :: Toggle -> Toggle -> Ordering
$c< :: Toggle -> Toggle -> Bool
< :: Toggle -> Toggle -> Bool
$c<= :: Toggle -> Toggle -> Bool
<= :: Toggle -> Toggle -> Bool
$c> :: Toggle -> Toggle -> Bool
> :: Toggle -> Toggle -> Bool
$c>= :: Toggle -> Toggle -> Bool
>= :: Toggle -> Toggle -> Bool
$cmax :: Toggle -> Toggle -> Toggle
max :: Toggle -> Toggle -> Toggle
$cmin :: Toggle -> Toggle -> Toggle
min :: Toggle -> Toggle -> Toggle
Ord, Int -> Toggle -> ShowS
[Toggle] -> ShowS
Toggle -> String
(Int -> Toggle -> ShowS)
-> (Toggle -> String) -> ([Toggle] -> ShowS) -> Show Toggle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Toggle -> ShowS
showsPrec :: Int -> Toggle -> ShowS
$cshow :: Toggle -> String
show :: Toggle -> String
$cshowList :: [Toggle] -> ShowS
showList :: [Toggle] -> ShowS
Show)

toToggle :: (Eq a, Num a) => a -> Toggle
toToggle :: forall a. (Eq a, Num a) => a -> Toggle
toToggle (a
0) = Toggle
Disable
{-# LINE 135 "Graphics/UI/SDL/Video.hsc" #-}
toToggle (1) = Enable
{-# LINE 136 "Graphics/UI/SDL/Video.hsc" #-}
toToggle (-1) = Query
{-# LINE 137 "Graphics/UI/SDL/Video.hsc" #-}
toToggle _ = error "Graphics.UI.SDL.Video.toToggle: bad argument"

fromToggle :: (Num a) => Toggle -> a
fromToggle :: forall a. Num a => Toggle -> a
fromToggle Toggle
Disable = a
0
fromToggle Toggle
Enable = a
1
fromToggle Toggle
Query = (-a
1)

foreign import ccall unsafe "SDL_GetVideoSurface" sdlGetVideoSurface :: IO (Ptr SurfaceStruct)

-- | Returns the video surface or @Nothing@ on error.
tryGetVideoSurface :: IO (Maybe Surface)
tryGetVideoSurface :: IO (Maybe Surface)
tryGetVideoSurface =
    IO (Ptr SurfaceStruct)
sdlGetVideoSurface IO (Ptr SurfaceStruct)
-> (Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr SurfaceStruct -> IO Surface)
-> Ptr SurfaceStruct -> IO (Maybe Surface)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr SurfaceStruct -> IO Surface
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_

-- | Returns the video surface, throwing an exception on error.
getVideoSurface :: IO Surface
getVideoSurface :: IO Surface
getVideoSurface = String -> IO (Maybe Surface) -> IO Surface
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"SDL_GetVideoSurface" IO (Maybe Surface)
tryGetVideoSurface

foreign import ccall unsafe "SDL_VideoDriverName" sdlVideoDriverName :: CString -> CInt -> IO CString

-- | Returns the video driver name or @Nothing@ on error. Notice, the driver name is limited to 256 chars.
tryVideoDriverName :: IO (Maybe String)
tryVideoDriverName :: IO (Maybe String)
tryVideoDriverName 
    = Int -> (Ptr CChar -> IO (Maybe String)) -> IO (Maybe String)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
size (\Ptr CChar
ptr -> Ptr CChar -> CInt -> IO (Ptr CChar)
sdlVideoDriverName Ptr CChar
ptr (Int -> CInt
toCInt Int
size) IO (Ptr CChar)
-> (Ptr CChar -> IO (Maybe String)) -> IO (Maybe String)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr CChar -> IO String) -> Ptr CChar -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO String
peekCString)
    where size :: Int
size = Int
256

-- | Returns the video driver name, throwing an exception on error. See also 'tryVideoDriverName'.
videoDriverName :: IO String
videoDriverName :: IO String
videoDriverName = String -> IO (Maybe String) -> IO String
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"SDL_VideoDriverName" IO (Maybe String)
tryVideoDriverName

foreign import ccall unsafe "SDL_GetVideoInfo" sdlGetVideoInfo :: IO (Ptr VideoInfoStruct)
getVideoInfo :: IO VideoInfo
getVideoInfo :: IO VideoInfo
getVideoInfo = IO (Ptr VideoInfoStruct)
sdlGetVideoInfo IO (Ptr VideoInfoStruct)
-> (Ptr VideoInfoStruct -> IO VideoInfo) -> IO VideoInfo
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr VideoInfoStruct -> IO VideoInfo
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_

data ListModes
    = Modes [Rect] -- ^ List of available resolutions.
    | NonAvailable -- ^ No modes available!
    | AnyOK -- ^ All resolutions available.
      deriving (Int -> ListModes -> ShowS
[ListModes] -> ShowS
ListModes -> String
(Int -> ListModes -> ShowS)
-> (ListModes -> String)
-> ([ListModes] -> ShowS)
-> Show ListModes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListModes -> ShowS
showsPrec :: Int -> ListModes -> ShowS
$cshow :: ListModes -> String
show :: ListModes -> String
$cshowList :: [ListModes] -> ShowS
showList :: [ListModes] -> ShowS
Show,ListModes -> ListModes -> Bool
(ListModes -> ListModes -> Bool)
-> (ListModes -> ListModes -> Bool) -> Eq ListModes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListModes -> ListModes -> Bool
== :: ListModes -> ListModes -> Bool
$c/= :: ListModes -> ListModes -> Bool
/= :: ListModes -> ListModes -> Bool
Eq,Eq ListModes
Eq ListModes
-> (ListModes -> ListModes -> Ordering)
-> (ListModes -> ListModes -> Bool)
-> (ListModes -> ListModes -> Bool)
-> (ListModes -> ListModes -> Bool)
-> (ListModes -> ListModes -> Bool)
-> (ListModes -> ListModes -> ListModes)
-> (ListModes -> ListModes -> ListModes)
-> Ord ListModes
ListModes -> ListModes -> Bool
ListModes -> ListModes -> Ordering
ListModes -> ListModes -> ListModes
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
$ccompare :: ListModes -> ListModes -> Ordering
compare :: ListModes -> ListModes -> Ordering
$c< :: ListModes -> ListModes -> Bool
< :: ListModes -> ListModes -> Bool
$c<= :: ListModes -> ListModes -> Bool
<= :: ListModes -> ListModes -> Bool
$c> :: ListModes -> ListModes -> Bool
> :: ListModes -> ListModes -> Bool
$c>= :: ListModes -> ListModes -> Bool
>= :: ListModes -> ListModes -> Bool
$cmax :: ListModes -> ListModes -> ListModes
max :: ListModes -> ListModes -> ListModes
$cmin :: ListModes -> ListModes -> ListModes
min :: ListModes -> ListModes -> ListModes
Ord)

foreign import ccall unsafe "SDL_ListModes" sdlListModes :: Ptr PixelFormatStruct -> Word32 -> IO (Ptr (Ptr Rect))

-- | Returns the available screen resolutions for the given format and video flags.
listModes :: Maybe PixelFormat -- ^ Will use SDL_GetVideoInfo()->vfmt when @Nothing@.
          -> [SurfaceFlag]
          -> IO ListModes
listModes :: Maybe PixelFormat -> [SurfaceFlag] -> IO ListModes
listModes Maybe PixelFormat
mbFormat [SurfaceFlag]
flags
    = do Ptr (Ptr Rect)
ret <- (Ptr PixelFormatStruct -> IO (Ptr (Ptr Rect)))
-> IO (Ptr (Ptr Rect))
forall {b}. (Ptr PixelFormatStruct -> IO b) -> IO b
getFormat (\Ptr PixelFormatStruct
ptr -> Ptr PixelFormatStruct -> Word32 -> IO (Ptr (Ptr Rect))
sdlListModes Ptr PixelFormatStruct
ptr ([SurfaceFlag] -> Word32
forall a b. (Enum a b, Bits b, Num b) => [a] -> b
toBitmask [SurfaceFlag]
flags))
         if Ptr (Ptr Rect)
ret Ptr (Ptr Rect) -> Ptr (Ptr Rect) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Any
forall a. Ptr a
nullPtr Ptr Any -> Int -> Ptr (Ptr Rect)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)
            then ListModes -> IO ListModes
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModes
AnyOK
            else if Ptr (Ptr Rect)
ret Ptr (Ptr Rect) -> Ptr (Ptr Rect) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (Ptr Rect)
forall a. Ptr a
nullPtr
                    then ListModes -> IO ListModes
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModes
NonAvailable
                    else do [Ptr Rect]
array <- Ptr Rect -> Ptr (Ptr Rect) -> IO [Ptr Rect]
forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 Ptr Rect
forall a. Ptr a
nullPtr Ptr (Ptr Rect)
ret
                            ([Rect] -> ListModes) -> IO [Rect] -> IO ListModes
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Rect] -> ListModes
Modes ((Ptr Rect -> IO Rect) -> [Ptr Rect] -> IO [Rect]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ptr Rect -> IO Rect
forall a. Storable a => Ptr a -> IO a
peek [Ptr Rect]
array)
    where getFormat :: (Ptr PixelFormatStruct -> IO b) -> IO b
getFormat = ((Ptr PixelFormatStruct -> IO b) -> IO b)
-> (PixelFormat -> (Ptr PixelFormatStruct -> IO b) -> IO b)
-> Maybe PixelFormat
-> (Ptr PixelFormatStruct -> IO b)
-> IO b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (\Ptr PixelFormatStruct -> IO b
action -> Ptr PixelFormatStruct -> IO b
action Ptr PixelFormatStruct
forall a. Ptr a
nullPtr) PixelFormat -> (Ptr PixelFormatStruct -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Maybe PixelFormat
mbFormat

-- int SDL_VideoModeOK(int width, int height, int bpp, Uint32 flags);
foreign import ccall unsafe "SDL_VideoModeOK" sdlVideoModeOK :: CInt -> CInt -> CInt -> Word32 -> IO CInt

-- | Check to see if a particular video mode is supported.
--   Returns the bits-per-pixel of the closest available mode with the given width,
--   height and requested surface flags, or @Nothing@ on error.
videoModeOK :: Int -- ^ Width.
            -> Int -- ^ Height.
            -> Int -- ^ Bits-per-pixel.
            -> [SurfaceFlag] -- ^ Flags.
            -> IO (Maybe Int)
videoModeOK :: Int -> Int -> Int -> [SurfaceFlag] -> IO (Maybe Int)
videoModeOK Int
width Int
height Int
bpp [SurfaceFlag]
flags
    = do CInt
ret <- CInt -> CInt -> CInt -> Word32 -> IO CInt
sdlVideoModeOK (Int -> CInt
toCInt Int
width) (Int -> CInt
toCInt Int
height) (Int -> CInt
toCInt Int
bpp) ([SurfaceFlag] -> Word32
forall a b. (Enum a b, Bits b, Num b) => [a] -> b
toBitmask [SurfaceFlag]
flags)
         case CInt
ret of
           CInt
0 -> Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
           CInt
x -> Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Num a => CInt -> a
fromCInt CInt
x)

-- SDL_Surface *SDL_SetVideoMode(int width, int height, int bpp, Uint32 flags);
foreign import ccall unsafe "SDL_SetVideoMode" sdlSetVideoMode :: CInt -> CInt -> CInt -> Word32 -> IO (Ptr SurfaceStruct)

-- | Set up a video mode with the specified width, height and bits-per-pixel.
--   Returns @Nothing@ on error.
trySetVideoMode :: Int -- ^ Width.
                -> Int -- ^ Height.
                -> Int -- ^ Bits-per-pixel.
                -> [SurfaceFlag] -- ^ Flags.
                -> IO (Maybe Surface)
trySetVideoMode :: Int -> Int -> Int -> [SurfaceFlag] -> IO (Maybe Surface)
trySetVideoMode Int
width Int
height Int
bpp [SurfaceFlag]
flags
    = CInt -> CInt -> CInt -> Word32 -> IO (Ptr SurfaceStruct)
sdlSetVideoMode (Int -> CInt
toCInt Int
width) (Int -> CInt
toCInt Int
height) (Int -> CInt
toCInt Int
bpp) ([SurfaceFlag] -> Word32
forall a b. (Enum a b, Bits b, Num b) => [a] -> b
toBitmask [SurfaceFlag]
flags) IO (Ptr SurfaceStruct)
-> (Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr SurfaceStruct -> IO Surface)
-> Ptr SurfaceStruct -> IO (Maybe Surface)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr SurfaceStruct -> IO Surface
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_

-- | Same as 'trySetVideoMode' except it throws an exception on error.
setVideoMode :: Int -> Int -> Int -> [SurfaceFlag] -> IO Surface
setVideoMode :: Int -> Int -> Int -> [SurfaceFlag] -> IO Surface
setVideoMode Int
width Int
height Int
bpp [SurfaceFlag]
flags
    = String -> IO (Maybe Surface) -> IO Surface
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"SDL_SetVideoMode" (Int -> Int -> Int -> [SurfaceFlag] -> IO (Maybe Surface)
trySetVideoMode Int
width Int
height Int
bpp [SurfaceFlag]
flags)

-- void SDL_UpdateRect(SDL_Surface *screen, Sint32 x, Sint32 y, Sint32 w, Sint32 h);
foreign import ccall unsafe "SDL_UpdateRect" sdlUpdateRect :: Ptr SurfaceStruct
                                                           -> Int32 -> Int32 -> Word32 -> Word32 -> IO ()

-- | Makes sure the given area is updated on the given screen.
updateRect :: Surface -> Rect -> IO ()
updateRect :: Surface -> Rect -> IO ()
updateRect Surface
surface Rect
rect
    = Surface -> (Ptr SurfaceStruct -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface (\Ptr SurfaceStruct
ptr -> Ptr SurfaceStruct -> Int32 -> Int32 -> Word32 -> Word32 -> IO ()
sdlUpdateRect Ptr SurfaceStruct
ptr Int32
x Int32
y Word32
w Word32
h)
    where x :: Int32
x = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rect -> Int
rectX Rect
rect)
          y :: Int32
y = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rect -> Int
rectY Rect
rect)
          w :: Word32
w = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rect -> Int
rectW Rect
rect)
          h :: Word32
h = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rect -> Int
rectH Rect
rect)


-- void SDL_UpdateRects(SDL_Surface *screen, int numrects, SDL_Rect *rects);
foreign import ccall unsafe "SDL_UpdateRects" sdlUpdateRects :: Ptr SurfaceStruct -> CInt -> Ptr Rect -> IO ()

-- | Makes sure the given list of rectangles is updated on the given screen.
--   The rectangles are not automatically merged or checked for overlap.
--   In general, the programmer can use his knowledge about his particular
--   rectangles to merge them in an efficient way, to avoid overdraw.
updateRects :: Surface -> [Rect] -> IO ()
updateRects :: Surface -> [Rect] -> IO ()
updateRects Surface
surface [Rect]
rects
    = Surface -> (Ptr SurfaceStruct -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface ((Ptr SurfaceStruct -> IO ()) -> IO ())
-> (Ptr SurfaceStruct -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
ptr ->
      [Rect] -> (Int -> Ptr Rect -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Rect]
rects ((Int -> Ptr Rect -> IO ()) -> IO ())
-> (Int -> Ptr Rect -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
len Ptr Rect
array ->
      Ptr SurfaceStruct -> CInt -> Ptr Rect -> IO ()
sdlUpdateRects Ptr SurfaceStruct
ptr (Int -> CInt
toCInt Int
len) Ptr Rect
array

-- int SDL_Flip(SDL_Surface *screen);
foreign import ccall unsafe "SDL_Flip" sdlFlip :: Ptr SurfaceStruct -> IO CInt

-- | Swaps screen buffers.
tryFlip :: Surface -> IO Bool
tryFlip :: Surface -> IO Bool
tryFlip Surface
surface
    = Surface -> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface ((Ptr SurfaceStruct -> IO Bool) -> IO Bool)
-> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
ptr ->
      do CInt
ret <- Ptr SurfaceStruct -> IO CInt
sdlFlip Ptr SurfaceStruct
ptr
         case CInt
ret of
           (-1) -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
           CInt
_    -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | Same as 'tryFlip' but throws an exception on error.
flip :: Surface -> IO ()
flip :: Surface -> IO ()
flip = String -> IO Bool -> IO ()
unwrapBool String
"SDL_Flip" (IO Bool -> IO ()) -> (Surface -> IO Bool) -> Surface -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Surface -> IO Bool
tryFlip

-- int SDL_SetColors(SDL_Surface *surface, SDL_Color *colors, int firstcolor, int ncolors);
foreign import ccall unsafe "SDL_SetColors" sdlSetColors :: Ptr SurfaceStruct -> Ptr Color -> CInt -> CInt -> IO CInt

-- | Sets a portion of the colormap for the given 8-bit surface.
setColors :: Surface -> [Color] -> Int -> IO Bool
setColors :: Surface -> [Color] -> Int -> IO Bool
setColors Surface
surface [Color]
colors Int
start
    = Surface -> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface ((Ptr SurfaceStruct -> IO Bool) -> IO Bool)
-> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
ptr ->
      [Color] -> (Int -> Ptr Color -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Color]
colors ((Int -> Ptr Color -> IO Bool) -> IO Bool)
-> (Int -> Ptr Color -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Int
len Ptr Color
array ->
      (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Ptr SurfaceStruct -> Ptr Color -> CInt -> CInt -> IO CInt
sdlSetColors Ptr SurfaceStruct
ptr Ptr Color
array (Int -> CInt
toCInt Int
start) (Int -> CInt
toCInt Int
len))

-- int SDL_SetPalette(SDL_Surface *surface, int flags, SDL_Color *colors, int firstcolor, int ncolors);
foreign import ccall unsafe "SDL_SetPalette" sdlSetPalette
    :: Ptr SurfaceStruct -> CInt -> Ptr Color -> CInt -> CInt -> IO CInt

-- | Sets the colors in the palette of an 8-bit surface.
setPalette :: Surface -> [Palette] -> [Color] -> Int -> IO Bool
setPalette :: Surface -> [Palette] -> [Color] -> Int -> IO Bool
setPalette Surface
surface [Palette]
flags [Color]
colors Int
start
    = Surface -> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface ((Ptr SurfaceStruct -> IO Bool) -> IO Bool)
-> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
ptr ->
      [Color] -> (Int -> Ptr Color -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Color]
colors ((Int -> Ptr Color -> IO Bool) -> IO Bool)
-> (Int -> Ptr Color -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Int
len Ptr Color
array ->
      (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Ptr SurfaceStruct -> CInt -> Ptr Color -> CInt -> CInt -> IO CInt
sdlSetPalette Ptr SurfaceStruct
ptr (Int -> CInt
toCInt (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ [Palette] -> Int
forall a b. (Enum a b, Bits b, Num b) => [a] -> b
toBitmask [Palette]
flags) Ptr Color
array (Int -> CInt
toCInt Int
start) (Int -> CInt
toCInt Int
len))

--int SDL_SetGamma(float redgamma, float greengamma, float bluegamma);
foreign import ccall unsafe "SDL_SetGamma" sdlSetGamma :: Float -> Float -> Float -> IO CInt
setGamma :: Float -> Float -> Float -> IO Bool
setGamma :: Float -> Float -> Float -> IO Bool
setGamma Float
red Float
green Float
blue
    = Int -> IO Int -> IO Bool
intToBool (-Int
1) ((CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a. Num a => CInt -> a
fromCInt (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> IO CInt
sdlSetGamma Float
red Float
green Float
blue)

-- int SDL_GetGammaRamp(Uint16 *redtable, Uint16 *greentable, Uint16 *bluetable);
foreign import ccall unsafe "SDL_GetGammaRamp" sdlGetGammaRamp :: Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> IO CInt
tryGetGammaRamp :: IO (Maybe ([Word16],[Word16],[Word16]))
tryGetGammaRamp :: IO (Maybe ([Word16], [Word16], [Word16]))
tryGetGammaRamp
    = Int
-> (Ptr Word16 -> IO (Maybe ([Word16], [Word16], [Word16])))
-> IO (Maybe ([Word16], [Word16], [Word16]))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
size ((Ptr Word16 -> IO (Maybe ([Word16], [Word16], [Word16])))
 -> IO (Maybe ([Word16], [Word16], [Word16])))
-> (Ptr Word16 -> IO (Maybe ([Word16], [Word16], [Word16])))
-> IO (Maybe ([Word16], [Word16], [Word16]))
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
red ->
      Int
-> (Ptr Word16 -> IO (Maybe ([Word16], [Word16], [Word16])))
-> IO (Maybe ([Word16], [Word16], [Word16]))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
size ((Ptr Word16 -> IO (Maybe ([Word16], [Word16], [Word16])))
 -> IO (Maybe ([Word16], [Word16], [Word16])))
-> (Ptr Word16 -> IO (Maybe ([Word16], [Word16], [Word16])))
-> IO (Maybe ([Word16], [Word16], [Word16]))
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
green ->
      Int
-> (Ptr Word16 -> IO (Maybe ([Word16], [Word16], [Word16])))
-> IO (Maybe ([Word16], [Word16], [Word16]))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
size ((Ptr Word16 -> IO (Maybe ([Word16], [Word16], [Word16])))
 -> IO (Maybe ([Word16], [Word16], [Word16])))
-> (Ptr Word16 -> IO (Maybe ([Word16], [Word16], [Word16])))
-> IO (Maybe ([Word16], [Word16], [Word16]))
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
blue ->
      do CInt
ret <- Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> IO CInt
sdlGetGammaRamp Ptr Word16
red Ptr Word16
green Ptr Word16
blue
         case CInt
ret of
           (-1) -> Maybe ([Word16], [Word16], [Word16])
-> IO (Maybe ([Word16], [Word16], [Word16]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([Word16], [Word16], [Word16])
forall a. Maybe a
Nothing
           CInt
_ -> do [[Word16]
r,[Word16]
g,[Word16]
b] <- (Ptr Word16 -> IO [Word16]) -> [Ptr Word16] -> IO [[Word16]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> Ptr Word16 -> IO [Word16]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
size) [Ptr Word16
red,Ptr Word16
green,Ptr Word16
blue]
                   Maybe ([Word16], [Word16], [Word16])
-> IO (Maybe ([Word16], [Word16], [Word16]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (([Word16], [Word16], [Word16])
-> Maybe ([Word16], [Word16], [Word16])
forall a. a -> Maybe a
Just ([Word16]
r,[Word16]
g,[Word16]
b))
    where size :: Int
size = Int
256

getGammaRamp :: IO ([Word16],[Word16],[Word16])
getGammaRamp :: IO ([Word16], [Word16], [Word16])
getGammaRamp = String
-> IO (Maybe ([Word16], [Word16], [Word16]))
-> IO ([Word16], [Word16], [Word16])
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"SDL_GetGammaRamp" IO (Maybe ([Word16], [Word16], [Word16]))
tryGetGammaRamp

-- int SDL_SetGammaRamp(Uint16 *redtable, Uint16 *greentable, Uint16 *bluetable);
foreign import ccall unsafe "SDL_SetGammaRamp" sdlSetGammaRamp :: Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> IO CInt
trySetGammaRamp :: [Word16] -> [Word16] -> [Word16] -> IO Bool
trySetGammaRamp :: [Word16] -> [Word16] -> [Word16] -> IO Bool
trySetGammaRamp [Word16]
red [Word16]
green [Word16]
blue
    = [Word16] -> (Int -> Ptr Word16 -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Word16]
red ((Int -> Ptr Word16 -> IO Bool) -> IO Bool)
-> (Int -> Ptr Word16 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Ptr Word16 -> IO Bool) -> Int -> Ptr Word16 -> IO Bool
forall {a} {m :: * -> *} {t}.
(Eq a, Num a, Monad m) =>
(t -> m Bool) -> a -> t -> m Bool
check ((Ptr Word16 -> IO Bool) -> Int -> Ptr Word16 -> IO Bool)
-> (Ptr Word16 -> IO Bool) -> Int -> Ptr Word16 -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
ptrRed ->
      [Word16] -> (Int -> Ptr Word16 -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Word16]
green ((Int -> Ptr Word16 -> IO Bool) -> IO Bool)
-> (Int -> Ptr Word16 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Ptr Word16 -> IO Bool) -> Int -> Ptr Word16 -> IO Bool
forall {a} {m :: * -> *} {t}.
(Eq a, Num a, Monad m) =>
(t -> m Bool) -> a -> t -> m Bool
check ((Ptr Word16 -> IO Bool) -> Int -> Ptr Word16 -> IO Bool)
-> (Ptr Word16 -> IO Bool) -> Int -> Ptr Word16 -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
ptrGreen ->
      [Word16] -> (Int -> Ptr Word16 -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Word16]
blue ((Int -> Ptr Word16 -> IO Bool) -> IO Bool)
-> (Int -> Ptr Word16 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Ptr Word16 -> IO Bool) -> Int -> Ptr Word16 -> IO Bool
forall {a} {m :: * -> *} {t}.
(Eq a, Num a, Monad m) =>
(t -> m Bool) -> a -> t -> m Bool
check ((Ptr Word16 -> IO Bool) -> Int -> Ptr Word16 -> IO Bool)
-> (Ptr Word16 -> IO Bool) -> Int -> Ptr Word16 -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
ptrBlue ->
      Int -> IO Int -> IO Bool
intToBool (-Int
1) ((CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a. Num a => CInt -> a
fromCInt (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> IO CInt
sdlSetGammaRamp Ptr Word16
ptrRed Ptr Word16
ptrGreen Ptr Word16
ptrBlue)
    where check :: (t -> m Bool) -> a -> t -> m Bool
check t -> m Bool
action a
256 t
ptr = t -> m Bool
action t
ptr
          check t -> m Bool
_ a
_ t
_ = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

setGammaRamp :: [Word16] -> [Word16] -> [Word16] -> IO ()
setGammaRamp :: [Word16] -> [Word16] -> [Word16] -> IO ()
setGammaRamp [Word16]
red [Word16]
green [Word16]
blue = String -> IO Bool -> IO ()
unwrapBool String
"setGammaRamp_" ([Word16] -> [Word16] -> [Word16] -> IO Bool
trySetGammaRamp [Word16]
red [Word16]
green [Word16]
blue)

-- Uint32 SDL_MapRGB(SDL_PixelFormat *fmt, Uint8 r, Uint8 g, Uint8 b);
foreign import ccall unsafe "SDL_MapRGB" sdlMapRGB :: Ptr PixelFormatStruct -> Word8 -> Word8 -> Word8 -> IO Word32

-- | Map a RGB color value to a pixel format.
mapRGB :: PixelFormat
       -> Word8 -- ^ Red value.
       -> Word8 -- ^ Green value.
       -> Word8 -- ^ Blue value.
       -> IO Pixel
mapRGB :: PixelFormat -> Word8 -> Word8 -> Word8 -> IO Pixel
mapRGB PixelFormat
format Word8
r Word8
g Word8
b
    = PixelFormat -> (Ptr PixelFormatStruct -> IO Pixel) -> IO Pixel
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr PixelFormat
format ((Ptr PixelFormatStruct -> IO Pixel) -> IO Pixel)
-> (Ptr PixelFormatStruct -> IO Pixel) -> IO Pixel
forall a b. (a -> b) -> a -> b
$ \Ptr PixelFormatStruct
ptr ->
      (Word32 -> Pixel) -> IO Word32 -> IO Pixel
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Pixel
Pixel (Ptr PixelFormatStruct -> Word8 -> Word8 -> Word8 -> IO Word32
sdlMapRGB Ptr PixelFormatStruct
ptr Word8
r Word8
g Word8
b)

-- Uint32 SDL_MapRGBA(SDL_PixelFormat *fmt, Uint8 r, Uint8 g, Uint8 b, Uint8 a);

foreign import ccall unsafe "SDL_MapRGBA" sdlMapRGBA
    :: Ptr PixelFormatStruct -> Word8 -> Word8 -> Word8 -> Word8 -> IO Word32

-- | Map a RGBA color value to a pixel format.
mapRGBA :: PixelFormat
        -> Word8 -- ^ Red value.
        -> Word8 -- ^ Green value.
        -> Word8 -- ^ Blue value.
        -> Word8 -- ^ Alpha value.
        -> IO Pixel
mapRGBA :: PixelFormat -> Word8 -> Word8 -> Word8 -> Word8 -> IO Pixel
mapRGBA PixelFormat
format Word8
r Word8
g Word8
b Word8
a
    = PixelFormat -> (Ptr PixelFormatStruct -> IO Pixel) -> IO Pixel
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr PixelFormat
format ((Ptr PixelFormatStruct -> IO Pixel) -> IO Pixel)
-> (Ptr PixelFormatStruct -> IO Pixel) -> IO Pixel
forall a b. (a -> b) -> a -> b
$ \Ptr PixelFormatStruct
ptr ->
      (Word32 -> Pixel) -> IO Word32 -> IO Pixel
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Pixel
Pixel (Ptr PixelFormatStruct
-> Word8 -> Word8 -> Word8 -> Word8 -> IO Word32
sdlMapRGBA Ptr PixelFormatStruct
ptr Word8
r Word8
g Word8
b Word8
a)

-- void SDL_GetRGB(Uint32 pixel, SDL_PixelFormat *fmt, Uint8 *r, Uint8 *g, Uint8 *b);
foreign import ccall unsafe "SDL_GetRGB" sdlGetRGB
    :: Word32 -> Ptr PixelFormatStruct -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()

-- | Get RGB values from a pixel in the specified pixel format.
getRGB :: Pixel -> PixelFormat -> IO (Word8,Word8,Word8)
getRGB :: Pixel -> PixelFormat -> IO (Word8, Word8, Word8)
getRGB (Pixel Word32
p) PixelFormat
format
    = (Ptr Word8 -> IO (Word8, Word8, Word8)) -> IO (Word8, Word8, Word8)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word8 -> IO (Word8, Word8, Word8))
 -> IO (Word8, Word8, Word8))
-> (Ptr Word8 -> IO (Word8, Word8, Word8))
-> IO (Word8, Word8, Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
red ->
      (Ptr Word8 -> IO (Word8, Word8, Word8)) -> IO (Word8, Word8, Word8)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word8 -> IO (Word8, Word8, Word8))
 -> IO (Word8, Word8, Word8))
-> (Ptr Word8 -> IO (Word8, Word8, Word8))
-> IO (Word8, Word8, Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
green ->
      (Ptr Word8 -> IO (Word8, Word8, Word8)) -> IO (Word8, Word8, Word8)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word8 -> IO (Word8, Word8, Word8))
 -> IO (Word8, Word8, Word8))
-> (Ptr Word8 -> IO (Word8, Word8, Word8))
-> IO (Word8, Word8, Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
blue ->
      PixelFormat
-> (Ptr PixelFormatStruct -> IO (Word8, Word8, Word8))
-> IO (Word8, Word8, Word8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr PixelFormat
format ((Ptr PixelFormatStruct -> IO (Word8, Word8, Word8))
 -> IO (Word8, Word8, Word8))
-> (Ptr PixelFormatStruct -> IO (Word8, Word8, Word8))
-> IO (Word8, Word8, Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr PixelFormatStruct
ptr ->
      do Word32
-> Ptr PixelFormatStruct
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> IO ()
sdlGetRGB Word32
p Ptr PixelFormatStruct
ptr Ptr Word8
red Ptr Word8
green Ptr Word8
blue
         [Word8
r,Word8
g,Word8
b] <- (Ptr Word8 -> IO Word8) -> [Ptr Word8] -> IO [Word8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek [Ptr Word8
red,Ptr Word8
green,Ptr Word8
blue]
         (Word8, Word8, Word8) -> IO (Word8, Word8, Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
r,Word8
g,Word8
b)

-- void SDL_GetRGBA(Uint32 pixel, SDL_PixelFormat *fmt, Uint8 *r, Uint8 *g, Uint8 *b, Uint8 *a);
foreign import ccall unsafe "SDL_GetRGBA" sdlGetRGBA
    :: Word32 -> Ptr PixelFormatStruct -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()

-- | Gets RGBA values from a pixel in the specified pixel format.
getRGBA :: Pixel -> PixelFormat -> IO (Word8,Word8,Word8,Word8)
getRGBA :: Pixel -> PixelFormat -> IO (Word8, Word8, Word8, Word8)
getRGBA (Pixel Word32
p) PixelFormat
format
    = (Ptr Word8 -> IO (Word8, Word8, Word8, Word8))
-> IO (Word8, Word8, Word8, Word8)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word8 -> IO (Word8, Word8, Word8, Word8))
 -> IO (Word8, Word8, Word8, Word8))
-> (Ptr Word8 -> IO (Word8, Word8, Word8, Word8))
-> IO (Word8, Word8, Word8, Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
red ->
      (Ptr Word8 -> IO (Word8, Word8, Word8, Word8))
-> IO (Word8, Word8, Word8, Word8)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word8 -> IO (Word8, Word8, Word8, Word8))
 -> IO (Word8, Word8, Word8, Word8))
-> (Ptr Word8 -> IO (Word8, Word8, Word8, Word8))
-> IO (Word8, Word8, Word8, Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
green ->
      (Ptr Word8 -> IO (Word8, Word8, Word8, Word8))
-> IO (Word8, Word8, Word8, Word8)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word8 -> IO (Word8, Word8, Word8, Word8))
 -> IO (Word8, Word8, Word8, Word8))
-> (Ptr Word8 -> IO (Word8, Word8, Word8, Word8))
-> IO (Word8, Word8, Word8, Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
blue ->
      (Ptr Word8 -> IO (Word8, Word8, Word8, Word8))
-> IO (Word8, Word8, Word8, Word8)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word8 -> IO (Word8, Word8, Word8, Word8))
 -> IO (Word8, Word8, Word8, Word8))
-> (Ptr Word8 -> IO (Word8, Word8, Word8, Word8))
-> IO (Word8, Word8, Word8, Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
alpha -> 
      PixelFormat
-> (Ptr PixelFormatStruct -> IO (Word8, Word8, Word8, Word8))
-> IO (Word8, Word8, Word8, Word8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr PixelFormat
format ((Ptr PixelFormatStruct -> IO (Word8, Word8, Word8, Word8))
 -> IO (Word8, Word8, Word8, Word8))
-> (Ptr PixelFormatStruct -> IO (Word8, Word8, Word8, Word8))
-> IO (Word8, Word8, Word8, Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr PixelFormatStruct
ptr ->
      do Word32
-> Ptr PixelFormatStruct
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> IO ()
sdlGetRGBA Word32
p Ptr PixelFormatStruct
ptr Ptr Word8
red Ptr Word8
green Ptr Word8
blue Ptr Word8
alpha
         [Word8
r,Word8
g,Word8
b,Word8
a] <- (Ptr Word8 -> IO Word8) -> [Ptr Word8] -> IO [Word8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek [Ptr Word8
red,Ptr Word8
green,Ptr Word8
blue,Ptr Word8
alpha]
         (Word8, Word8, Word8, Word8) -> IO (Word8, Word8, Word8, Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
r,Word8
g,Word8
b,Word8
a)

-- SDL_Surface *SDL_CreateRGBSurface(Uint32 flags, int width, int height, int depth, Uint32 Rmask, Uint32 Gmask, Uint32 Bmask, Uint32 Amask);
foreign import ccall unsafe "SDL_CreateRGBSurface" sdlCreateRGBSurface
    :: Word32 -> CInt -> CInt -> CInt -> Word32 -> Word32 -> Word32 -> Word32 -> IO (Ptr SurfaceStruct)

-- | Creates an empty @Surface@. Returns @Nothing@ on error.
tryCreateRGBSurface :: [SurfaceFlag] -> Int -> Int -> Int
                  -> Word32 -> Word32 -> Word32 -> Word32 -> IO (Maybe Surface)
tryCreateRGBSurface :: [SurfaceFlag]
-> Int
-> Int
-> Int
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Maybe Surface)
tryCreateRGBSurface [SurfaceFlag]
flags Int
width Int
height Int
bpp Word32
rmask Word32
gmask Word32
bmask Word32
amask
    = Word32
-> CInt
-> CInt
-> CInt
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Ptr SurfaceStruct)
sdlCreateRGBSurface ([SurfaceFlag] -> Word32
forall a b. (Enum a b, Bits b, Num b) => [a] -> b
toBitmask [SurfaceFlag]
flags) (Int -> CInt
toCInt Int
width) (Int -> CInt
toCInt Int
height) (Int -> CInt
toCInt Int
bpp) Word32
rmask Word32
gmask Word32
bmask Word32
amask IO (Ptr SurfaceStruct)
-> (Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      (Ptr SurfaceStruct -> IO Surface)
-> Ptr SurfaceStruct -> IO (Maybe Surface)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr SurfaceStruct -> IO Surface
mkFinalizedSurface

-- | Creates an empty @Surface@. Throws an exception on error.
createRGBSurface :: [SurfaceFlag] -> Int -> Int -> Int
                 -> Word32 -> Word32 -> Word32 -> Word32 -> IO Surface
createRGBSurface :: [SurfaceFlag]
-> Int
-> Int
-> Int
-> Word32
-> Word32
-> Word32
-> Word32
-> IO Surface
createRGBSurface [SurfaceFlag]
flags Int
width Int
height Int
bpp Word32
rmask Word32
gmask Word32
bmask Word32
amask
    = String -> IO (Maybe Surface) -> IO Surface
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"SDL_CreateRGBSurface" ([SurfaceFlag]
-> Int
-> Int
-> Int
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Maybe Surface)
tryCreateRGBSurface [SurfaceFlag]
flags Int
width Int
height Int
bpp Word32
rmask Word32
gmask Word32
bmask Word32
amask)

-- | Creates an empty @Surface@ with (r\/g\/b\/a)mask determined from the local endian.
--   Returns @Nothing@ on error.
tryCreateRGBSurfaceEndian :: [SurfaceFlag] -> Int -> Int -> Int -> IO (Maybe Surface)
tryCreateRGBSurfaceEndian :: [SurfaceFlag] -> Int -> Int -> Int -> IO (Maybe Surface)
tryCreateRGBSurfaceEndian [SurfaceFlag]
flags Int
width Int
height Int
bpp
    = [SurfaceFlag]
-> Int
-> Int
-> Int
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Maybe Surface)
tryCreateRGBSurface [SurfaceFlag]
flags Int
width Int
height Int
bpp

{-# LINE 412 "Graphics/UI/SDL/Video.hsc" #-}
        Word32
0x000000FF Word32
0x0000FF00 Word32
0x00FF0000 Word32
0xFF000000

{-# LINE 416 "Graphics/UI/SDL/Video.hsc" #-}

-- | Creates an empty @Surface@ with (r\/g\/b\/a)mask determined from the local endian.
--   Throws an exception on error.
createRGBSurfaceEndian :: [SurfaceFlag] -> Int -> Int -> Int -> IO Surface
createRGBSurfaceEndian :: [SurfaceFlag] -> Int -> Int -> Int -> IO Surface
createRGBSurfaceEndian [SurfaceFlag]
flags Int
width Int
height Int
bpp
    = String -> IO (Maybe Surface) -> IO Surface
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"SDL_CreateRGBSurface" ([SurfaceFlag] -> Int -> Int -> Int -> IO (Maybe Surface)
tryCreateRGBSurfaceEndian [SurfaceFlag]
flags Int
width Int
height Int
bpp)

-- SDL_Surface *SDL_CreateRGBSurfaceFrom(void *pixels, int width, int height, int depth, int pitch, Uint32 Rmask, Uint32 Gmask, Uint32 Bmask, Uint32 Amask);
foreign import ccall unsafe "SDL_CreateRGBSurfaceFrom" sdlCreateRGBSurfaceFrom
    :: Ptr Word8 -> CInt -> CInt -> CInt -> CInt -> Word32 -> Word32 -> Word32 -> Word32 -> IO (Ptr SurfaceStruct)
tryCreateRGBSurfaceFrom :: Ptr a -> Int -> Int -> Int -> Int
                        -> Word32 -> Word32 -> Word32 -> Word32 -> IO (Maybe Surface)
tryCreateRGBSurfaceFrom :: forall a.
Ptr a
-> Int
-> Int
-> Int
-> Int
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Maybe Surface)
tryCreateRGBSurfaceFrom Ptr a
pixels Int
width Int
height Int
depth Int
pitch Word32
rmask Word32
gmask Word32
bmask Word32
amask
    = Ptr Word8
-> CInt
-> CInt
-> CInt
-> CInt
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Ptr SurfaceStruct)
sdlCreateRGBSurfaceFrom (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
pixels) (Int -> CInt
toCInt Int
width) (Int -> CInt
toCInt Int
height) (Int -> CInt
toCInt Int
depth) (Int -> CInt
toCInt Int
pitch) Word32
rmask Word32
gmask Word32
bmask Word32
amask IO (Ptr SurfaceStruct)
-> (Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      (Ptr SurfaceStruct -> IO Surface)
-> Ptr SurfaceStruct -> IO (Maybe Surface)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr SurfaceStruct -> IO Surface
mkFinalizedSurface

createRGBSurfaceFrom :: Ptr a -> Int -> Int -> Int -> Int
                     -> Word32 -> Word32 -> Word32 -> Word32 -> IO Surface
createRGBSurfaceFrom :: forall a.
Ptr a
-> Int
-> Int
-> Int
-> Int
-> Word32
-> Word32
-> Word32
-> Word32
-> IO Surface
createRGBSurfaceFrom Ptr a
pixels Int
width Int
height Int
depth Int
pitch Word32
rmask Word32
gmask Word32
bmask Word32
amask
    = String -> IO (Maybe Surface) -> IO Surface
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"SDL_CreateRGBSurfaceFrom"
                  (Ptr a
-> Int
-> Int
-> Int
-> Int
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Maybe Surface)
forall a.
Ptr a
-> Int
-> Int
-> Int
-> Int
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Maybe Surface)
tryCreateRGBSurfaceFrom Ptr a
pixels Int
width Int
height Int
depth Int
pitch Word32
rmask Word32
gmask Word32
bmask Word32
amask)

{-
-- void SDL_FreeSurface(SDL_Surface *surface);
foreign import ccall unsafe "SDL_FreeSurface" sdlFreeSurface :: Ptr SurfaceStruct -> IO ()
-- | Frees (deletes) a @Surface@. Don\'t use it unless you really know what you're doing. All surfaces
--   are automatically deleted when they're out of scope or forced with @finalizeForeignPtr@.
freeSurface :: Surface -> IO ()
freeSurface surface
    = withForeignPtr surface sdlFreeSurface
-}

-- | Forces the finalization of a @Surface@. Only supported with GHC.
freeSurface :: Surface -> IO ()
freeSurface :: Surface -> IO ()
freeSurface =

{-# LINE 452 "Graphics/UI/SDL/Video.hsc" #-}
  finalizeForeignPtr

{-# LINE 456 "Graphics/UI/SDL/Video.hsc" #-}

-- int SDL_LockSurface(SDL_Surface *surface);
foreign import ccall unsafe "SDL_LockSurface" sdlLockSurface :: Ptr SurfaceStruct -> IO CInt

-- | Locks a surface for direct access.
lockSurface :: Surface -> IO Bool
lockSurface :: Surface -> IO Bool
lockSurface Surface
surface
    = Surface -> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface ((Ptr SurfaceStruct -> IO Bool) -> IO Bool)
-> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
ptr ->
      Int -> IO Int -> IO Bool
intToBool (-Int
1) ((CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a. Num a => CInt -> a
fromCInt (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr SurfaceStruct -> IO CInt
sdlLockSurface Ptr SurfaceStruct
ptr)

-- void SDL_UnlockSurface(SDL_Surface *surface);
foreign import ccall unsafe "SDL_UnlockSurface" sdlUnlockSurface :: Ptr SurfaceStruct -> IO ()

-- | Unlocks a previously locked surface.
unlockSurface :: Surface -> IO ()
unlockSurface :: Surface -> IO ()
unlockSurface Surface
surface = Surface -> (Ptr SurfaceStruct -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface Ptr SurfaceStruct -> IO ()
sdlUnlockSurface

-- extern DECLSPEC SDL_Surface * SDLCALL SDL_LoadBMP_RW(SDL_RWops *src, int freesrc);
-- define SDL_LoadBMP(file)       SDL_LoadBMP_RW(SDL_RWFromFile(file, "rb"), 1)
foreign import ccall unsafe "SDL_LoadBMP_RW" sdlLoadBMP_RW :: Ptr RWopsStruct -> CInt -> IO (Ptr SurfaceStruct)

tryLoadBMPRW :: RWops -> Bool -> IO (Maybe Surface)
tryLoadBMPRW :: RWops -> Bool -> IO (Maybe Surface)
tryLoadBMPRW RWops
rw Bool
freesrc
    = RWops
-> (Ptr RWopsStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RWops
rw ((Ptr RWopsStruct -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr RWopsStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr RWopsStruct
rwPtr ->
      Ptr RWopsStruct -> CInt -> IO (Ptr SurfaceStruct)
sdlLoadBMP_RW Ptr RWopsStruct
rwPtr (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
freesrc) IO (Ptr SurfaceStruct)
-> (Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr SurfaceStruct -> IO Surface)
-> Ptr SurfaceStruct -> IO (Maybe Surface)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr SurfaceStruct -> IO Surface
mkFinalizedSurface

loadBMPRW :: RWops -> Bool -> IO Surface
loadBMPRW :: RWops -> Bool -> IO Surface
loadBMPRW RWops
rw Bool
freesrc = String -> IO (Maybe Surface) -> IO Surface
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"SDL_LoadBMP_RW" (RWops -> Bool -> IO (Maybe Surface)
tryLoadBMPRW RWops
rw Bool
freesrc)

loadBMP :: FilePath -> IO Surface
loadBMP :: String -> IO Surface
loadBMP String
filepath
    = String -> String -> (RWops -> IO Surface) -> IO Surface
forall a. String -> String -> (RWops -> IO a) -> IO a
RW.with String
filepath String
"rb" ((RWops -> IO Surface) -> IO Surface)
-> (RWops -> IO Surface) -> IO Surface
forall a b. (a -> b) -> a -> b
$ \RWops
rw ->
      RWops -> Bool -> IO Surface
loadBMPRW RWops
rw Bool
False

-- extern DECLSPEC int SDLCALL SDL_SaveBMP_RW
--                (SDL_Surface *surface, SDL_RWops *dst, int freedst);
foreign import ccall unsafe "SDL_SaveBMP_RW" sdlSaveBMP_RW :: Ptr SurfaceStruct -> Ptr RWopsStruct -> CInt -> IO CInt

saveBMPRW :: Surface -> RWops -> Bool -> IO Bool
saveBMPRW :: Surface -> RWops -> Bool -> IO Bool
saveBMPRW Surface
surface RWops
rw Bool
freedst
    = Surface -> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface ((Ptr SurfaceStruct -> IO Bool) -> IO Bool)
-> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
ptr ->
      RWops -> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RWops
rw ((Ptr RWopsStruct -> IO Bool) -> IO Bool)
-> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr RWopsStruct
rwPtr ->
      Int -> IO Int -> IO Bool
intToBool (-Int
1) ((CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a. Num a => CInt -> a
fromCInt (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr SurfaceStruct -> Ptr RWopsStruct -> CInt -> IO CInt
sdlSaveBMP_RW Ptr SurfaceStruct
ptr Ptr RWopsStruct
rwPtr (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
freedst))

saveBMP :: Surface -> FilePath -> IO Bool
saveBMP :: Surface -> String -> IO Bool
saveBMP Surface
surface String
filepath
    = String -> String -> (RWops -> IO Bool) -> IO Bool
forall a. String -> String -> (RWops -> IO a) -> IO a
RW.with String
filepath String
"wb" ((RWops -> IO Bool) -> IO Bool) -> (RWops -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \RWops
rw ->
      Surface -> RWops -> Bool -> IO Bool
saveBMPRW Surface
surface RWops
rw Bool
False


-- int SDL_SetColorKey(SDL_Surface *surface, Uint32 flag, Uint32 key);
foreign import ccall unsafe "SDL_SetColorKey" sdlSetColorKey :: Ptr SurfaceStruct -> Word32 -> Word32 -> IO CInt
setColorKey :: Surface -> [SurfaceFlag] -> Pixel -> IO Bool
setColorKey :: Surface -> [SurfaceFlag] -> Pixel -> IO Bool
setColorKey Surface
surface [SurfaceFlag]
flags (Pixel Word32
w)
    = Surface -> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface ((Ptr SurfaceStruct -> IO Bool) -> IO Bool)
-> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
ptr ->
      Int -> IO Int -> IO Bool
intToBool (-Int
1) ((CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a. Num a => CInt -> a
fromCInt (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr SurfaceStruct -> Word32 -> Word32 -> IO CInt
sdlSetColorKey Ptr SurfaceStruct
ptr ([SurfaceFlag] -> Word32
forall a b. (Enum a b, Bits b, Num b) => [a] -> b
toBitmask [SurfaceFlag]
flags) Word32
w)

-- int SDL_SetAlpha(SDL_Surface *surface, Uint32 flag, Uint8 alpha);
foreign import ccall unsafe "SDL_SetAlpha" sdlSetAlpha :: Ptr SurfaceStruct -> Word32 -> Word8 -> IO CInt

-- | Adjusts the alpha properties of a surface.
setAlpha :: Surface -> [SurfaceFlag] -> Word8 -> IO Bool
setAlpha :: Surface -> [SurfaceFlag] -> Word8 -> IO Bool
setAlpha Surface
surface [SurfaceFlag]
flags Word8
alpha
    = Surface -> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface ((Ptr SurfaceStruct -> IO Bool) -> IO Bool)
-> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
ptr ->
      Int -> IO Int -> IO Bool
intToBool (-Int
1) ((CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a. Num a => CInt -> a
fromCInt (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr SurfaceStruct -> Word32 -> Word8 -> IO CInt
sdlSetAlpha Ptr SurfaceStruct
ptr ([SurfaceFlag] -> Word32
forall a b. (Enum a b, Bits b, Num b) => [a] -> b
toBitmask [SurfaceFlag]
flags) Word8
alpha)

-- void SDL_SetClipRect(SDL_Surface *surface, SDL_Rect *rect);
foreign import ccall unsafe "SDL_SetClipRect" sdlSetClipRect :: Ptr SurfaceStruct -> Ptr Rect -> IO ()

-- | Sets the clipping rectangle for a surface.
setClipRect :: Surface -> Maybe Rect -> IO ()
setClipRect :: Surface -> Maybe Rect -> IO ()
setClipRect Surface
surface Maybe Rect
mbRect
    = Surface -> (Ptr SurfaceStruct -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface ((Ptr SurfaceStruct -> IO ()) -> IO ())
-> (Ptr SurfaceStruct -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
ptr ->
      (Rect -> (Ptr Rect -> IO ()) -> IO ())
-> Maybe Rect -> (Ptr Rect -> IO ()) -> IO ()
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith Rect -> (Ptr Rect -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Maybe Rect
mbRect ((Ptr Rect -> IO ()) -> IO ()) -> (Ptr Rect -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Rect
rect ->
      Ptr SurfaceStruct -> Ptr Rect -> IO ()
sdlSetClipRect Ptr SurfaceStruct
ptr Ptr Rect
rect

-- void SDL_GetClipRect(SDL_Surface *surface, SDL_Rect *rect);
foreign import ccall unsafe "SDL_GetClipRect" sdlGetClipRect :: Ptr SurfaceStruct -> Ptr Rect -> IO ()

-- | Gets the clipping rectangle for a surface.
getClipRect :: Surface -> IO Rect
getClipRect :: Surface -> IO Rect
getClipRect Surface
surface
    = Surface -> (Ptr SurfaceStruct -> IO Rect) -> IO Rect
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface ((Ptr SurfaceStruct -> IO Rect) -> IO Rect)
-> (Ptr SurfaceStruct -> IO Rect) -> IO Rect
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
ptr ->
      (Ptr Rect -> IO Rect) -> IO Rect
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Rect -> IO Rect) -> IO Rect)
-> (Ptr Rect -> IO Rect) -> IO Rect
forall a b. (a -> b) -> a -> b
$ \Ptr Rect
rectPtr ->
      do Ptr SurfaceStruct -> Ptr Rect -> IO ()
sdlGetClipRect Ptr SurfaceStruct
ptr Ptr Rect
rectPtr
         Ptr Rect -> IO Rect
forall a. Storable a => Ptr a -> IO a
peek Ptr Rect
rectPtr

-- | Run an action with a given clipping rect applied.
--   If an exception is raised, then withClipRect will re-raise the exception (after resetting the original clipping rect).
withClipRect :: Surface -> Maybe Rect -> IO a -> IO a
withClipRect :: forall a. Surface -> Maybe Rect -> IO a -> IO a
withClipRect Surface
surface Maybe Rect
rect IO a
action
    = IO Rect -> (Rect -> IO ()) -> (Rect -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Surface -> IO Rect
getClipRect Surface
surface) -- Get the current cliprect
              (Surface -> Maybe Rect -> IO ()
setClipRect Surface
surface (Maybe Rect -> IO ()) -> (Rect -> Maybe Rect) -> Rect -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> Maybe Rect
forall a. a -> Maybe a
Just) -- Reset to old cliprect when done.
              (IO a -> Rect -> IO a
forall a b. a -> b -> a
const (Surface -> Maybe Rect -> IO ()
setClipRect Surface
surface Maybe Rect
rect IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
action)) -- Set new cliprect.

-- SDL_Surface *SDL_ConvertSurface(SDL_Surface *src, SDL_PixelFormat *fmt, Uint32 flags);
foreign import ccall unsafe "SDL_ConvertSurface" sdlConvertSurface
    :: Ptr SurfaceStruct -> Ptr PixelFormatStruct -> Word32 -> IO (Ptr SurfaceStruct)

-- | Converts a surface to the same format as another surface. Returns @Nothing@ on error.
tryConvertSurface :: Surface -> PixelFormat -> [SurfaceFlag] -> IO (Maybe Surface)
tryConvertSurface :: Surface -> PixelFormat -> [SurfaceFlag] -> IO (Maybe Surface)
tryConvertSurface Surface
surface PixelFormat
format [SurfaceFlag]
flags
    = Surface
-> (Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface ((Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
ptr ->
      PixelFormat
-> (Ptr PixelFormatStruct -> IO (Maybe Surface))
-> IO (Maybe Surface)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr PixelFormat
format ((Ptr PixelFormatStruct -> IO (Maybe Surface))
 -> IO (Maybe Surface))
-> (Ptr PixelFormatStruct -> IO (Maybe Surface))
-> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr PixelFormatStruct
formatPtr ->
      Ptr SurfaceStruct
-> Ptr PixelFormatStruct -> Word32 -> IO (Ptr SurfaceStruct)
sdlConvertSurface Ptr SurfaceStruct
ptr Ptr PixelFormatStruct
formatPtr ([SurfaceFlag] -> Word32
forall a b. (Enum a b, Bits b, Num b) => [a] -> b
toBitmask [SurfaceFlag]
flags) IO (Ptr SurfaceStruct)
-> (Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr SurfaceStruct -> IO Surface)
-> Ptr SurfaceStruct -> IO (Maybe Surface)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr SurfaceStruct -> IO Surface
mkFinalizedSurface

-- | Converts a surface to the same format as another surface. Throws an exception on error.
convertSurface :: Surface -> PixelFormat -> [SurfaceFlag] -> IO Surface
convertSurface :: Surface -> PixelFormat -> [SurfaceFlag] -> IO Surface
convertSurface Surface
surface PixelFormat
format [SurfaceFlag]
flags
    = String -> IO (Maybe Surface) -> IO Surface
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"SDL_ConvertSurface"
                  (Surface -> PixelFormat -> [SurfaceFlag] -> IO (Maybe Surface)
tryConvertSurface Surface
surface PixelFormat
format [SurfaceFlag]
flags)


-- int SDL_UpperBlit(SDL_Surface *src, SDL_Rect *srcrect, SDL_Surface *dst, SDL_Rect *dstrect);
foreign import ccall unsafe "SDL_UpperBlit" sdlBlitSurface
    :: Ptr SurfaceStruct -> Ptr Rect -> Ptr SurfaceStruct -> Ptr Rect -> IO CInt

-- | This function performs a fast blit from the source surface to the destination surface.
blitSurface :: Surface -> Maybe Rect -> Surface -> Maybe Rect -> IO Bool
blitSurface :: Surface -> Maybe Rect -> Surface -> Maybe Rect -> IO Bool
blitSurface Surface
src Maybe Rect
srcRect Surface
dst Maybe Rect
dstRect
    = Surface -> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
src ((Ptr SurfaceStruct -> IO Bool) -> IO Bool)
-> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
srcPtr ->
      Surface -> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
dst ((Ptr SurfaceStruct -> IO Bool) -> IO Bool)
-> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
dstPtr ->
      (Rect -> (Ptr Rect -> IO Bool) -> IO Bool)
-> Maybe Rect -> (Ptr Rect -> IO Bool) -> IO Bool
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith Rect -> (Ptr Rect -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Maybe Rect
srcRect ((Ptr Rect -> IO Bool) -> IO Bool)
-> (Ptr Rect -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Rect
srcRectPtr ->
      (Rect -> (Ptr Rect -> IO Bool) -> IO Bool)
-> Maybe Rect -> (Ptr Rect -> IO Bool) -> IO Bool
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith Rect -> (Ptr Rect -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Maybe Rect
dstRect ((Ptr Rect -> IO Bool) -> IO Bool)
-> (Ptr Rect -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Rect
dstRectPtr ->
      Int -> IO Int -> IO Bool
intToBool (-Int
1) ((CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a. Num a => CInt -> a
fromCInt (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr SurfaceStruct
-> Ptr Rect -> Ptr SurfaceStruct -> Ptr Rect -> IO CInt
sdlBlitSurface Ptr SurfaceStruct
srcPtr Ptr Rect
srcRectPtr Ptr SurfaceStruct
dstPtr Ptr Rect
dstRectPtr)


-- int SDL_FillRect(SDL_Surface *dst, SDL_Rect *dstrect, Uint32 color);
foreign import ccall unsafe "SDL_FillRect" sdlFillRect :: Ptr SurfaceStruct -> Ptr Rect -> Word32 -> IO CInt

-- | This function performs a fast fill of the given rectangle with some color.
fillRect :: Surface -> Maybe Rect -> Pixel -> IO Bool
fillRect :: Surface -> Maybe Rect -> Pixel -> IO Bool
fillRect Surface
surface Maybe Rect
mbRect (Pixel Word32
w)
    = Surface -> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface ((Ptr SurfaceStruct -> IO Bool) -> IO Bool)
-> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
ptr ->
      (Rect -> (Ptr Rect -> IO Bool) -> IO Bool)
-> Maybe Rect -> (Ptr Rect -> IO Bool) -> IO Bool
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith Rect -> (Ptr Rect -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Maybe Rect
mbRect ((Ptr Rect -> IO Bool) -> IO Bool)
-> (Ptr Rect -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Rect
rect ->
      Int -> IO Int -> IO Bool
intToBool (-Int
1) ((CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a. Num a => CInt -> a
fromCInt (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr SurfaceStruct -> Ptr Rect -> Word32 -> IO CInt
sdlFillRect Ptr SurfaceStruct
ptr Ptr Rect
rect Word32
w)

-- SDL_Surface *SDL_DisplayFormat(SDL_Surface *surface);
foreign import ccall unsafe "SDL_DisplayFormat" sdlDisplayFormat :: Ptr SurfaceStruct -> IO (Ptr SurfaceStruct)

-- | Converts a surface to the display format. Returns @Nothing@ on error.
tryDisplayFormat :: Surface -> IO (Maybe Surface)
tryDisplayFormat :: Surface -> IO (Maybe Surface)
tryDisplayFormat Surface
surface
    = Surface
-> (Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface ((Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
ptr ->
      Ptr SurfaceStruct -> IO (Ptr SurfaceStruct)
sdlDisplayFormat Ptr SurfaceStruct
ptr IO (Ptr SurfaceStruct)
-> (Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr SurfaceStruct -> IO Surface)
-> Ptr SurfaceStruct -> IO (Maybe Surface)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr SurfaceStruct -> IO Surface
mkFinalizedSurface

-- | Converts a surface to the display format. Throws an exception on error.
displayFormat :: Surface -> IO Surface
displayFormat :: Surface -> IO Surface
displayFormat = String -> IO (Maybe Surface) -> IO Surface
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"SDL_DisplayFormat" (IO (Maybe Surface) -> IO Surface)
-> (Surface -> IO (Maybe Surface)) -> Surface -> IO Surface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Surface -> IO (Maybe Surface)
tryDisplayFormat

-- SDL_Surface *SDL_DisplayFormatAlpha(SDL_Surface *surface);
foreign import ccall unsafe "SDL_DisplayFormatAlpha" sdlDisplayFormatAlpha :: Ptr SurfaceStruct -> IO (Ptr SurfaceStruct)

-- | Converts a surface to the display format. Returns @Nothing@ on error.
tryDisplayFormatAlpha :: Surface -> IO (Maybe Surface)
tryDisplayFormatAlpha :: Surface -> IO (Maybe Surface)
tryDisplayFormatAlpha Surface
surface
    = Surface
-> (Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface ((Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr SurfaceStruct
ptr ->
      Ptr SurfaceStruct -> IO (Ptr SurfaceStruct)
sdlDisplayFormatAlpha Ptr SurfaceStruct
ptr IO (Ptr SurfaceStruct)
-> (Ptr SurfaceStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr SurfaceStruct -> IO Surface)
-> Ptr SurfaceStruct -> IO (Maybe Surface)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr SurfaceStruct -> IO Surface
mkFinalizedSurface

-- | Converts a surface to the display format. Throws an exception on error.
displayFormatAlpha :: Surface -> IO Surface
displayFormatAlpha :: Surface -> IO Surface
displayFormatAlpha = String -> IO (Maybe Surface) -> IO Surface
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"SDL_DisplayFormatAlpha" (IO (Maybe Surface) -> IO Surface)
-> (Surface -> IO (Maybe Surface)) -> Surface -> IO Surface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Surface -> IO (Maybe Surface)
tryDisplayFormatAlpha

-- void SDL_WarpMouse(Uint16 x, Uint16 y);
foreign import ccall unsafe "SDL_WarpMouse" sdlWarpMouse :: Word16 -> Word16 -> IO ()

-- | Sets the position of the mouse cursor.
warpMouse :: Word16 -- ^ Mouse X position.
          -> Word16 -- ^ Mouse Y position.
          -> IO ()
warpMouse :: Word16 -> Word16 -> IO ()
warpMouse = Word16 -> Word16 -> IO ()
sdlWarpMouse

-- int SDL_ShowCursor(int toggle);
foreign import ccall unsafe "SDL_ShowCursor" sdlShowCursor :: CInt -> IO CInt

-- | Toggle whether or not the cursor is shown on the screen.
showCursor :: Bool -> IO ()
showCursor :: Bool -> IO ()
showCursor Bool
enable
    = CInt -> IO CInt
sdlShowCursor (Toggle -> CInt
forall a. Num a => Toggle -> a
fromToggle Toggle
toggle) IO CInt -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where toggle :: Toggle
toggle = case Bool
enable of
                     Bool
True -> Toggle
Enable
                     Bool
False -> Toggle
Disable

-- | Returns @True@ when the cursor is set to visible. See also 'showCursor'.
queryCursorState :: IO Bool
queryCursorState :: IO Bool
queryCursorState = (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CInt -> IO CInt
sdlShowCursor (Toggle -> CInt
forall a. Num a => Toggle -> a
fromToggle Toggle
Query))


type GLAttr = CInt
type GLValue = CInt

glRedSize, glGreenSize, glBlueSize, glAlphaSize, glBufferSize, glDoubleBuffer :: GLAttr
glDepthSize, glStencilSize, glAccumRedSize, glAccumGreenSize, glAccumBlueSize :: GLAttr
glAccumAlphaSize, glStereo, glMultiSampleBuffers, glMultiSampleSamples :: GLAttr

glRedSize :: CInt
glRedSize = CInt
0
{-# LINE 653 "Graphics/UI/SDL/Video.hsc" #-}
glGreenSize = 1
{-# LINE 654 "Graphics/UI/SDL/Video.hsc" #-}
glBlueSize = 2
{-# LINE 655 "Graphics/UI/SDL/Video.hsc" #-}
glAlphaSize = 3
{-# LINE 656 "Graphics/UI/SDL/Video.hsc" #-}
glBufferSize = 4
{-# LINE 657 "Graphics/UI/SDL/Video.hsc" #-}
glDoubleBuffer = 5
{-# LINE 658 "Graphics/UI/SDL/Video.hsc" #-}
glDepthSize  = 6
{-# LINE 659 "Graphics/UI/SDL/Video.hsc" #-}
glStencilSize = 7
{-# LINE 660 "Graphics/UI/SDL/Video.hsc" #-}
glAccumRedSize = 8
{-# LINE 661 "Graphics/UI/SDL/Video.hsc" #-}
glAccumGreenSize = 9
{-# LINE 662 "Graphics/UI/SDL/Video.hsc" #-}
glAccumBlueSize = 10
{-# LINE 663 "Graphics/UI/SDL/Video.hsc" #-}
glAccumAlphaSize = 11
glStereo :: CInt
{-# LINE 664 "Graphics/UI/SDL/Video.hsc" #-}
glStereo = 12
{-# LINE 665 "Graphics/UI/SDL/Video.hsc" #-}
glMultiSampleBuffers = 13
{-# LINE 666 "Graphics/UI/SDL/Video.hsc" #-}
glMultiSampleSamples = 14
{-# LINE 667 "Graphics/UI/SDL/Video.hsc" #-}

--int SDL_GL_SetAttribute(SDL_GLattr attr, int value);
foreign import ccall unsafe "SDL_GL_SetAttribute" sdlGLSetAttribute :: CInt -> CInt -> IO CInt
-- | Sets a special SDL\/OpenGL attribute. Returns @False@ on error.
tryGLSetAttribute :: GLAttr -> GLValue -> IO Bool
tryGLSetAttribute :: CInt -> CInt -> IO Bool
tryGLSetAttribute CInt
attr CInt
value = (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
==CInt
0) (CInt -> CInt -> IO CInt
sdlGLSetAttribute CInt
attr CInt
value)

-- | Sets a special SDL\/OpenGL attribute. Throws an exception on error.
glSetAttribute :: GLAttr -> GLValue -> IO ()
glSetAttribute :: CInt -> CInt -> IO ()
glSetAttribute CInt
attr CInt
value = String -> IO Bool -> IO ()
unwrapBool String
"SDL_GL_SetAttribute" (CInt -> CInt -> IO Bool
tryGLSetAttribute CInt
attr CInt
value)

-- int SDL_GL_GetAttribute(SDLGLattr attr, int *value);
foreign import ccall unsafe "SDL_GL_GetAttribute" sdlGLGetAttribute :: CInt -> Ptr CInt -> IO CInt

-- | Gets the value of a special SDL\/OpenGL attribute. Returns @Nothing@ on error.
tryGLGetAttribute :: GLAttr -> IO (Maybe GLValue)
tryGLGetAttribute :: CInt -> IO (Maybe CInt)
tryGLGetAttribute CInt
attr
    = (Ptr CInt -> IO (Maybe CInt)) -> IO (Maybe CInt)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe CInt)) -> IO (Maybe CInt))
-> (Ptr CInt -> IO (Maybe CInt)) -> IO (Maybe CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
valuePtr ->
      do CInt
ret <- CInt -> Ptr CInt -> IO CInt
sdlGLGetAttribute CInt
attr Ptr CInt
valuePtr
         case CInt
ret of
           CInt
0 -> (CInt -> Maybe CInt) -> IO CInt -> IO (Maybe CInt)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Maybe CInt
forall a. a -> Maybe a
Just (Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
valuePtr)
           CInt
_ -> Maybe CInt -> IO (Maybe CInt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CInt
forall a. Maybe a
Nothing

-- | Gets the value of a special SDL\/OpenGL attribute. Throws an exception on error.
glGetAttribute :: GLAttr -> IO GLValue
glGetAttribute :: CInt -> IO CInt
glGetAttribute = String -> IO (Maybe CInt) -> IO CInt
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"SDL_GL_GetAttribute" (IO (Maybe CInt) -> IO CInt)
-> (CInt -> IO (Maybe CInt)) -> CInt -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> IO (Maybe CInt)
tryGLGetAttribute

--void SDLCALL SDL_GL_SwapBuffers(void);
-- | Swaps OpenGL framebuffers\/Update Display.
foreign import ccall unsafe "SDL_GL_SwapBuffers" glSwapBuffers :: IO ()

foreign import ccall unsafe "&SDL_FreeSurface" sdlFreeSurfaceFinal :: FunPtr (Ptr SurfaceStruct -> IO ())

mkFinalizedSurface :: Ptr SurfaceStruct -> IO Surface
mkFinalizedSurface :: Ptr SurfaceStruct -> IO Surface
mkFinalizedSurface = FinalizerPtr SurfaceStruct -> Ptr SurfaceStruct -> IO Surface
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr SurfaceStruct
sdlFreeSurfaceFinal