{-# LINE 1 "Graphics/UI/SDL/General.hsc" #-}
{-# LINE 5 "Graphics/UI/SDL/General.hsc" #-}
module Graphics.UI.SDL.General
( init
, withInit
, initSubSystem
, quitSubSystem
, quit
, wasInit
, getError
, failWithError
, unwrapBool
, unwrapMaybe
, unwrapInt
, InitFlag(..)
) where
import Foreign.C (peekCString,CString)
import Data.Maybe (fromMaybe)
import Control.Monad (when)
import Data.Word (Word32)
import Control.Exception (bracket_)
import Prelude hiding (init,Enum(..))
import Graphics.UI.SDL.Utilities (Enum(..), toBitmask, fromBitmask)
data InitFlag = InitTimer
| InitAudio
| InitVideo
| InitCDROM
| InitJoystick
| InitNoParachute
| InitEventthread
| InitEverything
deriving (InitFlag -> InitFlag -> Bool
(InitFlag -> InitFlag -> Bool)
-> (InitFlag -> InitFlag -> Bool) -> Eq InitFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitFlag -> InitFlag -> Bool
== :: InitFlag -> InitFlag -> Bool
$c/= :: InitFlag -> InitFlag -> Bool
/= :: InitFlag -> InitFlag -> Bool
Eq, Eq InitFlag
Eq InitFlag
-> (InitFlag -> InitFlag -> Ordering)
-> (InitFlag -> InitFlag -> Bool)
-> (InitFlag -> InitFlag -> Bool)
-> (InitFlag -> InitFlag -> Bool)
-> (InitFlag -> InitFlag -> Bool)
-> (InitFlag -> InitFlag -> InitFlag)
-> (InitFlag -> InitFlag -> InitFlag)
-> Ord InitFlag
InitFlag -> InitFlag -> Bool
InitFlag -> InitFlag -> Ordering
InitFlag -> InitFlag -> InitFlag
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 :: InitFlag -> InitFlag -> Ordering
compare :: InitFlag -> InitFlag -> Ordering
$c< :: InitFlag -> InitFlag -> Bool
< :: InitFlag -> InitFlag -> Bool
$c<= :: InitFlag -> InitFlag -> Bool
<= :: InitFlag -> InitFlag -> Bool
$c> :: InitFlag -> InitFlag -> Bool
> :: InitFlag -> InitFlag -> Bool
$c>= :: InitFlag -> InitFlag -> Bool
>= :: InitFlag -> InitFlag -> Bool
$cmax :: InitFlag -> InitFlag -> InitFlag
max :: InitFlag -> InitFlag -> InitFlag
$cmin :: InitFlag -> InitFlag -> InitFlag
min :: InitFlag -> InitFlag -> InitFlag
Ord, Int -> InitFlag -> ShowS
[InitFlag] -> ShowS
InitFlag -> String
(Int -> InitFlag -> ShowS)
-> (InitFlag -> String) -> ([InitFlag] -> ShowS) -> Show InitFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitFlag -> ShowS
showsPrec :: Int -> InitFlag -> ShowS
$cshow :: InitFlag -> String
show :: InitFlag -> String
$cshowList :: [InitFlag] -> ShowS
showList :: [InitFlag] -> ShowS
Show, ReadPrec [InitFlag]
ReadPrec InitFlag
Int -> ReadS InitFlag
ReadS [InitFlag]
(Int -> ReadS InitFlag)
-> ReadS [InitFlag]
-> ReadPrec InitFlag
-> ReadPrec [InitFlag]
-> Read InitFlag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS InitFlag
readsPrec :: Int -> ReadS InitFlag
$creadList :: ReadS [InitFlag]
readList :: ReadS [InitFlag]
$creadPrec :: ReadPrec InitFlag
readPrec :: ReadPrec InitFlag
$creadListPrec :: ReadPrec [InitFlag]
readListPrec :: ReadPrec [InitFlag]
Read)
instance Bounded InitFlag where
minBound :: InitFlag
minBound = InitFlag
InitTimer
maxBound :: InitFlag
maxBound = InitFlag
InitEventthread
instance Enum InitFlag Word32 where
fromEnum :: InitFlag -> Word32
fromEnum InitFlag
InitTimer = Word32
1
{-# LINE 58 "Graphics/UI/SDL/General.hsc" #-}
fromEnum InitAudio = 16
{-# LINE 59 "Graphics/UI/SDL/General.hsc" #-}
fromEnum InitVideo = 32
{-# LINE 60 "Graphics/UI/SDL/General.hsc" #-}
fromEnum InitCDROM = 256
{-# LINE 61 "Graphics/UI/SDL/General.hsc" #-}
fromEnum InitJoystick = 512
{-# LINE 62 "Graphics/UI/SDL/General.hsc" #-}
fromEnum InitNoParachute = 1048576
{-# LINE 63 "Graphics/UI/SDL/General.hsc" #-}
fromEnum InitEventthread = 16777216
{-# LINE 64 "Graphics/UI/SDL/General.hsc" #-}
fromEnum InitEverything = 65535
{-# LINE 65 "Graphics/UI/SDL/General.hsc" #-}
toEnum 1 = InitTimer
{-# LINE 66 "Graphics/UI/SDL/General.hsc" #-}
toEnum 16 = InitAudio
{-# LINE 67 "Graphics/UI/SDL/General.hsc" #-}
toEnum 32= InitVideo
{-# LINE 68 "Graphics/UI/SDL/General.hsc" #-}
toEnum 256 = InitCDROM
{-# LINE 69 "Graphics/UI/SDL/General.hsc" #-}
toEnum 512 = InitJoystick
{-# LINE 70 "Graphics/UI/SDL/General.hsc" #-}
toEnum 1048576 = InitNoParachute
{-# LINE 71 "Graphics/UI/SDL/General.hsc" #-}
toEnum 16777216 = InitEventthread
{-# LINE 72 "Graphics/UI/SDL/General.hsc" #-}
toEnum 65535 = InitEverything
{-# LINE 73 "Graphics/UI/SDL/General.hsc" #-}
toEnum _ = error "Graphics.UI.SDL.General.toEnum: bad argument"
succ :: InitFlag -> InitFlag
succ InitFlag
InitTimer = InitFlag
InitAudio
succ InitFlag
InitAudio = InitFlag
InitVideo
succ InitFlag
InitVideo = InitFlag
InitCDROM
succ InitFlag
InitCDROM = InitFlag
InitJoystick
succ InitFlag
InitJoystick = InitFlag
InitNoParachute
succ InitFlag
InitNoParachute = InitFlag
InitEventthread
succ InitFlag
InitEventthread = InitFlag
InitEverything
succ InitFlag
_ = String -> InitFlag
forall a. HasCallStack => String -> a
error String
"Graphics.UI.SDL.General.succ: bad argument"
pred :: InitFlag -> InitFlag
pred InitFlag
InitAudio = InitFlag
InitTimer
pred InitFlag
InitVideo = InitFlag
InitAudio
pred InitFlag
InitCDROM = InitFlag
InitVideo
pred InitFlag
InitJoystick = InitFlag
InitCDROM
pred InitFlag
InitNoParachute = InitFlag
InitJoystick
pred InitFlag
InitEventthread = InitFlag
InitNoParachute
pred InitFlag
InitEverything = InitFlag
InitEventthread
pred InitFlag
_ = String -> InitFlag
forall a. HasCallStack => String -> a
error String
"Graphics.UI.SDL.General.pred: bad argument"
enumFromTo :: InitFlag -> InitFlag -> [InitFlag]
enumFromTo InitFlag
x InitFlag
y | InitFlag
x InitFlag -> InitFlag -> Bool
forall a. Ord a => a -> a -> Bool
> InitFlag
y = []
| InitFlag
x InitFlag -> InitFlag -> Bool
forall a. Eq a => a -> a -> Bool
== InitFlag
y = [InitFlag
y]
| Bool
True = InitFlag
x InitFlag -> [InitFlag] -> [InitFlag]
forall a. a -> [a] -> [a]
: InitFlag -> InitFlag -> [InitFlag]
forall a b. Enum a b => a -> a -> [a]
enumFromTo (InitFlag -> InitFlag
forall a b. Enum a b => a -> a
succ InitFlag
x) InitFlag
y
unwrapMaybe :: String -> IO (Maybe a) -> IO a
unwrapMaybe :: forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
errMsg IO (Maybe a)
action
= do Maybe a
val <- IO (Maybe a)
action
case Maybe a
val of
Just a
a -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Maybe a
Nothing -> String -> IO a
forall a. String -> IO a
failWithError String
errMsg
unwrapInt :: (Int -> Bool) -> String -> IO Int -> IO Int
unwrapInt :: (Int -> Bool) -> String -> IO Int -> IO Int
unwrapInt Int -> Bool
fn String
errMsg IO Int
action
= do Int
val <- IO Int
action
if Int -> Bool
fn Int
val
then Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
val
else String -> IO Int
forall a. String -> IO a
failWithError String
errMsg
unwrapBool :: String -> IO Bool -> IO ()
unwrapBool :: String -> IO Bool -> IO ()
unwrapBool String
errMsg IO Bool
action
= do Bool
val <- IO Bool
action
case Bool
val of
Bool
True -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> String -> IO ()
forall a. String -> IO a
failWithError String
errMsg
foreign import ccall unsafe "SDL_Init" sdlInit :: Word32 -> IO Int
init :: [InitFlag] -> IO ()
init :: [InitFlag] -> IO ()
init [InitFlag]
flags
= do Int
ret <- Word32 -> IO Int
sdlInit (Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([InitFlag] -> Word32
forall a b. (Enum a b, Bits b, Num b) => [a] -> b
toBitmask [InitFlag]
flags))
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ret Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1)) (String -> IO ()
forall a. String -> IO a
failWithError String
"SDL_Init")
withInit :: [InitFlag] -> IO a -> IO a
withInit :: forall a. [InitFlag] -> IO a -> IO a
withInit [InitFlag]
flags IO a
action
= IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ ([InitFlag] -> IO ()
init [InitFlag]
flags) IO ()
quit IO a
action
foreign import ccall unsafe "SDL_InitSubSystem" sdlInitSubSystem :: Word32 -> IO Int
initSubSystem :: [InitFlag] -> IO ()
initSubSystem :: [InitFlag] -> IO ()
initSubSystem [InitFlag]
flags
= do Int
ret <- Word32 -> IO Int
sdlInitSubSystem (Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([InitFlag] -> Word32
forall a b. (Enum a b, Bits b, Num b) => [a] -> b
toBitmask [InitFlag]
flags))
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ret Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1)) (String -> IO ()
forall a. String -> IO a
failWithError String
"SDL_InitSubSystem")
foreign import ccall unsafe "SDL_QuitSubSystem" sdlQuitSubSystem :: Word32 -> IO ()
quitSubSystem :: [InitFlag] -> IO ()
quitSubSystem :: [InitFlag] -> IO ()
quitSubSystem = Word32 -> IO ()
sdlQuitSubSystem (Word32 -> IO ()) -> ([InitFlag] -> Word32) -> [InitFlag] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32)
-> ([InitFlag] -> Word32) -> [InitFlag] -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InitFlag] -> Word32
forall a b. (Enum a b, Bits b, Num b) => [a] -> b
toBitmask
foreign import ccall unsafe "SDL_Quit" sdlQuit :: IO ()
quit :: IO ()
quit :: IO ()
quit = IO ()
sdlQuit
foreign import ccall unsafe "SDL_WasInit" sdlWasInit :: Word32 -> IO Word32
wasInit :: [InitFlag] -> IO [InitFlag]
wasInit :: [InitFlag] -> IO [InitFlag]
wasInit [InitFlag]
flags
= do Word32
ret <- Word32 -> IO Word32
sdlWasInit (Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([InitFlag] -> Word32
forall a b. (Enum a b, Bits b, Num b) => [a] -> b
toBitmask [InitFlag]
flags))
[InitFlag] -> IO [InitFlag]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> [InitFlag]
forall a b. (Bounded a, Enum a b, Bits b, Num b) => b -> [a]
fromBitmask (Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ret))
foreign import ccall unsafe "SDL_GetError" sdlGetError :: IO CString
getError :: IO (Maybe String)
getError :: IO (Maybe String)
getError
= do String
str <- CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO CString
sdlGetError
if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str
then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
else Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
str)
failWithError :: String -> IO a
failWithError :: forall a. String -> IO a
failWithError String
msg
= do String
err <- (Maybe String -> String) -> IO (Maybe String) -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"No SDL error") IO (Maybe String)
getError
IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> IOError -> IO a
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nSDL message: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err