{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
module SDL.Video
  ( module SDL.Video.OpenGL
  , module SDL.Video.Renderer

  -- * Window Management
  , Window
  , createWindow
  , defaultWindow
  , WindowConfig(..)
  , WindowGraphicsContext(..)
  , WindowMode(..)
  , WindowPosition(..)
  , destroyWindow

  -- * Window Actions
  , hideWindow
  , raiseWindow
  , showWindow

  -- * Window Attributes
  , windowMinimumSize
  , windowMaximumSize
  , windowSize
  , windowBordered
  , windowBrightness
  , windowGammaRamp
  , windowGrab
  , setWindowMode
  , getWindowAbsolutePosition
  , getWindowBordersSize
  , setWindowIcon
  , setWindowPosition
  , windowTitle
  , windowData
  , getWindowConfig
  , getWindowPixelFormat
  , PixelFormat(..)

  -- * Renderer Management
  , createRenderer
  , createSoftwareRenderer
  , destroyRenderer

  -- * Clipboard Handling
  , getClipboardText
  , hasClipboardText
  , setClipboardText

  -- * Display
  , getDisplays
  , Display(..)
  , DisplayMode(..)
  , VideoDriver(..)

  -- * Screen Savers
  -- | Screen savers should be disabled when the sudden enablement of the
  -- monitor's power saving features would be inconvenient for when the user
  -- hasn't provided any input for some period of time, such as during video
  -- playback.
  --
  -- Screen savers are disabled by default upon the initialization of the
  -- video subsystem.
  , screenSaverEnabled

  -- * Message Box
  , showSimpleMessageBox
  , MessageKind(..)
  ) where

import Prelude hiding (all, foldl, foldr, mapM_)

import Data.StateVar
import Control.Applicative
import Control.Exception
import Control.Monad (forM, unless, void)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bits
import Data.Data (Data)
import Data.Foldable
import Data.Maybe (fromMaybe)
import Data.Monoid (First(..))
import Data.Text (Text)
import Data.Typeable
import Foreign hiding (void, throwIfNull, throwIfNeg, throwIfNeg_)
import Foreign.C
import GHC.Generics (Generic)
import SDL.Vect
import SDL.Internal.Exception
import SDL.Internal.Numbered
import SDL.Internal.Types
import SDL.Video.OpenGL
import SDL.Video.Renderer

import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as Text
import qualified Data.Vector.Storable as SV
import qualified SDL.Raw as Raw

-- | Create a window with the given title and configuration.
--
-- Throws 'SDLException' on failure.
createWindow :: MonadIO m => Text -> WindowConfig -> m Window
createWindow :: Text -> WindowConfig -> m Window
createWindow Text
title WindowConfig
config = IO Window -> m Window
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Window -> m Window) -> IO Window -> m Window
forall a b. (a -> b) -> a -> b
$ do
  case WindowConfig -> WindowGraphicsContext
windowGraphicsContext WindowConfig
config of
    OpenGLContext OpenGLConfig
glcfg -> OpenGLConfig -> IO ()
forall (m :: Type -> Type). MonadIO m => OpenGLConfig -> m ()
setGLAttributes OpenGLConfig
glcfg
    WindowGraphicsContext
_                   -> () -> IO ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

  ByteString -> (CString -> IO Window) -> IO Window
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
Text.encodeUtf8 Text
title) ((CString -> IO Window) -> IO Window)
-> (CString -> IO Window) -> IO Window
forall a b. (a -> b) -> a -> b
$ \CString
title' -> do
    let create :: CInt -> CInt -> CInt -> CInt -> Word32 -> IO Window
create = CString -> CInt -> CInt -> CInt -> CInt -> Word32 -> IO Window
forall (m :: Type -> Type).
MonadIO m =>
CString -> CInt -> CInt -> CInt -> CInt -> Word32 -> m Window
Raw.createWindow CString
title'
    let create' :: V2 CInt -> Word32 -> IO Window
create' (V2 CInt
w CInt
h) = case WindowConfig -> WindowPosition
windowPosition WindowConfig
config of
          WindowPosition
Centered -> let u :: CInt
u = CInt
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOWPOS_CENTERED in CInt -> CInt -> CInt -> CInt -> Word32 -> IO Window
create CInt
u CInt
u CInt
w CInt
h
          WindowPosition
Wherever -> let u :: CInt
u = CInt
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOWPOS_UNDEFINED in CInt -> CInt -> CInt -> CInt -> Word32 -> IO Window
create CInt
u CInt
u CInt
w CInt
h
          Absolute (P (V2 CInt
x CInt
y)) -> CInt -> CInt -> CInt -> CInt -> Word32 -> IO Window
create CInt
x CInt
y CInt
w CInt
h
    V2 CInt -> Word32 -> IO Window
create' (WindowConfig -> V2 CInt
windowInitialSize WindowConfig
config) Word32
flags IO Window -> (Window -> IO Window) -> IO Window
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Window -> IO Window
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Window -> IO Window) -> (Window -> Window) -> Window -> IO Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Window
Window
  where
    flags :: Word32
flags = (Word32 -> Word32 -> Word32) -> Word32 -> [Word32] -> Word32
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
(.|.) Word32
0
      [ if WindowConfig -> Bool
windowBorder WindowConfig
config then Word32
0 else Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_BORDERLESS
      , if WindowConfig -> Bool
windowHighDPI WindowConfig
config then Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_ALLOW_HIGHDPI else Word32
0
      , if WindowConfig -> Bool
windowInputGrabbed WindowConfig
config then Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_INPUT_GRABBED else Word32
0
      , WindowMode -> Word32
forall a b. ToNumber a b => a -> b
toNumber (WindowMode -> Word32) -> WindowMode -> Word32
forall a b. (a -> b) -> a -> b
$ WindowConfig -> WindowMode
windowMode WindowConfig
config
      , if WindowGraphicsContext -> Bool
ctxIsOpenGL (WindowConfig -> WindowGraphicsContext
windowGraphicsContext WindowConfig
config) then Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_OPENGL else Word32
0
      , if WindowConfig -> Bool
windowResizable WindowConfig
config then Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_RESIZABLE else Word32
0
      , if WindowConfig -> Bool
windowVisible WindowConfig
config then Word32
0 else Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_HIDDEN
      , if WindowConfig -> WindowGraphicsContext
windowGraphicsContext WindowConfig
config WindowGraphicsContext -> WindowGraphicsContext -> Bool
forall a. Eq a => a -> a -> Bool
== WindowGraphicsContext
VulkanContext then Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_VULKAN else Word32
0
      ]
    setGLAttributes :: OpenGLConfig -> m ()
setGLAttributes (OpenGLConfig (V4 CInt
r CInt
g CInt
b CInt
a) CInt
d CInt
s CInt
ms Profile
p) = do
      let (CInt
msk, CInt
v0, CInt
v1, CInt
flg) = case Profile
p of
            Core Mode
Debug CInt
v0' CInt
v1' -> (CInt
forall a. (Eq a, Num a) => a
Raw.SDL_GL_CONTEXT_PROFILE_CORE, CInt
v0', CInt
v1', CInt
forall a. (Eq a, Num a) => a
Raw.SDL_GL_CONTEXT_DEBUG_FLAG)
            Core Mode
Normal CInt
v0' CInt
v1' -> (CInt
forall a. (Eq a, Num a) => a
Raw.SDL_GL_CONTEXT_PROFILE_CORE, CInt
v0', CInt
v1', CInt
0)
            Compatibility Mode
Debug CInt
v0' CInt
v1' -> (CInt
forall a. (Eq a, Num a) => a
Raw.SDL_GL_CONTEXT_PROFILE_COMPATIBILITY, CInt
v0', CInt
v1', CInt
forall a. (Eq a, Num a) => a
Raw.SDL_GL_CONTEXT_DEBUG_FLAG)
            Compatibility Mode
Normal CInt
v0' CInt
v1' -> (CInt
forall a. (Eq a, Num a) => a
Raw.SDL_GL_CONTEXT_PROFILE_COMPATIBILITY, CInt
v0', CInt
v1', CInt
0)
            ES Mode
Debug CInt
v0' CInt
v1' -> (CInt
forall a. (Eq a, Num a) => a
Raw.SDL_GL_CONTEXT_PROFILE_ES, CInt
v0', CInt
v1', CInt
forall a. (Eq a, Num a) => a
Raw.SDL_GL_CONTEXT_DEBUG_FLAG)
            ES Mode
Normal CInt
v0' CInt
v1' -> (CInt
forall a. (Eq a, Num a) => a
Raw.SDL_GL_CONTEXT_PROFILE_ES, CInt
v0', CInt
v1', CInt
0)
      ((Word32, CInt) -> m ()) -> [(Word32, CInt)] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> Text -> m CInt -> m ()
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m ()
throwIfNeg_ Text
"SDL.Video.createWindow" Text
"SDL_GL_SetAttribute" (m CInt -> m ())
-> ((Word32, CInt) -> m CInt) -> (Word32, CInt) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> CInt -> m CInt) -> (Word32, CInt) -> m CInt
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word32 -> CInt -> m CInt
forall (m :: Type -> Type). MonadIO m => Word32 -> CInt -> m CInt
Raw.glSetAttribute) ([(Word32, CInt)] -> m ()) -> [(Word32, CInt)] -> m ()
forall a b. (a -> b) -> a -> b
$
        [ (Word32
Raw.SDL_GL_RED_SIZE, CInt
r)
        , (Word32
Raw.SDL_GL_GREEN_SIZE, CInt
g)
        , (Word32
Raw.SDL_GL_BLUE_SIZE, CInt
b)
        , (Word32
Raw.SDL_GL_ALPHA_SIZE, CInt
a)
        , (Word32
Raw.SDL_GL_DEPTH_SIZE, CInt
d)
        , (Word32
Raw.SDL_GL_STENCIL_SIZE, CInt
s)
        , (Word32
Raw.SDL_GL_MULTISAMPLEBUFFERS, if CInt
ms CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
1 then CInt
1 else CInt
0)
        , (Word32
Raw.SDL_GL_MULTISAMPLESAMPLES, if CInt
ms CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
1 then CInt
ms else CInt
0)
        , (Word32
Raw.SDL_GL_CONTEXT_PROFILE_MASK, CInt
msk)
        , (Word32
Raw.SDL_GL_CONTEXT_MAJOR_VERSION, CInt
v0)
        , (Word32
Raw.SDL_GL_CONTEXT_MINOR_VERSION, CInt
v1)
        , (Word32
Raw.SDL_GL_CONTEXT_FLAGS, CInt
flg)
        ]

-- | Default configuration for windows. Use the record update syntax to
-- override any of the defaults.
--
-- @
-- 'defaultWindow' = 'WindowConfig'
--   { 'windowBorder'          = True
--   , 'windowHighDPI'         = False
--   , 'windowInputGrabbed'    = False
--   , 'windowMode'            = 'Windowed'
--   , 'windowGraphicsContext' = NoGraphicsContext
--   , 'windowPosition'        = 'Wherever'
--   , 'windowResizable'       = False
--   , 'windowInitialSize'     = V2 800 600
--   , 'windowVisible'         = True
--   }
-- @
defaultWindow :: WindowConfig
defaultWindow :: WindowConfig
defaultWindow = WindowConfig :: Bool
-> Bool
-> Bool
-> WindowMode
-> WindowGraphicsContext
-> WindowPosition
-> Bool
-> V2 CInt
-> Bool
-> WindowConfig
WindowConfig
  { windowBorder :: Bool
windowBorder          = Bool
True
  , windowHighDPI :: Bool
windowHighDPI         = Bool
False
  , windowInputGrabbed :: Bool
windowInputGrabbed    = Bool
False
  , windowMode :: WindowMode
windowMode            = WindowMode
Windowed
  , windowGraphicsContext :: WindowGraphicsContext
windowGraphicsContext = WindowGraphicsContext
NoGraphicsContext
  , windowPosition :: WindowPosition
windowPosition        = WindowPosition
Wherever
  , windowResizable :: Bool
windowResizable       = Bool
False
  , windowInitialSize :: V2 CInt
windowInitialSize     = CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
V2 CInt
800 CInt
600
     , windowVisible :: Bool
windowVisible      = Bool
True
  }

