{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

module SDL.Init
  ( initialize
  , initializeAll
  , InitFlag(..)
  , quit
  , version
  ) where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bitmask (foldFlags)
import Data.Data (Data)
import Data.Typeable
import Data.Word
import Foreign.Marshal.Alloc
import Foreign.Storable
import GHC.Generics
import SDL.Internal.Exception
import SDL.Internal.Numbered
import qualified SDL.Raw as Raw

#if !MIN_VERSION_base(4,8,0)
import Data.Foldable
#endif

data InitFlag
  = InitTimer
  | InitAudio
  | InitVideo
  | InitJoystick
  | InitHaptic
  | InitGameController
  | InitEvents
  deriving (InitFlag
forall a. a -> a -> Bounded a
maxBound :: InitFlag
$cmaxBound :: InitFlag
minBound :: InitFlag
$cminBound :: InitFlag
Bounded, Typeable InitFlag
InitFlag -> DataType
InitFlag -> Constr
(forall b. Data b => b -> b) -> InitFlag -> InitFlag
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> InitFlag -> u
forall u. (forall d. Data d => d -> u) -> InitFlag -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InitFlag -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InitFlag -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> InitFlag -> m InitFlag
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitFlag -> m InitFlag
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InitFlag
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InitFlag -> c InitFlag
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InitFlag)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InitFlag)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitFlag -> m InitFlag
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitFlag -> m InitFlag
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitFlag -> m InitFlag
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitFlag -> m InitFlag
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> InitFlag -> m InitFlag
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> InitFlag -> m InitFlag
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InitFlag -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InitFlag -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> InitFlag -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InitFlag -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InitFlag -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InitFlag -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InitFlag -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InitFlag -> r
gmapT :: (forall b. Data b => b -> b) -> InitFlag -> InitFlag
$cgmapT :: (forall b. Data b => b -> b) -> InitFlag -> InitFlag
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InitFlag)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InitFlag)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InitFlag)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InitFlag)
dataTypeOf :: InitFlag -> DataType
$cdataTypeOf :: InitFlag -> DataType
toConstr :: InitFlag -> Constr
$ctoConstr :: InitFlag -> Constr
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InitFlag
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InitFlag
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InitFlag -> c InitFlag
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InitFlag -> c InitFlag
Data, Int -> InitFlag
InitFlag -> Int
InitFlag -> [InitFlag]
InitFlag -> InitFlag
InitFlag -> InitFlag -> [InitFlag]
InitFlag -> InitFlag -> InitFlag -> [InitFlag]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: InitFlag -> InitFlag -> InitFlag -> [InitFlag]
$cenumFromThenTo :: InitFlag -> InitFlag -> InitFlag -> [InitFlag]
enumFromTo :: InitFlag -> InitFlag -> [InitFlag]
$cenumFromTo :: InitFlag -> InitFlag -> [InitFlag]
enumFromThen :: InitFlag -> InitFlag -> [InitFlag]
$cenumFromThen :: InitFlag -> InitFlag -> [InitFlag]
enumFrom :: InitFlag -> [InitFlag]
$cenumFrom :: InitFlag -> [InitFlag]
fromEnum :: InitFlag -> Int
$cfromEnum :: InitFlag -> Int
toEnum :: Int -> InitFlag
$ctoEnum :: Int -> InitFlag
pred :: InitFlag -> InitFlag
$cpred :: InitFlag -> InitFlag
succ :: InitFlag -> InitFlag
$csucc :: InitFlag -> InitFlag
Enum, InitFlag -> InitFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitFlag -> InitFlag -> Bool
$c/= :: InitFlag -> InitFlag -> Bool
== :: InitFlag -> InitFlag -> Bool
$c== :: InitFlag -> InitFlag -> Bool
Eq, forall x. Rep InitFlag x -> InitFlag
forall x. InitFlag -> Rep InitFlag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InitFlag x -> InitFlag
$cfrom :: forall x. InitFlag -> Rep InitFlag x
Generic, Eq 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
min :: InitFlag -> InitFlag -> InitFlag
$cmin :: InitFlag -> InitFlag -> InitFlag
max :: InitFlag -> InitFlag -> InitFlag
$cmax :: InitFlag -> InitFlag -> InitFlag
>= :: InitFlag -> InitFlag -> Bool
$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
compare :: InitFlag -> InitFlag -> Ordering
$ccompare :: InitFlag -> InitFlag -> Ordering
Ord, ReadPrec [InitFlag]
ReadPrec InitFlag
Int -> ReadS InitFlag
ReadS [InitFlag]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitFlag]
$creadListPrec :: ReadPrec [InitFlag]
readPrec :: ReadPrec InitFlag
$creadPrec :: ReadPrec InitFlag
readList :: ReadS [InitFlag]
$creadList :: ReadS [InitFlag]
readsPrec :: Int -> ReadS InitFlag
$creadsPrec :: Int -> ReadS InitFlag
Read, Int -> InitFlag -> ShowS
[InitFlag] -> ShowS
InitFlag -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [InitFlag] -> ShowS
$cshowList :: [InitFlag] -> ShowS
show :: InitFlag -> [Char]
$cshow :: InitFlag -> [Char]
showsPrec :: Int -> InitFlag -> ShowS
$cshowsPrec :: Int -> InitFlag -> ShowS
Show, Typeable)

