{-# LINE 1 "Graphics/UI/SDL/General.hsc" #-}


{-# LINE 5 "Graphics/UI/SDL/General.hsc" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.SDL.General
-- Copyright   :  (c) David Himmelstrup 2005
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-----------------------------------------------------------------------------
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
-- | Initializes SDL. This should be called before all other SDL functions.
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
-- | After SDL has been initialized with SDL_Init you may initialize
-- uninitialized subsystems with SDL_InitSubSystem.
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 allows you to see which SDL subsytems have been initialized
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
-- | Returns a string containing the last error. Nothing if no error.
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