data WindowConfig = WindowConfig
  { WindowConfig -> Bool
windowBorder          :: Bool                  -- ^ Defaults to 'True'.
  , WindowConfig -> Bool
windowHighDPI         :: Bool                  -- ^ Defaults to 'False'. Can not be changed after window creation.
  , WindowConfig -> Bool
windowInputGrabbed    :: Bool                  -- ^ Defaults to 'False'. Whether the mouse shall be confined to the window.
  , WindowConfig -> WindowMode
windowMode            :: WindowMode            -- ^ Defaults to 'Windowed'.
  , WindowConfig -> WindowGraphicsContext
windowGraphicsContext :: WindowGraphicsContext -- ^ Defaults to 'NoGraphicsContext'. Can not be changed after window creation.
  , WindowConfig -> WindowPosition
windowPosition        :: WindowPosition        -- ^ Defaults to 'Wherever'.
  , WindowConfig -> Bool
windowResizable       :: Bool                  -- ^ Defaults to 'False'. Whether the window can be resized by the user. It is still possible to programatically change the size by changing 'windowSize'.
  , WindowConfig -> V2 CInt
windowInitialSize     :: V2 CInt               -- ^ Defaults to @(800, 600)@. If you set 'windowHighDPI' flag, window size in screen coordinates may differ from the size in pixels. Use 'glGetDrawableSize' or 'SDL.Video.Vulkan.vkGetDrawableSize' to get size in pixels.
  , WindowConfig -> Bool
windowVisible         :: Bool                  -- ^ Defaults to 'True'.
  } deriving (WindowConfig -> WindowConfig -> Bool
(WindowConfig -> WindowConfig -> Bool)
-> (WindowConfig -> WindowConfig -> Bool) -> Eq WindowConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowConfig -> WindowConfig -> Bool
$c/= :: WindowConfig -> WindowConfig -> Bool
== :: WindowConfig -> WindowConfig -> Bool
$c== :: WindowConfig -> WindowConfig -> Bool
Eq, (forall x. WindowConfig -> Rep WindowConfig x)
-> (forall x. Rep WindowConfig x -> WindowConfig)
-> Generic WindowConfig
forall x. Rep WindowConfig x -> WindowConfig
forall x. WindowConfig -> Rep WindowConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WindowConfig x -> WindowConfig
$cfrom :: forall x. WindowConfig -> Rep WindowConfig x
Generic, Eq WindowConfig
Eq WindowConfig
-> (WindowConfig -> WindowConfig -> Ordering)
-> (WindowConfig -> WindowConfig -> Bool)
-> (WindowConfig -> WindowConfig -> Bool)
-> (WindowConfig -> WindowConfig -> Bool)
-> (WindowConfig -> WindowConfig -> Bool)
-> (WindowConfig -> WindowConfig -> WindowConfig)
-> (WindowConfig -> WindowConfig -> WindowConfig)
-> Ord WindowConfig
WindowConfig -> WindowConfig -> Bool
WindowConfig -> WindowConfig -> Ordering
WindowConfig -> WindowConfig -> WindowConfig
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 :: WindowConfig -> WindowConfig -> WindowConfig
$cmin :: WindowConfig -> WindowConfig -> WindowConfig
max :: WindowConfig -> WindowConfig -> WindowConfig
$cmax :: WindowConfig -> WindowConfig -> WindowConfig
>= :: WindowConfig -> WindowConfig -> Bool
$c>= :: WindowConfig -> WindowConfig -> Bool
> :: WindowConfig -> WindowConfig -> Bool
$c> :: WindowConfig -> WindowConfig -> Bool
<= :: WindowConfig -> WindowConfig -> Bool
$c<= :: WindowConfig -> WindowConfig -> Bool
< :: WindowConfig -> WindowConfig -> Bool
$c< :: WindowConfig -> WindowConfig -> Bool
compare :: WindowConfig -> WindowConfig -> Ordering
$ccompare :: WindowConfig -> WindowConfig -> Ordering
$cp1Ord :: Eq WindowConfig
Ord, ReadPrec [WindowConfig]
ReadPrec WindowConfig
Int -> ReadS WindowConfig
ReadS [WindowConfig]
(Int -> ReadS WindowConfig)
-> ReadS [WindowConfig]
-> ReadPrec WindowConfig
-> ReadPrec [WindowConfig]
-> Read WindowConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WindowConfig]
$creadListPrec :: ReadPrec [WindowConfig]
readPrec :: ReadPrec WindowConfig
$creadPrec :: ReadPrec WindowConfig
readList :: ReadS [WindowConfig]
$creadList :: ReadS [WindowConfig]
readsPrec :: Int -> ReadS WindowConfig
$creadsPrec :: Int -> ReadS WindowConfig
Read, Int -> WindowConfig -> ShowS
[WindowConfig] -> ShowS
WindowConfig -> String
(Int -> WindowConfig -> ShowS)
-> (WindowConfig -> String)
-> ([WindowConfig] -> ShowS)
-> Show WindowConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowConfig] -> ShowS
$cshowList :: [WindowConfig] -> ShowS
show :: WindowConfig -> String
$cshow :: WindowConfig -> String
showsPrec :: Int -> WindowConfig -> ShowS
$cshowsPrec :: Int -> WindowConfig -> ShowS
Show, Typeable)

-- | Configuration of additional graphics context that will be created for window.
--
--   Can not be changed after window creation.
data WindowGraphicsContext
  = NoGraphicsContext          -- ^ Window will be created without any additional graphics context.
  | OpenGLContext OpenGLConfig -- ^ Window will be created with OpenGL support with parameters from 'OpenGLConfig'.
  | VulkanContext              -- ^ Window will be created with Vulkan support.
                               --   The following functions will be implicitly called by SDL C library:
                               --
                               --     1. analogue of 'SDL.Video.Vulkan.vkLoadLibrary' 'Nothing' will be called automatically before first window creation;
                               --     2. analogue of 'SDL.Video.Vulkan.vkUnloadLibrary' will be called after last window destruction.
  deriving (WindowGraphicsContext -> WindowGraphicsContext -> Bool
(WindowGraphicsContext -> WindowGraphicsContext -> Bool)
-> (WindowGraphicsContext -> WindowGraphicsContext -> Bool)
-> Eq WindowGraphicsContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowGraphicsContext -> WindowGraphicsContext -> Bool
$c/= :: WindowGraphicsContext -> WindowGraphicsContext -> Bool
== :: WindowGraphicsContext -> WindowGraphicsContext -> Bool
$c== :: WindowGraphicsContext -> WindowGraphicsContext -> Bool
Eq, (forall x. WindowGraphicsContext -> Rep WindowGraphicsContext x)
-> (forall x. Rep WindowGraphicsContext x -> WindowGraphicsContext)
-> Generic WindowGraphicsContext
forall x. Rep WindowGraphicsContext x -> WindowGraphicsContext
forall x. WindowGraphicsContext -> Rep WindowGraphicsContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WindowGraphicsContext x -> WindowGraphicsContext
$cfrom :: forall x. WindowGraphicsContext -> Rep WindowGraphicsContext x
Generic, Eq WindowGraphicsContext
Eq WindowGraphicsContext
-> (WindowGraphicsContext -> WindowGraphicsContext -> Ordering)
-> (WindowGraphicsContext -> WindowGraphicsContext -> Bool)
-> (WindowGraphicsContext -> WindowGraphicsContext -> Bool)
-> (WindowGraphicsContext -> WindowGraphicsContext -> Bool)
-> (WindowGraphicsContext -> WindowGraphicsContext -> Bool)
-> (WindowGraphicsContext
    -> WindowGraphicsContext -> WindowGraphicsContext)
-> (WindowGraphicsContext
    -> WindowGraphicsContext -> WindowGraphicsContext)
-> Ord WindowGraphicsContext
WindowGraphicsContext -> WindowGraphicsContext -> Bool
WindowGraphicsContext -> WindowGraphicsContext -> Ordering
WindowGraphicsContext
-> WindowGraphicsContext -> WindowGraphicsContext
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 :: WindowGraphicsContext
-> WindowGraphicsContext -> WindowGraphicsContext
$cmin :: WindowGraphicsContext
-> WindowGraphicsContext -> WindowGraphicsContext
max :: WindowGraphicsContext
-> WindowGraphicsContext -> WindowGraphicsContext
$cmax :: WindowGraphicsContext
-> WindowGraphicsContext -> WindowGraphicsContext
>= :: WindowGraphicsContext -> WindowGraphicsContext -> Bool
$c>= :: WindowGraphicsContext -> WindowGraphicsContext -> Bool
> :: WindowGraphicsContext -> WindowGraphicsContext -> Bool
$c> :: WindowGraphicsContext -> WindowGraphicsContext -> Bool
<= :: WindowGraphicsContext -> WindowGraphicsContext -> Bool
$c<= :: WindowGraphicsContext -> WindowGraphicsContext -> Bool
< :: WindowGraphicsContext -> WindowGraphicsContext -> Bool
$c< :: WindowGraphicsContext -> WindowGraphicsContext -> Bool
compare :: WindowGraphicsContext -> WindowGraphicsContext -> Ordering
$ccompare :: WindowGraphicsContext -> WindowGraphicsContext -> Ordering
$cp1Ord :: Eq WindowGraphicsContext
Ord, ReadPrec [WindowGraphicsContext]
ReadPrec WindowGraphicsContext
Int -> ReadS WindowGraphicsContext
ReadS [WindowGraphicsContext]
(Int -> ReadS WindowGraphicsContext)
-> ReadS [WindowGraphicsContext]
-> ReadPrec WindowGraphicsContext
-> ReadPrec [WindowGraphicsContext]
-> Read WindowGraphicsContext
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WindowGraphicsContext]
$creadListPrec :: ReadPrec [WindowGraphicsContext]
readPrec :: ReadPrec WindowGraphicsContext
$creadPrec :: ReadPrec WindowGraphicsContext
readList :: ReadS [WindowGraphicsContext]
$creadList :: ReadS [WindowGraphicsContext]
readsPrec :: Int -> ReadS WindowGraphicsContext
$creadsPrec :: Int -> ReadS WindowGraphicsContext
Read, Int -> WindowGraphicsContext -> ShowS
[WindowGraphicsContext] -> ShowS
WindowGraphicsContext -> String
(Int -> WindowGraphicsContext -> ShowS)
-> (WindowGraphicsContext -> String)
-> ([WindowGraphicsContext] -> ShowS)
-> Show WindowGraphicsContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowGraphicsContext] -> ShowS
$cshowList :: [WindowGraphicsContext] -> ShowS
show :: WindowGraphicsContext -> String
$cshow :: WindowGraphicsContext -> String
showsPrec :: Int -> WindowGraphicsContext -> ShowS
$cshowsPrec :: Int -> WindowGraphicsContext -> ShowS
Show, Typeable)

ctxIsOpenGL :: WindowGraphicsContext -> Bool
ctxIsOpenGL :: WindowGraphicsContext -> Bool
ctxIsOpenGL (OpenGLContext OpenGLConfig
_) = Bool
True
ctxIsOpenGL WindowGraphicsContext
_                 = Bool
False