instance ToNumber InitFlag Word32 where
  toNumber :: InitFlag -> Word32
toNumber InitFlag
InitTimer = Word32
Raw.SDL_INIT_TIMER
  toNumber InitFlag
InitAudio = Word32
Raw.SDL_INIT_AUDIO
  toNumber InitFlag
InitVideo = Word32
Raw.SDL_INIT_VIDEO
  toNumber InitFlag
InitJoystick = Word32
Raw.SDL_INIT_JOYSTICK
  toNumber InitFlag
InitHaptic = Word32
Raw.SDL_INIT_HAPTIC
  toNumber InitFlag
InitGameController = Word32
Raw.SDL_INIT_GAMECONTROLLER
  toNumber InitFlag
InitEvents = Word32
Raw.SDL_INIT_EVENTS

-- | Initializes SDL and the given subsystems. Do not call any SDL functions
-- prior to this one, unless otherwise documented that you may do so.
--
-- You may call this function again with additional subsystems to initialize.
--
-- Throws 'SDLEx.SDLException' if initialization fails.
initialize :: (Foldable f, Functor m, MonadIO m) => f InitFlag -> m ()
initialize :: forall (f :: Type -> Type) (m :: Type -> Type).
(Foldable f, Functor m, MonadIO m) =>
f InitFlag -> m ()
initialize f InitFlag
flags =
  forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m ()
throwIfNeg_ Text
"SDL.Init.init" Text
"SDL_Init" forall a b. (a -> b) -> a -> b
$
    forall (m :: Type -> Type). MonadIO m => Word32 -> m CInt
Raw.init (forall b (f :: Type -> Type) flag.
(Bits b, Foldable f, Num b) =>
(flag -> b) -> f flag -> b
foldFlags forall a b. ToNumber a b => a -> b
toNumber f InitFlag
flags)

-- | Equivalent to @'initialize' ['minBound' .. 'maxBound']@.
initializeAll :: (Functor m, MonadIO m) => m ()
initializeAll :: forall (m :: Type -> Type). (Functor m, MonadIO m) => m ()
initializeAll = forall (f :: Type -> Type) (m :: Type -> Type).
(Foldable f, Functor m, MonadIO m) =>
f InitFlag -> m ()
initialize [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]

-- | Quit and shutdown SDL, freeing any resources that may have been in use.
-- Do not call any SDL functions after you've called this function, unless
-- otherwise documented that you may do so.
quit :: MonadIO m => m ()
quit :: forall (m :: Type -> Type). MonadIO m => m ()
quit = forall (m :: Type -> Type). MonadIO m => m ()
Raw.quit

-- | The major, minor, and patch versions of the SDL library linked with.
-- Does not require initialization.
version :: (Integral a, MonadIO m) => m (a, a, a)
version :: forall a (m :: Type -> Type).
(Integral a, MonadIO m) =>
m (a, a, a)
version = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Raw.Version Word8
major Word8
minor Word8
patch <- forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Version
v -> forall (m :: Type -> Type). MonadIO m => Ptr Version -> m ()
Raw.getVersion Ptr Version
v forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> forall a. Storable a => Ptr a -> IO a
peek Ptr Version
v
  forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
major, forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
minor, forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
patch)