data WindowMode
  = Fullscreen        -- ^ Real fullscreen with a video mode change
  | FullscreenDesktop -- ^ Fake fullscreen that takes the size of the desktop
  | Maximized
  | Minimized
  | Windowed
  deriving (WindowMode
WindowMode -> WindowMode -> Bounded WindowMode
forall a. a -> a -> Bounded a
maxBound :: WindowMode
$cmaxBound :: WindowMode
minBound :: WindowMode
$cminBound :: WindowMode
Bounded, Typeable WindowMode
DataType
Constr
Typeable WindowMode
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> WindowMode -> c WindowMode)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c WindowMode)
-> (WindowMode -> Constr)
-> (WindowMode -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c WindowMode))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c WindowMode))
-> ((forall b. Data b => b -> b) -> WindowMode -> WindowMode)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WindowMode -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WindowMode -> r)
-> (forall u. (forall d. Data d => d -> u) -> WindowMode -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> WindowMode -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> WindowMode -> m WindowMode)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WindowMode -> m WindowMode)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WindowMode -> m WindowMode)
-> Data WindowMode
WindowMode -> DataType
WindowMode -> Constr
(forall b. Data b => b -> b) -> WindowMode -> WindowMode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowMode -> c WindowMode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowMode
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) -> WindowMode -> u
forall u. (forall d. Data d => d -> u) -> WindowMode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowMode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowMode -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> WindowMode -> m WindowMode
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WindowMode -> m WindowMode
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowMode
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowMode -> c WindowMode
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WindowMode)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WindowMode)
$cWindowed :: Constr
$cMinimized :: Constr
$cMaximized :: Constr
$cFullscreenDesktop :: Constr
$cFullscreen :: Constr
$tWindowMode :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> WindowMode -> m WindowMode
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WindowMode -> m WindowMode
gmapMp :: (forall d. Data d => d -> m d) -> WindowMode -> m WindowMode
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WindowMode -> m WindowMode
gmapM :: (forall d. Data d => d -> m d) -> WindowMode -> m WindowMode
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> WindowMode -> m WindowMode
gmapQi :: Int -> (forall d. Data d => d -> u) -> WindowMode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WindowMode -> u
gmapQ :: (forall d. Data d => d -> u) -> WindowMode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WindowMode -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowMode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowMode -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowMode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowMode -> r
gmapT :: (forall b. Data b => b -> b) -> WindowMode -> WindowMode
$cgmapT :: (forall b. Data b => b -> b) -> WindowMode -> WindowMode
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WindowMode)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WindowMode)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c WindowMode)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WindowMode)
dataTypeOf :: WindowMode -> DataType
$cdataTypeOf :: WindowMode -> DataType
toConstr :: WindowMode -> Constr
$ctoConstr :: WindowMode -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowMode
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowMode
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowMode -> c WindowMode
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowMode -> c WindowMode
$cp1Data :: Typeable WindowMode
Data, Int -> WindowMode
WindowMode -> Int
WindowMode -> [WindowMode]
WindowMode -> WindowMode
WindowMode -> WindowMode -> [WindowMode]
WindowMode -> WindowMode -> WindowMode -> [WindowMode]
(WindowMode -> WindowMode)
-> (WindowMode -> WindowMode)
-> (Int -> WindowMode)
-> (WindowMode -> Int)
-> (WindowMode -> [WindowMode])
-> (WindowMode -> WindowMode -> [WindowMode])
-> (WindowMode -> WindowMode -> [WindowMode])
-> (WindowMode -> WindowMode -> WindowMode -> [WindowMode])
-> Enum WindowMode
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 :: WindowMode -> WindowMode -> WindowMode -> [WindowMode]
$cenumFromThenTo :: WindowMode -> WindowMode -> WindowMode -> [WindowMode]
enumFromTo :: WindowMode -> WindowMode -> [WindowMode]
$cenumFromTo :: WindowMode -> WindowMode -> [WindowMode]
enumFromThen :: WindowMode -> WindowMode -> [WindowMode]
$cenumFromThen :: WindowMode -> WindowMode -> [WindowMode]
enumFrom :: WindowMode -> [WindowMode]
$cenumFrom :: WindowMode -> [WindowMode]
fromEnum :: WindowMode -> Int
$cfromEnum :: WindowMode -> Int
toEnum :: Int -> WindowMode
$ctoEnum :: Int -> WindowMode
pred :: WindowMode -> WindowMode
$cpred :: WindowMode -> WindowMode
succ :: WindowMode -> WindowMode
$csucc :: WindowMode -> WindowMode
Enum, WindowMode -> WindowMode -> Bool
(WindowMode -> WindowMode -> Bool)
-> (WindowMode -> WindowMode -> Bool) -> Eq WindowMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowMode -> WindowMode -> Bool
$c/= :: WindowMode -> WindowMode -> Bool
== :: WindowMode -> WindowMode -> Bool
$c== :: WindowMode -> WindowMode -> Bool
Eq, (forall x. WindowMode -> Rep WindowMode x)
-> (forall x. Rep WindowMode x -> WindowMode) -> Generic WindowMode
forall x. Rep WindowMode x -> WindowMode
forall x. WindowMode -> Rep WindowMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WindowMode x -> WindowMode
$cfrom :: forall x. WindowMode -> Rep WindowMode x
Generic, Eq WindowMode
Eq WindowMode
-> (WindowMode -> WindowMode -> Ordering)
-> (WindowMode -> WindowMode -> Bool)
-> (WindowMode -> WindowMode -> Bool)
-> (WindowMode -> WindowMode -> Bool)
-> (WindowMode -> WindowMode -> Bool)
-> (WindowMode -> WindowMode -> WindowMode)
-> (WindowMode -> WindowMode -> WindowMode)
-> Ord WindowMode
WindowMode -> WindowMode -> Bool
WindowMode -> WindowMode -> Ordering
WindowMode -> WindowMode -> WindowMode
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 :: WindowMode -> WindowMode -> WindowMode
$cmin :: WindowMode -> WindowMode -> WindowMode
max :: WindowMode -> WindowMode -> WindowMode
$cmax :: WindowMode -> WindowMode -> WindowMode
>= :: WindowMode -> WindowMode -> Bool
$c>= :: WindowMode -> WindowMode -> Bool
> :: WindowMode -> WindowMode -> Bool
$c> :: WindowMode -> WindowMode -> Bool
<= :: WindowMode -> WindowMode -> Bool
$c<= :: WindowMode -> WindowMode -> Bool
< :: WindowMode -> WindowMode -> Bool
$c< :: WindowMode -> WindowMode -> Bool
compare :: WindowMode -> WindowMode -> Ordering
$ccompare :: WindowMode -> WindowMode -> Ordering
$cp1Ord :: Eq WindowMode
Ord, ReadPrec [WindowMode]
ReadPrec WindowMode
Int -> ReadS WindowMode
ReadS [WindowMode]
(Int -> ReadS WindowMode)
-> ReadS [WindowMode]
-> ReadPrec WindowMode
-> ReadPrec [WindowMode]
-> Read WindowMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WindowMode]
$creadListPrec :: ReadPrec [WindowMode]
readPrec :: ReadPrec WindowMode
$creadPrec :: ReadPrec WindowMode
readList :: ReadS [WindowMode]
$creadList :: ReadS [WindowMode]
readsPrec :: Int -> ReadS WindowMode
$creadsPrec :: Int -> ReadS WindowMode
Read, Int -> WindowMode -> ShowS
[WindowMode] -> ShowS
WindowMode -> String
(Int -> WindowMode -> ShowS)
-> (WindowMode -> String)
-> ([WindowMode] -> ShowS)
-> Show WindowMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowMode] -> ShowS
$cshowList :: [WindowMode] -> ShowS
show :: WindowMode -> String
$cshow :: WindowMode -> String
showsPrec :: Int -> WindowMode -> ShowS
$cshowsPrec :: Int -> WindowMode -> ShowS
Show, Typeable)

instance ToNumber WindowMode Word32 where
  toNumber :: WindowMode -> Word32
toNumber WindowMode
Fullscreen = Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_FULLSCREEN
  toNumber WindowMode
FullscreenDesktop = Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_FULLSCREEN_DESKTOP
  toNumber WindowMode
Maximized = Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_MAXIMIZED
  toNumber WindowMode
Minimized = Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_MINIMIZED
  toNumber WindowMode
Windowed = Word32
0

instance FromNumber WindowMode Word32 where
  fromNumber :: Word32 -> WindowMode
fromNumber Word32
n = WindowMode -> Maybe WindowMode -> WindowMode
forall a. a -> Maybe a -> a
fromMaybe WindowMode
Windowed (Maybe WindowMode -> WindowMode)
-> (First WindowMode -> Maybe WindowMode)
-> First WindowMode
-> WindowMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. First WindowMode -> Maybe WindowMode
forall a. First a -> Maybe a
getFirst (First WindowMode -> WindowMode) -> First WindowMode -> WindowMode
forall a b. (a -> b) -> a -> b
$
    (Maybe WindowMode -> First WindowMode)
-> [Maybe WindowMode] -> First WindowMode
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Maybe WindowMode -> First WindowMode
forall a. Maybe a -> First a
First [
        Maybe WindowMode
sdlWindowFullscreenDesktop
      , Maybe WindowMode
sdlWindowFullscreen
      , Maybe WindowMode
sdlWindowMaximized
      , Maybe WindowMode
sdlWindowMinimized
      ]
    where
      maybeBit :: a -> Word32 -> Maybe a
maybeBit a
val Word32
msk = if Word32
n Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
msk Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
msk then a -> Maybe a
forall a. a -> Maybe a
Just a
val else Maybe a
forall a. Maybe a
Nothing
      sdlWindowFullscreenDesktop :: Maybe WindowMode
sdlWindowFullscreenDesktop = WindowMode -> Word32 -> Maybe WindowMode
forall a. a -> Word32 -> Maybe a
maybeBit WindowMode
FullscreenDesktop Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_FULLSCREEN_DESKTOP
      sdlWindowFullscreen :: Maybe WindowMode
sdlWindowFullscreen        = WindowMode -> Word32 -> Maybe WindowMode
forall a. a -> Word32 -> Maybe a
maybeBit WindowMode
Fullscreen Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_FULLSCREEN
      sdlWindowMaximized :: Maybe WindowMode
sdlWindowMaximized         = WindowMode -> Word32 -> Maybe WindowMode
forall a. a -> Word32 -> Maybe a
maybeBit WindowMode
Maximized Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_MAXIMIZED
      sdlWindowMinimized :: Maybe WindowMode
sdlWindowMinimized         = WindowMode -> Word32 -> Maybe WindowMode
forall a. a -> Word32 -> Maybe a
maybeBit WindowMode
Minimized Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_MINIMIZED

data WindowPosition
  = Centered
  | Wherever -- ^ Let the window mananger decide where it's best to place the window.
  | Absolute (Point V2 CInt)
  deriving (WindowPosition -> WindowPosition -> Bool
(WindowPosition -> WindowPosition -> Bool)
-> (WindowPosition -> WindowPosition -> Bool) -> Eq WindowPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowPosition -> WindowPosition -> Bool
$c/= :: WindowPosition -> WindowPosition -> Bool
== :: WindowPosition -> WindowPosition -> Bool
$c== :: WindowPosition -> WindowPosition -> Bool
Eq, (forall x. WindowPosition -> Rep WindowPosition x)
-> (forall x. Rep WindowPosition x -> WindowPosition)
-> Generic WindowPosition
forall x. Rep WindowPosition x -> WindowPosition
forall x. WindowPosition -> Rep WindowPosition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WindowPosition x -> WindowPosition
$cfrom :: forall x. WindowPosition -> Rep WindowPosition x
Generic, Eq WindowPosition
Eq WindowPosition
-> (WindowPosition -> WindowPosition -> Ordering)
-> (WindowPosition -> WindowPosition -> Bool)
-> (WindowPosition -> WindowPosition -> Bool)
-> (WindowPosition -> WindowPosition -> Bool)
-> (WindowPosition -> WindowPosition -> Bool)
-> (WindowPosition -> WindowPosition -> WindowPosition)
-> (WindowPosition -> WindowPosition -> WindowPosition)
-> Ord WindowPosition
WindowPosition -> WindowPosition -> Bool
WindowPosition -> WindowPosition -> Ordering
WindowPosition -> WindowPosition -> WindowPosition
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 :: WindowPosition -> WindowPosition -> WindowPosition
$cmin :: WindowPosition -> WindowPosition -> WindowPosition
max :: WindowPosition -> WindowPosition -> WindowPosition
$cmax :: WindowPosition -> WindowPosition -> WindowPosition
>= :: WindowPosition -> WindowPosition -> Bool
$c>= :: WindowPosition -> WindowPosition -> Bool
> :: WindowPosition -> WindowPosition -> Bool
$c> :: WindowPosition -> WindowPosition -> Bool
<= :: WindowPosition -> WindowPosition -> Bool
$c<= :: WindowPosition -> WindowPosition -> Bool
< :: WindowPosition -> WindowPosition -> Bool
$c< :: WindowPosition -> WindowPosition -> Bool
compare :: WindowPosition -> WindowPosition -> Ordering
$ccompare :: WindowPosition -> WindowPosition -> Ordering
$cp1Ord :: Eq WindowPosition
Ord, ReadPrec [WindowPosition]
ReadPrec WindowPosition
Int -> ReadS WindowPosition
ReadS [WindowPosition]
(Int -> ReadS WindowPosition)
-> ReadS [WindowPosition]
-> ReadPrec WindowPosition
-> ReadPrec [WindowPosition]
-> Read WindowPosition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WindowPosition]
$creadListPrec :: ReadPrec [WindowPosition]
readPrec :: ReadPrec WindowPosition
$creadPrec :: ReadPrec WindowPosition
readList :: ReadS [WindowPosition]
$creadList :: ReadS [WindowPosition]
readsPrec :: Int -> ReadS WindowPosition
$creadsPrec :: Int -> ReadS WindowPosition
Read, Int -> WindowPosition -> ShowS
[WindowPosition] -> ShowS
WindowPosition -> String
(Int -> WindowPosition -> ShowS)
-> (WindowPosition -> String)
-> ([WindowPosition] -> ShowS)
-> Show WindowPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowPosition] -> ShowS
$cshowList :: [WindowPosition] -> ShowS
show :: WindowPosition -> String
$cshow :: WindowPosition -> String
showsPrec :: Int -> WindowPosition -> ShowS
$cshowsPrec :: Int -> WindowPosition -> ShowS
Show, Typeable)

-- | Destroy the given window. The 'Window' handler may not be used
-- afterwards.
destroyWindow :: MonadIO m => Window -> m ()
destroyWindow :: Window -> m ()
destroyWindow (Window Window
w) = Window -> m ()
forall (m :: Type -> Type). MonadIO m => Window -> m ()
Raw.destroyWindow Window
w

-- | Get or set if the window should have a border.
--
-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'.
windowBordered :: Window -> StateVar Bool
windowBordered :: Window -> StateVar Bool
windowBordered (Window Window
w) = IO Bool -> (Bool -> IO ()) -> StateVar Bool
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO Bool
getWindowBordered Bool -> IO ()
setWindowBordered
  where
  getWindowBordered :: IO Bool
getWindowBordered = (Word32 -> Bool) -> IO Word32 -> IO Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0) (Word32 -> Bool) -> (Word32 -> Word32) -> Word32 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_BORDERLESS)) (Window -> IO Word32
forall (m :: Type -> Type). MonadIO m => Window -> m Word32
Raw.getWindowFlags Window
w)
  setWindowBordered :: Bool -> IO ()
setWindowBordered = Window -> Bool -> IO ()
forall (m :: Type -> Type). MonadIO m => Window -> Bool -> m ()
Raw.setWindowBordered Window
w

-- | Get or set the window's brightness, where 0.0 is completely dark and 1.0 is normal brightness.
--
-- Throws 'SDLException' if the hardware does not support gamma
-- correction, or if the system has run out of memory.
--
-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'.
windowBrightness :: Window -> StateVar Float
windowBrightness :: Window -> StateVar Float
windowBrightness (Window Window
w) = IO Float -> (Float -> IO ()) -> StateVar Float
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO Float
getWindowBrightness Float -> IO ()
forall (m :: Type -> Type) a. (MonadIO m, Real a) => a -> m ()
setWindowBrightness
  where
  setWindowBrightness :: a -> m ()
setWindowBrightness a
brightness = do
    Text -> Text -> m CInt -> m ()
forall a (m :: Type -> Type).
(Eq a, MonadIO m, Num a) =>
Text -> Text -> m a -> m ()
throwIfNot0_ Text
"SDL.Video.setWindowBrightness" Text
"SDL_SetWindowBrightness" (m CInt -> m ()) -> m CInt -> m ()
forall a b. (a -> b) -> a -> b
$
      Window -> CFloat -> m CInt
forall (m :: Type -> Type). MonadIO m => Window -> CFloat -> m CInt
Raw.setWindowBrightness Window
w (CFloat -> m CInt) -> CFloat -> m CInt
forall a b. (a -> b) -> a -> b
$ a -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
brightness

  getWindowBrightness :: IO Float
getWindowBrightness =
      Float -> IO Float
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Float -> IO Float) -> (CFloat -> Float) -> CFloat -> IO Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CFloat -> IO Float) -> IO CFloat -> IO Float
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Window -> IO CFloat
forall (m :: Type -> Type). MonadIO m => Window -> m CFloat
Raw.getWindowBrightness Window
w

-- | Get or set whether the mouse shall be confined to the window.
--
-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'.
windowGrab :: Window -> StateVar Bool
windowGrab :: Window -> StateVar Bool
windowGrab (Window Window
w) = IO Bool -> (Bool -> IO ()) -> StateVar Bool
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO Bool
getWindowGrab Bool -> IO ()
setWindowGrab
  where
  setWindowGrab :: Bool -> IO ()
setWindowGrab = Window -> Bool -> IO ()
forall (m :: Type -> Type). MonadIO m => Window -> Bool -> m ()
Raw.setWindowGrab Window
w
  getWindowGrab :: IO Bool
getWindowGrab = Window -> IO Bool
forall (m :: Type -> Type). MonadIO m => Window -> m Bool
Raw.getWindowGrab Window
w

-- | Change between window modes.
--
-- Throws 'SDLException' on failure.
setWindowMode :: MonadIO m => Window -> WindowMode -> m ()
setWindowMode :: Window -> WindowMode -> m ()
setWindowMode (Window Window
w) WindowMode
mode =
  IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (IO CInt -> IO ()) -> IO CInt -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> IO CInt -> IO ()
forall a (m :: Type -> Type).
(Eq a, MonadIO m, Num a) =>
Text -> Text -> m a -> m ()
throwIfNot0_ Text
"SDL.Video.setWindowMode" Text
"SDL_SetWindowFullscreen" (IO CInt -> m ()) -> IO CInt -> m ()
forall a b. (a -> b) -> a -> b
$
    case WindowMode
mode of
      WindowMode
Fullscreen -> Window -> Word32 -> IO CInt
forall (m :: Type -> Type). MonadIO m => Window -> Word32 -> m CInt
Raw.setWindowFullscreen Window
w Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_FULLSCREEN IO CInt -> IO () -> IO CInt
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Window -> IO ()
forall (m :: Type -> Type). MonadIO m => Window -> m ()
Raw.raiseWindow Window
w
      WindowMode
FullscreenDesktop -> Window -> Word32 -> IO CInt
forall (m :: Type -> Type). MonadIO m => Window -> Word32 -> m CInt
Raw.setWindowFullscreen Window
w Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_FULLSCREEN_DESKTOP IO CInt -> IO () -> IO CInt
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Window -> IO ()
forall (m :: Type -> Type). MonadIO m => Window -> m ()
Raw.raiseWindow Window
w
      WindowMode
Maximized -> Window -> Word32 -> IO CInt
forall (m :: Type -> Type). MonadIO m => Window -> Word32 -> m CInt
Raw.setWindowFullscreen Window
w Word32
0 IO CInt -> IO () -> IO CInt
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Window -> IO ()
forall (m :: Type -> Type). MonadIO m => Window -> m ()
Raw.maximizeWindow Window
w
      WindowMode
Minimized -> Window -> IO ()
forall (m :: Type -> Type). MonadIO m => Window -> m ()
Raw.minimizeWindow Window
w IO () -> IO CInt -> IO CInt
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> CInt -> IO CInt
forall (m :: Type -> Type) a. Monad m => a -> m a
return CInt
0
      WindowMode
Windowed -> Window -> Word32 -> IO CInt
forall (m :: Type -> Type). MonadIO m => Window -> Word32 -> m CInt
Raw.setWindowFullscreen Window
w Word32
0 IO CInt -> IO () -> IO CInt
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Window -> IO ()
forall (m :: Type -> Type). MonadIO m => Window -> m ()
Raw.restoreWindow Window
w

-- | Set the icon for a window.
setWindowIcon :: MonadIO m => Window -> Surface -> m ()
setWindowIcon :: Window -> Surface -> m ()
setWindowIcon (Window Window
win) (Surface Ptr Surface
sfc Maybe (IOVector Word8)
_) =
  Window -> Ptr Surface -> m ()
forall (m :: Type -> Type).
MonadIO m =>
Window -> Ptr Surface -> m ()
Raw.setWindowIcon Window
win Ptr Surface
sfc

-- | Set the position of the window.
setWindowPosition :: MonadIO m => Window -> WindowPosition -> m ()
setWindowPosition :: Window -> WindowPosition -> m ()
setWindowPosition (Window Window
w) WindowPosition
pos = case WindowPosition
pos of
  WindowPosition
Centered -> let u :: CInt
u = CInt
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOWPOS_CENTERED in Window -> CInt -> CInt -> m ()
forall (m :: Type -> Type).
MonadIO m =>
Window -> CInt -> CInt -> m ()
Raw.setWindowPosition Window
w CInt
u CInt
u
  WindowPosition
Wherever -> let u :: CInt
u = CInt
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOWPOS_UNDEFINED in Window -> CInt -> CInt -> m ()
forall (m :: Type -> Type).
MonadIO m =>
Window -> CInt -> CInt -> m ()
Raw.setWindowPosition Window
w CInt
u CInt
u
  Absolute (P (V2 CInt
x CInt
y)) -> Window -> CInt -> CInt -> m ()
forall (m :: Type -> Type).
MonadIO m =>
Window -> CInt -> CInt -> m ()
Raw.setWindowPosition Window
w CInt
x CInt
y

-- | Get the position of the window.
getWindowAbsolutePosition :: MonadIO m => Window -> m (V2 CInt)
getWindowAbsolutePosition :: Window -> m (V2 CInt)
getWindowAbsolutePosition (Window Window
w) =
    IO (V2 CInt) -> m (V2 CInt)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (V2 CInt) -> m (V2 CInt)) -> IO (V2 CInt) -> m (V2 CInt)
forall a b. (a -> b) -> a -> b
$
    (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt))
-> (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
wPtr ->
    (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt))
-> (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
hPtr -> do
        Window -> Ptr CInt -> Ptr CInt -> IO ()
forall (m :: Type -> Type).
MonadIO m =>
Window -> Ptr CInt -> Ptr CInt -> m ()
Raw.getWindowPosition Window
w Ptr CInt
wPtr Ptr CInt
hPtr
        CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
V2 (CInt -> CInt -> V2 CInt) -> IO CInt -> IO (CInt -> V2 CInt)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
wPtr IO (CInt -> V2 CInt) -> IO CInt -> IO (V2 CInt)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
hPtr

-- | Get the size of a window's borders (decorations) around the client area (top, left, bottom, right).
--
-- See @<https://wiki.libsdl.org/SDL_GetWindowBordersSize SDL_GetWindowBordersSize>@ for C documentation.
getWindowBordersSize :: MonadIO m => Window -> m (Maybe (V4 CInt))
getWindowBordersSize :: Window -> m (Maybe (V4 CInt))
getWindowBordersSize (Window Window
win) =
  IO (Maybe (V4 CInt)) -> m (Maybe (V4 CInt))
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (V4 CInt)) -> m (Maybe (V4 CInt)))
-> IO (Maybe (V4 CInt)) -> m (Maybe (V4 CInt))
forall a b. (a -> b) -> a -> b
$
  (Ptr CInt -> IO (Maybe (V4 CInt))) -> IO (Maybe (V4 CInt))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (V4 CInt))) -> IO (Maybe (V4 CInt)))
-> (Ptr CInt -> IO (Maybe (V4 CInt))) -> IO (Maybe (V4 CInt))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
tPtr ->
  (Ptr CInt -> IO (Maybe (V4 CInt))) -> IO (Maybe (V4 CInt))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (V4 CInt))) -> IO (Maybe (V4 CInt)))
-> (Ptr CInt -> IO (Maybe (V4 CInt))) -> IO (Maybe (V4 CInt))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
lPtr ->
  (Ptr CInt -> IO (Maybe (V4 CInt))) -> IO (Maybe (V4 CInt))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (V4 CInt))) -> IO (Maybe (V4 CInt)))
-> (Ptr CInt -> IO (Maybe (V4 CInt))) -> IO (Maybe (V4 CInt))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
bPtr ->
  (Ptr CInt -> IO (Maybe (V4 CInt))) -> IO (Maybe (V4 CInt))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (V4 CInt))) -> IO (Maybe (V4 CInt)))
-> (Ptr CInt -> IO (Maybe (V4 CInt))) -> IO (Maybe (V4 CInt))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
rPtr -> do
    CInt
n <- Window -> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO CInt
forall (m :: Type -> Type).
MonadIO m =>
Window -> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> m CInt
Raw.getWindowBordersSize Window
win Ptr CInt
tPtr Ptr CInt
lPtr Ptr CInt
bPtr Ptr CInt
rPtr
    if CInt
n CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
      then Maybe (V4 CInt) -> IO (Maybe (V4 CInt))
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (V4 CInt)
forall a. Maybe a
Nothing
      else (V4 CInt -> Maybe (V4 CInt))
-> IO (V4 CInt) -> IO (Maybe (V4 CInt))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap V4 CInt -> Maybe (V4 CInt)
forall a. a -> Maybe a
Just (IO (V4 CInt) -> IO (Maybe (V4 CInt)))
-> IO (V4 CInt) -> IO (Maybe (V4 CInt))
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> CInt -> CInt -> V4 CInt
forall a. a -> a -> a -> a -> V4 a
V4 (CInt -> CInt -> CInt -> CInt -> V4 CInt)
-> IO CInt -> IO (CInt -> CInt -> CInt -> V4 CInt)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
tPtr IO (CInt -> CInt -> CInt -> V4 CInt)
-> IO CInt -> IO (CInt -> CInt -> V4 CInt)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
lPtr IO (CInt -> CInt -> V4 CInt) -> IO CInt -> IO (CInt -> V4 CInt)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
bPtr IO (CInt -> V4 CInt) -> IO CInt -> IO (V4 CInt)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rPtr

-- | Get or set the size of a window's client area. Values beyond the maximum supported size are clamped.
--
-- If window was created with 'windowHighDPI' flag, this size may differ from the size in pixels.
-- Use 'glGetDrawableSize' or 'SDL.Video.Vulkan.vkGetDrawableSize' to get size in pixels.
--
-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'.
--
-- See @<https://wiki.libsdl.org/SDL_SetWindowSize SDL_SetWindowSize>@ and @<https://wiki.libsdl.org/SDL_GetWindowSize SDL_GetWindowSize>@ for C documentation.
windowSize :: Window -> StateVar (V2 CInt)
windowSize :: Window -> StateVar (V2 CInt)
windowSize (Window Window
win) = IO (V2 CInt) -> (V2 CInt -> IO ()) -> StateVar (V2 CInt)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO (V2 CInt)
getWindowSize V2 CInt -> IO ()
forall (m :: Type -> Type). MonadIO m => V2 CInt -> m ()
setWindowSize
  where
  setWindowSize :: V2 CInt -> m ()
setWindowSize (V2 CInt
w CInt
h) = Window -> CInt -> CInt -> m ()
forall (m :: Type -> Type).
MonadIO m =>
Window -> CInt -> CInt -> m ()
Raw.setWindowSize Window
win CInt
w CInt
h

  getWindowSize :: IO (V2 CInt)
getWindowSize =
    IO (V2 CInt) -> IO (V2 CInt)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (V2 CInt) -> IO (V2 CInt)) -> IO (V2 CInt) -> IO (V2 CInt)
forall a b. (a -> b) -> a -> b
$
    (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt))
-> (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
wptr ->
    (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt))
-> (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
hptr -> do
      Window -> Ptr CInt -> Ptr CInt -> IO ()
forall (m :: Type -> Type).
MonadIO m =>
Window -> Ptr CInt -> Ptr CInt -> m ()
Raw.getWindowSize Window
win Ptr CInt
wptr Ptr CInt
hptr
      CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
V2 (CInt -> CInt -> V2 CInt) -> IO CInt -> IO (CInt -> V2 CInt)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
wptr IO (CInt -> V2 CInt) -> IO CInt -> IO (V2 CInt)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
hptr

-- | Get or set the title of the window. If the window has no title, then an empty string is returned.
--
-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'.
--
-- See @<https://wiki.libsdl.org/SDL_SetWindowTitle SDL_SetWindowTitle>@ and @<https://wiki.libsdl.org/SDL_GetWindowTitle SDL_GetWindowTitle>@ for C documentation.
windowTitle :: Window -> StateVar Text
windowTitle :: Window -> StateVar Text
windowTitle (Window Window
w) = IO Text -> (Text -> IO ()) -> StateVar Text
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO Text
getWindowTitle Text -> IO ()
forall (m :: Type -> Type). MonadIO m => Text -> m ()
setWindowTitle
  where
  setWindowTitle :: Text -> m ()
setWindowTitle Text
title =
    IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
Text.encodeUtf8 Text
title) ((CString -> IO ()) -> m ()) -> (CString -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$
      Window -> CString -> IO ()
forall (m :: Type -> Type). MonadIO m => Window -> CString -> m ()
Raw.setWindowTitle Window
w

  getWindowTitle :: IO Text
getWindowTitle = IO Text -> IO Text
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Text -> IO Text) -> IO Text -> IO Text
forall a b. (a -> b) -> a -> b
$ do
      CString
cstr <- Window -> IO CString
forall (m :: Type -> Type). MonadIO m => Window -> m CString
Raw.getWindowTitle Window
w
      ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
BS.packCString CString
cstr

-- | Get or set the pointer to arbitrary user data associated with the given
-- window and name.
--
-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'.
windowData :: Window -> CString -> StateVar (Ptr ())
windowData :: Window -> CString -> StateVar Window
windowData (Window Window
w) CString
key = IO Window -> (Window -> IO ()) -> StateVar Window
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO Window
getWindowData Window -> IO ()
setWindowData
  where
  setWindowData :: Window -> IO ()
setWindowData = IO Window -> IO ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (IO Window -> IO ()) -> (Window -> IO Window) -> Window -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> CString -> Window -> IO Window
forall (m :: Type -> Type).
MonadIO m =>
Window -> CString -> Window -> m Window
Raw.setWindowData Window
w CString
key
  getWindowData :: IO Window
getWindowData = Window -> CString -> IO Window
forall (m :: Type -> Type).
MonadIO m =>
Window -> CString -> m Window
Raw.getWindowData Window
w CString
key

-- | Retrieve the configuration of the given window.
--
-- Note that 'NoGraphicsContext' will be returned instead of potential OpenGL parameters
-- used during the creation of the window.
getWindowConfig :: MonadIO m => Window -> m WindowConfig
getWindowConfig :: Window -> m WindowConfig
getWindowConfig (Window Window
w) = do
    Word32
wFlags <- Window -> m Word32
forall (m :: Type -> Type). MonadIO m => Window -> m Word32
Raw.getWindowFlags Window
w

    V2 CInt
wSize <- StateVar (V2 CInt) -> m (V2 CInt)
forall t a (m :: Type -> Type).
(HasGetter t a, MonadIO m) =>
t -> m a
get (Window -> StateVar (V2 CInt)
windowSize (Window -> Window
Window Window
w))
    V2 CInt
wPos  <- Window -> m (V2 CInt)
forall (m :: Type -> Type). MonadIO m => Window -> m (V2 CInt)
getWindowAbsolutePosition (Window -> Window
Window Window
w)

    WindowConfig -> m WindowConfig
forall (m :: Type -> Type) a. Monad m => a -> m a
return WindowConfig :: Bool
-> Bool
-> Bool
-> WindowMode
-> WindowGraphicsContext
-> WindowPosition
-> Bool
-> V2 CInt
-> Bool
-> WindowConfig
WindowConfig {
        windowBorder :: Bool
windowBorder          = Word32
wFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_BORDERLESS Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
      , windowHighDPI :: Bool
windowHighDPI         = Word32
wFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_ALLOW_HIGHDPI Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
      , windowInputGrabbed :: Bool
windowInputGrabbed    = Word32
wFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_INPUT_GRABBED Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
      , windowMode :: WindowMode
windowMode            = Word32 -> WindowMode
forall a b. FromNumber a b => b -> a
fromNumber Word32
wFlags
        -- Should we store the OpenGL config that was used to create the window?
      , windowGraphicsContext :: WindowGraphicsContext
windowGraphicsContext = if Word32
wFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_VULKAN Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
                                  then WindowGraphicsContext
VulkanContext else WindowGraphicsContext
NoGraphicsContext
      , windowPosition :: WindowPosition
windowPosition        = Point V2 CInt -> WindowPosition
Absolute (V2 CInt -> Point V2 CInt
forall (f :: Type -> Type) a. f a -> Point f a
P V2 CInt
wPos)
      , windowResizable :: Bool
windowResizable       = Word32
wFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_RESIZABLE Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
      , windowInitialSize :: V2 CInt
windowInitialSize     = V2 CInt
wSize
      , windowVisible :: Bool
windowVisible         = Word32
wFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
forall a. (Eq a, Num a) => a
Raw.SDL_WINDOW_SHOWN Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
    }

-- | Get the pixel format that is used for the given window.
getWindowPixelFormat :: MonadIO m => Window -> m PixelFormat
getWindowPixelFormat :: Window -> m PixelFormat
getWindowPixelFormat (Window Window
w) = PixelFormat -> m PixelFormat
forall (m :: Type -> Type) a. Monad m => a -> m a
return (PixelFormat -> m PixelFormat)
-> (Word32 -> PixelFormat) -> Word32 -> m PixelFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> PixelFormat
forall a b. FromNumber a b => b -> a
fromNumber (Word32 -> m PixelFormat) -> m Word32 -> m PixelFormat
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Window -> m Word32
forall (m :: Type -> Type). MonadIO m => Window -> m Word32
Raw.getWindowPixelFormat Window
w

-- | Get the text from the clipboard.
--
-- Throws 'SDLException' on failure.
getClipboardText :: MonadIO m => m Text
getClipboardText :: m Text
getClipboardText = IO Text -> m Text
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> (IO Text -> IO Text) -> IO Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Text -> IO Text
forall a. IO a -> IO a
mask_ (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
  CString
cstr <- Text -> Text -> IO CString -> IO CString
forall (m :: Type -> Type) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull Text
"SDL.Video.getClipboardText" Text
"SDL_GetClipboardText"
    IO CString
forall (m :: Type -> Type). MonadIO m => m CString
Raw.getClipboardText
  IO Text -> IO () -> IO Text
forall a b. IO a -> IO b -> IO a
finally (ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
BS.packCString CString
cstr) (CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cstr)

-- | Checks if the clipboard exists, and has some text in it.
hasClipboardText :: MonadIO m => m Bool
hasClipboardText :: m Bool
hasClipboardText = m Bool
forall (m :: Type -> Type). MonadIO m => m Bool
Raw.hasClipboardText

-- | Replace the contents of the clipboard with the given text.
--
-- Throws 'SDLException' on failure.
setClipboardText :: MonadIO m => Text -> m ()
setClipboardText :: Text -> m ()
setClipboardText Text
str = IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Text -> Text -> IO CInt -> IO ()
forall a (m :: Type -> Type).
(Eq a, MonadIO m, Num a) =>
Text -> Text -> m a -> m ()
throwIfNot0_ Text
"SDL.Video.setClipboardText" Text
"SDL_SetClipboardText" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> (CString -> IO CInt) -> IO CInt
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
Text.encodeUtf8 Text
str) CString -> IO CInt
forall (m :: Type -> Type). MonadIO m => CString -> m CInt
Raw.setClipboardText

-- | Hide a window.
--
-- See @<https://wiki.libsdl.org/SDL_HideWindow SDL_HideWindow>@ for C documentation.
hideWindow :: MonadIO m => Window -> m ()
hideWindow :: Window -> m ()
hideWindow (Window Window
w) = Window -> m ()
forall (m :: Type -> Type). MonadIO m => Window -> m ()
Raw.hideWindow Window
w

-- | Raise the window above other windows and set the input focus.
--
-- See @<https://wiki.libsdl.org/SDL_RaiseWindow SDL_RaiseWindow>@ for C documentation.
raiseWindow :: MonadIO m => Window -> m ()
raiseWindow :: Window -> m ()
raiseWindow (Window Window
w) = Window -> m ()
forall (m :: Type -> Type). MonadIO m => Window -> m ()
Raw.raiseWindow Window
w

-- | Get or set whether to allow the screen to be blanked by a screen saver.
--
-- Screen savers are re-enabled, if needed, when SDL quits.
screenSaverEnabled :: StateVar Bool
screenSaverEnabled :: StateVar Bool
screenSaverEnabled = IO Bool -> (Bool -> IO ()) -> StateVar Bool
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar (IO Bool
isScreenSaverEnabled) (Bool -> IO ()
forall (m :: Type -> Type). MonadIO m => Bool -> m ()
setScreenSaverEnabled)
  where
  isScreenSaverEnabled :: IO Bool
isScreenSaverEnabled = IO Bool
forall (m :: Type -> Type). MonadIO m => m Bool
Raw.isScreenSaverEnabled

  setScreenSaverEnabled :: Bool -> m ()
setScreenSaverEnabled Bool
True = m ()
forall (m :: Type -> Type). MonadIO m => m ()
Raw.enableScreenSaver
  setScreenSaverEnabled Bool
False = m ()
forall (m :: Type -> Type). MonadIO m => m ()
Raw.disableScreenSaver

-- | Show a window.
--
-- See @<https://wiki.libsdl.org/SDL_ShowWindow SDL_ShowWindow>@ for C documentation.
showWindow :: MonadIO m => Window -> m ()
showWindow :: Window -> m ()
showWindow (Window Window
w) = Window -> m ()
forall (m :: Type -> Type). MonadIO m => Window -> m ()
Raw.showWindow Window
w

-- | Gets or sets the gamma ramp for the display that owns a given window.
--
-- Note that the data for the gamma ramp - the 'V3' ('SV.Vector' 'Word16') - must contain 256 element arrays. This triple is a set of translation vectors for each of the 16-bit red, green and blue channels.
--
-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'.
--
-- Despite the name and signature, this method retrieves the gamma ramp of the entire display, not an individual window. A window is considered to be owned by the display that contains the window's center pixel.
windowGammaRamp :: Window -> StateVar (V3 (SV.Vector Word16))
windowGammaRamp :: Window -> StateVar (V3 (Vector Word16))
windowGammaRamp (Window Window
w) = IO (V3 (Vector Word16))
-> (V3 (Vector Word16) -> IO ()) -> StateVar (V3 (Vector Word16))
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO (V3 (Vector Word16))
getWindowGammaRamp V3 (Vector Word16) -> IO ()
forall (m :: Type -> Type). MonadIO m => V3 (Vector Word16) -> m ()
setWindowGammaRamp
  where
  getWindowGammaRamp :: IO (V3 (Vector Word16))
getWindowGammaRamp =
    Int
-> (Ptr Word16 -> IO (V3 (Vector Word16)))
-> IO (V3 (Vector Word16))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
256 ((Ptr Word16 -> IO (V3 (Vector Word16)))
 -> IO (V3 (Vector Word16)))
-> (Ptr Word16 -> IO (V3 (Vector Word16)))
-> IO (V3 (Vector Word16))
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
rPtr ->
    Int
-> (Ptr Word16 -> IO (V3 (Vector Word16)))
-> IO (V3 (Vector Word16))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
256 ((Ptr Word16 -> IO (V3 (Vector Word16)))
 -> IO (V3 (Vector Word16)))
-> (Ptr Word16 -> IO (V3 (Vector Word16)))
-> IO (V3 (Vector Word16))
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
gPtr ->
    Int
-> (Ptr Word16 -> IO (V3 (Vector Word16)))
-> IO (V3 (Vector Word16))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
256 ((Ptr Word16 -> IO (V3 (Vector Word16)))
 -> IO (V3 (Vector Word16)))
-> (Ptr Word16 -> IO (V3 (Vector Word16)))
-> IO (V3 (Vector Word16))
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
bPtr -> do
      Text -> Text -> IO CInt -> IO ()
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m ()
throwIfNeg_ Text
"SDL.Video.getWindowGammaRamp" Text
"SDL_GetWindowGammaRamp"
        (Window -> Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> IO CInt
forall (m :: Type -> Type).
MonadIO m =>
Window -> Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> m CInt
Raw.getWindowGammaRamp Window
w Ptr Word16
rPtr Ptr Word16
gPtr Ptr Word16
bPtr)
      (Vector Word16
 -> Vector Word16 -> Vector Word16 -> V3 (Vector Word16))
-> IO (Vector Word16)
-> IO (Vector Word16)
-> IO (Vector Word16)
-> IO (V3 (Vector Word16))
forall (f :: Type -> Type) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Vector Word16
-> Vector Word16 -> Vector Word16 -> V3 (Vector Word16)
forall a. a -> a -> a -> V3 a
V3 (([Word16] -> Vector Word16) -> IO [Word16] -> IO (Vector Word16)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word16] -> Vector Word16
forall a. Storable a => [a] -> Vector a
SV.fromList (Int -> Ptr Word16 -> IO [Word16]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
256 Ptr Word16
rPtr))
                (([Word16] -> Vector Word16) -> IO [Word16] -> IO (Vector Word16)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word16] -> Vector Word16
forall a. Storable a => [a] -> Vector a
SV.fromList (Int -> Ptr Word16 -> IO [Word16]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
256 Ptr Word16
gPtr))
                (([Word16] -> Vector Word16) -> IO [Word16] -> IO (Vector Word16)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word16] -> Vector Word16
forall a. Storable a => [a] -> Vector a
SV.fromList (Int -> Ptr Word16 -> IO [Word16]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
256 Ptr Word16
bPtr))


  setWindowGammaRamp :: V3 (Vector Word16) -> m ()
setWindowGammaRamp (V3 Vector Word16
r Vector Word16
g Vector Word16
b) = IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless ((Vector Word16 -> Bool) -> [Vector Word16] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
256) (Int -> Bool) -> (Vector Word16 -> Int) -> Vector Word16 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word16 -> Int
forall a. Storable a => Vector a -> Int
SV.length) [Vector Word16
r,Vector Word16
g,Vector Word16
b]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> IO ()
forall a. HasCallStack => String -> a
error String
"setWindowGammaRamp requires 256 element in each colour channel"

    Vector Word16 -> (Ptr Word16 -> IO ()) -> IO ()
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
SV.unsafeWith Vector Word16
r ((Ptr Word16 -> IO ()) -> IO ()) -> (Ptr Word16 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
rPtr ->
      Vector Word16 -> (Ptr Word16 -> IO ()) -> IO ()
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
SV.unsafeWith Vector Word16
b ((Ptr Word16 -> IO ()) -> IO ()) -> (Ptr Word16 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
bPtr ->
        Vector Word16 -> (Ptr Word16 -> IO ()) -> IO ()
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
SV.unsafeWith Vector Word16
g ((Ptr Word16 -> IO ()) -> IO ()) -> (Ptr Word16 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
gPtr ->
          Text -> Text -> IO CInt -> IO ()
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m ()
throwIfNeg_ Text
"SDL.Video.setWindowGammaRamp" Text
"SDL_SetWindowGammaRamp" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
            Window -> Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> IO CInt
forall (m :: Type -> Type).
MonadIO m =>
Window -> Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> m CInt
Raw.setWindowGammaRamp Window
w Ptr Word16
rPtr Ptr Word16
gPtr Ptr Word16
bPtr

data Display = Display {
               Display -> String
displayName           :: String
             , Display -> Point V2 CInt
displayBoundsPosition :: Point V2 CInt
                 -- ^ Position of the desktop area represented by the display,
                 -- with the primary display located at @(0, 0)@.
             , Display -> V2 CInt
displayBoundsSize     :: V2 CInt
                 -- ^ Size of the desktop area represented by the display.
             , Display -> [DisplayMode]
displayModes          :: [DisplayMode]
             }
             deriving (Display -> Display -> Bool
(Display -> Display -> Bool)
-> (Display -> Display -> Bool) -> Eq Display
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Display -> Display -> Bool
$c/= :: Display -> Display -> Bool
== :: Display -> Display -> Bool
$c== :: Display -> Display -> Bool
Eq, (forall x. Display -> Rep Display x)
-> (forall x. Rep Display x -> Display) -> Generic Display
forall x. Rep Display x -> Display
forall x. Display -> Rep Display x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Display x -> Display
$cfrom :: forall x. Display -> Rep Display x
Generic, Eq Display
Eq Display
-> (Display -> Display -> Ordering)
-> (Display -> Display -> Bool)
-> (Display -> Display -> Bool)
-> (Display -> Display -> Bool)
-> (Display -> Display -> Bool)
-> (Display -> Display -> Display)
-> (Display -> Display -> Display)
-> Ord Display
Display -> Display -> Bool
Display -> Display -> Ordering
Display -> Display -> Display
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 :: Display -> Display -> Display
$cmin :: Display -> Display -> Display
max :: Display -> Display -> Display
$cmax :: Display -> Display -> Display
>= :: Display -> Display -> Bool
$c>= :: Display -> Display -> Bool
> :: Display -> Display -> Bool
$c> :: Display -> Display -> Bool
<= :: Display -> Display -> Bool
$c<= :: Display -> Display -> Bool
< :: Display -> Display -> Bool
$c< :: Display -> Display -> Bool
compare :: Display -> Display -> Ordering
$ccompare :: Display -> Display -> Ordering
$cp1Ord :: Eq Display
Ord, ReadPrec [Display]
ReadPrec Display
Int -> ReadS Display
ReadS [Display]
(Int -> ReadS Display)
-> ReadS [Display]
-> ReadPrec Display
-> ReadPrec [Display]
-> Read Display
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Display]
$creadListPrec :: ReadPrec [Display]
readPrec :: ReadPrec Display
$creadPrec :: ReadPrec Display
readList :: ReadS [Display]
$creadList :: ReadS [Display]
readsPrec :: Int -> ReadS Display
$creadsPrec :: Int -> ReadS Display
Read, Int -> Display -> ShowS
[Display] -> ShowS
Display -> String
(Int -> Display -> ShowS)
-> (Display -> String) -> ([Display] -> ShowS) -> Show Display
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Display] -> ShowS
$cshowList :: [Display] -> ShowS
show :: Display -> String
$cshow :: Display -> String
showsPrec :: Int -> Display -> ShowS
$cshowsPrec :: Int -> Display -> ShowS
Show, Typeable)

data DisplayMode = DisplayMode {
                   DisplayMode -> PixelFormat
displayModeFormat      :: PixelFormat
                 , DisplayMode -> V2 CInt
displayModeSize        :: V2 CInt
                 , DisplayMode -> CInt
displayModeRefreshRate :: CInt -- ^ Display's refresh rate in hertz, or @0@ if unspecified.
                 }
                 deriving (DisplayMode -> DisplayMode -> Bool
(DisplayMode -> DisplayMode -> Bool)
-> (DisplayMode -> DisplayMode -> Bool) -> Eq DisplayMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayMode -> DisplayMode -> Bool
$c/= :: DisplayMode -> DisplayMode -> Bool
== :: DisplayMode -> DisplayMode -> Bool
$c== :: DisplayMode -> DisplayMode -> Bool
Eq, (forall x. DisplayMode -> Rep DisplayMode x)
-> (forall x. Rep DisplayMode x -> DisplayMode)
-> Generic DisplayMode
forall x. Rep DisplayMode x -> DisplayMode
forall x. DisplayMode -> Rep DisplayMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DisplayMode x -> DisplayMode
$cfrom :: forall x. DisplayMode -> Rep DisplayMode x
Generic, Eq DisplayMode
Eq DisplayMode
-> (DisplayMode -> DisplayMode -> Ordering)
-> (DisplayMode -> DisplayMode -> Bool)
-> (DisplayMode -> DisplayMode -> Bool)
-> (DisplayMode -> DisplayMode -> Bool)
-> (DisplayMode -> DisplayMode -> Bool)
-> (DisplayMode -> DisplayMode -> DisplayMode)
-> (DisplayMode -> DisplayMode -> DisplayMode)
-> Ord DisplayMode
DisplayMode -> DisplayMode -> Bool
DisplayMode -> DisplayMode -> Ordering
DisplayMode -> DisplayMode -> DisplayMode
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 :: DisplayMode -> DisplayMode -> DisplayMode
$cmin :: DisplayMode -> DisplayMode -> DisplayMode
max :: DisplayMode -> DisplayMode -> DisplayMode
$cmax :: DisplayMode -> DisplayMode -> DisplayMode
>= :: DisplayMode -> DisplayMode -> Bool
$c>= :: DisplayMode -> DisplayMode -> Bool
> :: DisplayMode -> DisplayMode -> Bool
$c> :: DisplayMode -> DisplayMode -> Bool
<= :: DisplayMode -> DisplayMode -> Bool
$c<= :: DisplayMode -> DisplayMode -> Bool
< :: DisplayMode -> DisplayMode -> Bool
$c< :: DisplayMode -> DisplayMode -> Bool
compare :: DisplayMode -> DisplayMode -> Ordering
$ccompare :: DisplayMode -> DisplayMode -> Ordering
$cp1Ord :: Eq DisplayMode
Ord, ReadPrec [DisplayMode]
ReadPrec DisplayMode
Int -> ReadS DisplayMode
ReadS [DisplayMode]
(Int -> ReadS DisplayMode)
-> ReadS [DisplayMode]
-> ReadPrec DisplayMode
-> ReadPrec [DisplayMode]
-> Read DisplayMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisplayMode]
$creadListPrec :: ReadPrec [DisplayMode]
readPrec :: ReadPrec DisplayMode
$creadPrec :: ReadPrec DisplayMode
readList :: ReadS [DisplayMode]
$creadList :: ReadS [DisplayMode]
readsPrec :: Int -> ReadS DisplayMode
$creadsPrec :: Int -> ReadS DisplayMode
Read, Int -> DisplayMode -> ShowS
[DisplayMode] -> ShowS
DisplayMode -> String
(Int -> DisplayMode -> ShowS)
-> (DisplayMode -> String)
-> ([DisplayMode] -> ShowS)
-> Show DisplayMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisplayMode] -> ShowS
$cshowList :: [DisplayMode] -> ShowS
show :: DisplayMode -> String
$cshow :: DisplayMode -> String
showsPrec :: Int -> DisplayMode -> ShowS
$cshowsPrec :: Int -> DisplayMode -> ShowS
Show, Typeable)

data VideoDriver = VideoDriver {
                   VideoDriver -> String
videoDriverName :: String
                 }
                 deriving (Typeable VideoDriver
DataType
Constr
Typeable VideoDriver
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> VideoDriver -> c VideoDriver)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c VideoDriver)
-> (VideoDriver -> Constr)
-> (VideoDriver -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c VideoDriver))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c VideoDriver))
-> ((forall b. Data b => b -> b) -> VideoDriver -> VideoDriver)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> VideoDriver -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> VideoDriver -> r)
-> (forall u. (forall d. Data d => d -> u) -> VideoDriver -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> VideoDriver -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> VideoDriver -> m VideoDriver)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> VideoDriver -> m VideoDriver)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> VideoDriver -> m VideoDriver)
-> Data VideoDriver
VideoDriver -> DataType
VideoDriver -> Constr
(forall b. Data b => b -> b) -> VideoDriver -> VideoDriver
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VideoDriver -> c VideoDriver
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VideoDriver
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) -> VideoDriver -> u
forall u. (forall d. Data d => d -> u) -> VideoDriver -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VideoDriver -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VideoDriver -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> VideoDriver -> m VideoDriver
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VideoDriver -> m VideoDriver
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VideoDriver
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VideoDriver -> c VideoDriver
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VideoDriver)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VideoDriver)
$cVideoDriver :: Constr
$tVideoDriver :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> VideoDriver -> m VideoDriver
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VideoDriver -> m VideoDriver
gmapMp :: (forall d. Data d => d -> m d) -> VideoDriver -> m VideoDriver
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VideoDriver -> m VideoDriver
gmapM :: (forall d. Data d => d -> m d) -> VideoDriver -> m VideoDriver
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> VideoDriver -> m VideoDriver
gmapQi :: Int -> (forall d. Data d => d -> u) -> VideoDriver -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> VideoDriver -> u
gmapQ :: (forall d. Data d => d -> u) -> VideoDriver -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> VideoDriver -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VideoDriver -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VideoDriver -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VideoDriver -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VideoDriver -> r
gmapT :: (forall b. Data b => b -> b) -> VideoDriver -> VideoDriver
$cgmapT :: (forall b. Data b => b -> b) -> VideoDriver -> VideoDriver
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VideoDriver)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VideoDriver)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c VideoDriver)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VideoDriver)
dataTypeOf :: VideoDriver -> DataType
$cdataTypeOf :: VideoDriver -> DataType
toConstr :: VideoDriver -> Constr
$ctoConstr :: VideoDriver -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VideoDriver
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VideoDriver
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VideoDriver -> c VideoDriver
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VideoDriver -> c VideoDriver
$cp1Data :: Typeable VideoDriver
Data, VideoDriver -> VideoDriver -> Bool
(VideoDriver -> VideoDriver -> Bool)
-> (VideoDriver -> VideoDriver -> Bool) -> Eq VideoDriver
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoDriver -> VideoDriver -> Bool
$c/= :: VideoDriver -> VideoDriver -> Bool
== :: VideoDriver -> VideoDriver -> Bool
$c== :: VideoDriver -> VideoDriver -> Bool
Eq, (forall x. VideoDriver -> Rep VideoDriver x)
-> (forall x. Rep VideoDriver x -> VideoDriver)
-> Generic VideoDriver
forall x. Rep VideoDriver x -> VideoDriver
forall x. VideoDriver -> Rep VideoDriver x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VideoDriver x -> VideoDriver
$cfrom :: forall x. VideoDriver -> Rep VideoDriver x
Generic, Eq VideoDriver
Eq VideoDriver
-> (VideoDriver -> VideoDriver -> Ordering)
-> (VideoDriver -> VideoDriver -> Bool)
-> (VideoDriver -> VideoDriver -> Bool)
-> (VideoDriver -> VideoDriver -> Bool)
-> (VideoDriver -> VideoDriver -> Bool)
-> (VideoDriver -> VideoDriver -> VideoDriver)
-> (VideoDriver -> VideoDriver -> VideoDriver)
-> Ord VideoDriver
VideoDriver -> VideoDriver -> Bool
VideoDriver -> VideoDriver -> Ordering
VideoDriver -> VideoDriver -> VideoDriver
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 :: VideoDriver -> VideoDriver -> VideoDriver
$cmin :: VideoDriver -> VideoDriver -> VideoDriver
max :: VideoDriver -> VideoDriver -> VideoDriver
$cmax :: VideoDriver -> VideoDriver -> VideoDriver
>= :: VideoDriver -> VideoDriver -> Bool
$c>= :: VideoDriver -> VideoDriver -> Bool
> :: VideoDriver -> VideoDriver -> Bool
$c> :: VideoDriver -> VideoDriver -> Bool
<= :: VideoDriver -> VideoDriver -> Bool
$c<= :: VideoDriver -> VideoDriver -> Bool
< :: VideoDriver -> VideoDriver -> Bool
$c< :: VideoDriver -> VideoDriver -> Bool
compare :: VideoDriver -> VideoDriver -> Ordering
$ccompare :: VideoDriver -> VideoDriver -> Ordering
$cp1Ord :: Eq VideoDriver
Ord, ReadPrec [VideoDriver]
ReadPrec VideoDriver
Int -> ReadS VideoDriver
ReadS [VideoDriver]
(Int -> ReadS VideoDriver)
-> ReadS [VideoDriver]
-> ReadPrec VideoDriver
-> ReadPrec [VideoDriver]
-> Read VideoDriver
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VideoDriver]
$creadListPrec :: ReadPrec [VideoDriver]
readPrec :: ReadPrec VideoDriver
$creadPrec :: ReadPrec VideoDriver
readList :: ReadS [VideoDriver]
$creadList :: ReadS [VideoDriver]
readsPrec :: Int -> ReadS VideoDriver
$creadsPrec :: Int -> ReadS VideoDriver
Read, Int -> VideoDriver -> ShowS
[VideoDriver] -> ShowS
VideoDriver -> String
(Int -> VideoDriver -> ShowS)
-> (VideoDriver -> String)
-> ([VideoDriver] -> ShowS)
-> Show VideoDriver
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoDriver] -> ShowS
$cshowList :: [VideoDriver] -> ShowS
show :: VideoDriver -> String
$cshow :: VideoDriver -> String
showsPrec :: Int -> VideoDriver -> ShowS
$cshowsPrec :: Int -> VideoDriver -> ShowS
Show, Typeable)

-- | Throws 'SDLException' on failure.
getDisplays :: MonadIO m => m [Display]
getDisplays :: m [Display]
getDisplays = IO [Display] -> m [Display]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Display] -> m [Display]) -> IO [Display] -> m [Display]
forall a b. (a -> b) -> a -> b
$ do
  CInt
numDisplays <- Text -> Text -> IO CInt -> IO CInt
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m a
throwIfNeg Text
"SDL.Video.getDisplays" Text
"SDL_GetNumVideoDisplays"
    IO CInt
forall (m :: Type -> Type). MonadIO m => m CInt
Raw.getNumVideoDisplays

  [CInt] -> (CInt -> IO Display) -> IO [Display]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [CInt
0..CInt
numDisplays CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1] ((CInt -> IO Display) -> IO [Display])
-> (CInt -> IO Display) -> IO [Display]
forall a b. (a -> b) -> a -> b
$ \CInt
displayId -> do
    CString
name <- Text -> Text -> IO CString -> IO CString
forall (m :: Type -> Type) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull Text
"SDL.Video.getDisplays" Text
"SDL_GetDisplayName" (IO CString -> IO CString) -> IO CString -> IO CString
forall a b. (a -> b) -> a -> b
$
        CInt -> IO CString
forall (m :: Type -> Type). MonadIO m => CInt -> m CString
Raw.getDisplayName CInt
displayId

    String
name' <- CString -> IO String
peekCString CString
name

    Raw.Rect CInt
x CInt
y CInt
w CInt
h <- (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
rect -> do
      Text -> Text -> IO CInt -> IO ()
forall a (m :: Type -> Type).
(Eq a, MonadIO m, Num a) =>
Text -> Text -> m a -> m ()
throwIfNot0_ Text
"SDL.Video.getDisplays" Text
"SDL_GetDisplayBounds" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
        CInt -> Ptr Rect -> IO CInt
forall (m :: Type -> Type). MonadIO m => CInt -> Ptr Rect -> m CInt
Raw.getDisplayBounds CInt
displayId Ptr Rect
rect
      Ptr Rect -> IO Rect
forall a. Storable a => Ptr a -> IO a
peek Ptr Rect
rect

    CInt
numModes <- Text -> Text -> IO CInt -> IO CInt
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m a
throwIfNeg Text
"SDL.Video.getDisplays" Text
"SDL_GetNumDisplayModes" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
      CInt -> IO CInt
forall (m :: Type -> Type). MonadIO m => CInt -> m CInt
Raw.getNumDisplayModes CInt
displayId

    [DisplayMode]
modes <- [CInt] -> (CInt -> IO DisplayMode) -> IO [DisplayMode]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [CInt
0..CInt
numModes CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1] ((CInt -> IO DisplayMode) -> IO [DisplayMode])
-> (CInt -> IO DisplayMode) -> IO [DisplayMode]
forall a b. (a -> b) -> a -> b
$ \CInt
modeId -> do
      Raw.DisplayMode Word32
format CInt
w' CInt
h' CInt
refreshRate Window
_ <- (Ptr DisplayMode -> IO DisplayMode) -> IO DisplayMode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr DisplayMode -> IO DisplayMode) -> IO DisplayMode)
-> (Ptr DisplayMode -> IO DisplayMode) -> IO DisplayMode
forall a b. (a -> b) -> a -> b
$ \Ptr DisplayMode
mode -> do
        Text -> Text -> IO CInt -> IO ()
forall a (m :: Type -> Type).
(Eq a, MonadIO m, Num a) =>
Text -> Text -> m a -> m ()
throwIfNot0_ Text
"SDL.Video.getDisplays" Text
"SDL_GetDisplayMode" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
          CInt -> CInt -> Ptr DisplayMode -> IO CInt
forall (m :: Type -> Type).
MonadIO m =>
CInt -> CInt -> Ptr DisplayMode -> m CInt
Raw.getDisplayMode CInt
displayId CInt
modeId Ptr DisplayMode
mode
        Ptr DisplayMode -> IO DisplayMode
forall a. Storable a => Ptr a -> IO a
peek Ptr DisplayMode
mode

      DisplayMode -> IO DisplayMode
forall (m :: Type -> Type) a. Monad m => a -> m a
return (DisplayMode -> IO DisplayMode) -> DisplayMode -> IO DisplayMode
forall a b. (a -> b) -> a -> b
$ DisplayMode :: PixelFormat -> V2 CInt -> CInt -> DisplayMode
DisplayMode {
          displayModeFormat :: PixelFormat
displayModeFormat = Word32 -> PixelFormat
forall a b. FromNumber a b => b -> a
fromNumber Word32
format
        , displayModeSize :: V2 CInt
displayModeSize = CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
V2 CInt
w' CInt
h'
        , displayModeRefreshRate :: CInt
displayModeRefreshRate = CInt
refreshRate
      }

    Display -> IO Display
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Display -> IO Display) -> Display -> IO Display
forall a b. (a -> b) -> a -> b
$ Display :: String -> Point V2 CInt -> V2 CInt -> [DisplayMode] -> Display
Display {
        displayName :: String
displayName = String
name'
      , displayBoundsPosition :: Point V2 CInt
displayBoundsPosition = V2 CInt -> Point V2 CInt
forall (f :: Type -> Type) a. f a -> Point f a
P (CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
V2 CInt
x CInt
y)
      , displayBoundsSize :: V2 CInt
displayBoundsSize = CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
V2 CInt
w CInt
h
      , displayModes :: [DisplayMode]
displayModes = [DisplayMode]
modes
    }

-- | Show a simple message box with the given title and a message. Consider
-- writing your messages to @stderr@ too.
--
-- Throws 'SDLException' if there are no available video targets.
showSimpleMessageBox :: MonadIO m => Maybe Window -> MessageKind -> Text -> Text -> m ()
showSimpleMessageBox :: Maybe Window -> MessageKind -> Text -> Text -> m ()
showSimpleMessageBox Maybe Window
window MessageKind
kind Text
title Text
message =
  IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (IO CInt -> IO ()) -> IO CInt -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> IO CInt -> IO ()
forall a (m :: Type -> Type).
(Eq a, MonadIO m, Num a) =>
Text -> Text -> m a -> m ()
throwIfNot0_ Text
"SDL.Video.showSimpleMessageBox" Text
"SDL_ShowSimpleMessageBox" (IO CInt -> m ()) -> IO CInt -> m ()
forall a b. (a -> b) -> a -> b
$ do
    ByteString -> (CString -> IO CInt) -> IO CInt
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
Text.encodeUtf8 Text
title) ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
title' ->
      ByteString -> (CString -> IO CInt) -> IO CInt
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
Text.encodeUtf8 Text
message) ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
message' ->
        Word32 -> CString -> CString -> Window -> IO CInt
forall (m :: Type -> Type).
MonadIO m =>
Word32 -> CString -> CString -> Window -> m CInt
Raw.showSimpleMessageBox (MessageKind -> Word32
forall a b. ToNumber a b => a -> b
toNumber MessageKind
kind) CString
title' CString
message' (Window -> IO CInt) -> Window -> IO CInt
forall a b. (a -> b) -> a -> b
$
          Maybe Window -> Window
windowId Maybe Window
window
  where
    windowId :: Maybe Window -> Window
windowId (Just (Window Window
w)) = Window
w
    windowId Maybe Window
Nothing = Window
forall a. Ptr a
nullPtr

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

instance ToNumber MessageKind Word32 where
  toNumber :: MessageKind -> Word32
toNumber MessageKind
Error = Word32
forall a. (Eq a, Num a) => a
Raw.SDL_MESSAGEBOX_ERROR
  toNumber MessageKind
Warning = Word32
forall a. (Eq a, Num a) => a
Raw.SDL_MESSAGEBOX_WARNING
  toNumber MessageKind
Information = Word32
forall a. (Eq a, Num a) => a
Raw.SDL_MESSAGEBOX_INFORMATION

-- | Get or set the maximum size of a window's client area.
--
-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'.
--
-- See @<https://wiki.libsdl.org/SDL_SetWindowMaximumSize SDL_SetWindowMaximumSize>@ and @<https://wiki.libsdl.org/SDL_GetWindowMaximumSize SDL_GetWindowMaximumSize>@ for C documentation.
windowMaximumSize :: Window -> StateVar (V2 CInt)
windowMaximumSize :: Window -> StateVar (V2 CInt)
windowMaximumSize (Window Window
win) = IO (V2 CInt) -> (V2 CInt -> IO ()) -> StateVar (V2 CInt)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO (V2 CInt)
getWindowMaximumSize V2 CInt -> IO ()
forall (m :: Type -> Type). MonadIO m => V2 CInt -> m ()
setWindowMaximumSize
  where
  setWindowMaximumSize :: V2 CInt -> m ()
setWindowMaximumSize (V2 CInt
w CInt
h) = Window -> CInt -> CInt -> m ()
forall (m :: Type -> Type).
MonadIO m =>
Window -> CInt -> CInt -> m ()
Raw.setWindowMaximumSize Window
win CInt
w CInt
h

  getWindowMaximumSize :: IO (V2 CInt)
getWindowMaximumSize =
    IO (V2 CInt) -> IO (V2 CInt)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (V2 CInt) -> IO (V2 CInt)) -> IO (V2 CInt) -> IO (V2 CInt)
forall a b. (a -> b) -> a -> b
$
    (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt))
-> (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
wptr ->
    (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt))
-> (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
hptr -> do
      Window -> Ptr CInt -> Ptr CInt -> IO ()
forall (m :: Type -> Type).
MonadIO m =>
Window -> Ptr CInt -> Ptr CInt -> m ()
Raw.getWindowMaximumSize Window
win Ptr CInt
wptr Ptr CInt
hptr
      CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
V2 (CInt -> CInt -> V2 CInt) -> IO CInt -> IO (CInt -> V2 CInt)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
wptr IO (CInt -> V2 CInt) -> IO CInt -> IO (V2 CInt)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
hptr

-- | Get or set the minimum size of a window's client area.
--
-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'.
--
-- See @<https://wiki.libsdl.org/SDL_SetWindowMinimumSize SDL_SetWindowMinimumSize>@ and @<https://wiki.libsdl.org/SDL_GetWindowMinimumSize SDL_GetWindowMinimumSize>@ for C documentation.
windowMinimumSize :: Window -> StateVar (V2 CInt)
windowMinimumSize :: Window -> StateVar (V2 CInt)
windowMinimumSize (Window Window
win) = IO (V2 CInt) -> (V2 CInt -> IO ()) -> StateVar (V2 CInt)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO (V2 CInt)
getWindowMinimumSize V2 CInt -> IO ()
forall (m :: Type -> Type). MonadIO m => V2 CInt -> m ()
setWindowMinimumSize
  where
  setWindowMinimumSize :: V2 CInt -> m ()
setWindowMinimumSize (V2 CInt
w CInt
h) = Window -> CInt -> CInt -> m ()
forall (m :: Type -> Type).
MonadIO m =>
Window -> CInt -> CInt -> m ()
Raw.setWindowMinimumSize Window
win CInt
w CInt
h

  getWindowMinimumSize :: IO (V2 CInt)
getWindowMinimumSize =
    IO (V2 CInt) -> IO (V2 CInt)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (V2 CInt) -> IO (V2 CInt)) -> IO (V2 CInt) -> IO (V2 CInt)
forall a b. (a -> b) -> a -> b
$
    (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt))
-> (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
wptr ->
    (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt))
-> (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
hptr -> do
      Window -> Ptr CInt -> Ptr CInt -> IO ()
forall (m :: Type -> Type).
MonadIO m =>
Window -> Ptr CInt -> Ptr CInt -> m ()
Raw.getWindowMinimumSize Window
win Ptr CInt
wptr Ptr CInt
hptr
      CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
V2 (CInt -> CInt -> V2 CInt) -> IO CInt -> IO (CInt -> V2 CInt)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
wptr IO (CInt -> V2 CInt) -> IO CInt -> IO (V2 CInt)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
hptr

createRenderer :: MonadIO m => Window -> CInt -> RendererConfig -> m Renderer
createRenderer :: Window -> CInt -> RendererConfig -> m Renderer
createRenderer (Window Window
w) CInt
driver RendererConfig
config =
  IO Renderer -> m Renderer
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Renderer -> m Renderer)
-> (IO Window -> IO Renderer) -> IO Window -> m Renderer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> Renderer) -> IO Window -> IO Renderer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Window -> Renderer
Renderer (IO Window -> m Renderer) -> IO Window -> m Renderer
forall a b. (a -> b) -> a -> b
$
    Text -> Text -> IO Window -> IO Window
forall (m :: Type -> Type) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull Text
"SDL.Video.createRenderer" Text
"SDL_CreateRenderer" (IO Window -> IO Window) -> IO Window -> IO Window
forall a b. (a -> b) -> a -> b
$
    Window -> CInt -> Word32 -> IO Window
forall (m :: Type -> Type).
MonadIO m =>
Window -> CInt -> Word32 -> m Window
Raw.createRenderer Window
w CInt
driver (RendererConfig -> Word32
forall a b. ToNumber a b => a -> b
toNumber RendererConfig
config)

-- | Create a 2D software rendering context for the given surface.
--
-- See @<https://wiki.libsdl.org/SDL_CreateSoftwareRenderer>@
createSoftwareRenderer :: MonadIO m => Surface -> m Renderer
createSoftwareRenderer :: Surface -> m Renderer
createSoftwareRenderer (Surface Ptr Surface
ptr Maybe (IOVector Word8)
_) =
  IO Renderer -> m Renderer
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Renderer -> m Renderer)
-> (IO Window -> IO Renderer) -> IO Window -> m Renderer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> Renderer) -> IO Window -> IO Renderer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Window -> Renderer
Renderer (IO Window -> m Renderer) -> IO Window -> m Renderer
forall a b. (a -> b) -> a -> b
$
    Text -> Text -> IO Window -> IO Window
forall (m :: Type -> Type) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull Text
"SDL.Video.createSoftwareRenderer" Text
"SDL_CreateSoftwareRenderer" (IO Window -> IO Window) -> IO Window -> IO Window
forall a b. (a -> b) -> a -> b
$
    Ptr Surface -> IO Window
forall (m :: Type -> Type). MonadIO m => Ptr Surface -> m Window
Raw.createSoftwareRenderer Ptr Surface
ptr

destroyRenderer :: MonadIO m => Renderer -> m ()
destroyRenderer :: Renderer -> m ()
destroyRenderer (Renderer Window
r) = Window -> m ()
forall (m :: Type -> Type). MonadIO m => Window -> m ()
Raw.destroyRenderer Window
r