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


{-# LINE 5 "Graphics/UI/SDL/WindowManagement.hsc" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.SDL.WindowManagement
-- Copyright   :  (c) David Himmelstrup 2005
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-----------------------------------------------------------------------------
module Graphics.UI.SDL.WindowManagement
    ( GrabMode (..)
    , setCaption
    , rawSetCaption
    , getCaption
    , iconifyWindow
    , tryToggleFullscreen
    , toggleFullscreen
    , grabInput
    , queryGrabMode
    ) where

import Control.Monad (void)
import Foreign (Int32, Ptr, Storable(peek), nullPtr, toBool, maybePeek,
                alloca, withForeignPtr)
import Foreign.C (withCString, peekCString, CString)

import Graphics.UI.SDL.Types (Surface, SurfaceStruct)
import Graphics.UI.SDL.General (unwrapBool)


data GrabMode
    = GrabQuery
    | GrabOff
    | GrabOn
      deriving (Int -> GrabMode -> ShowS
[GrabMode] -> ShowS
GrabMode -> String
(Int -> GrabMode -> ShowS)
-> (GrabMode -> String) -> ([GrabMode] -> ShowS) -> Show GrabMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GrabMode -> ShowS
showsPrec :: Int -> GrabMode -> ShowS
$cshow :: GrabMode -> String
show :: GrabMode -> String
$cshowList :: [GrabMode] -> ShowS
showList :: [GrabMode] -> ShowS
Show,GrabMode -> GrabMode -> Bool
(GrabMode -> GrabMode -> Bool)
-> (GrabMode -> GrabMode -> Bool) -> Eq GrabMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GrabMode -> GrabMode -> Bool
== :: GrabMode -> GrabMode -> Bool
$c/= :: GrabMode -> GrabMode -> Bool
/= :: GrabMode -> GrabMode -> Bool
Eq)

toGrabMode :: Int32 -> GrabMode
{-# LINE 44 "Graphics/UI/SDL/WindowManagement.hsc" #-}
toGrabMode (-1) = GrabQuery
{-# LINE 45 "Graphics/UI/SDL/WindowManagement.hsc" #-}
toGrabMode (0) = GrabOff
{-# LINE 46 "Graphics/UI/SDL/WindowManagement.hsc" #-}
toGrabMode (1) = GrabOn
{-# LINE 47 "Graphics/UI/SDL/WindowManagement.hsc" #-}
toGrabMode _ = error "Graphics.UI.SDL.WindowManagement.toGrabMode: bad argument"

fromGrabMode :: GrabMode -> Int32
{-# LINE 50 "Graphics/UI/SDL/WindowManagement.hsc" #-}
fromGrabMode GrabQuery = (-1)
{-# LINE 51 "Graphics/UI/SDL/WindowManagement.hsc" #-}
fromGrabMode GrabOff = (0)
{-# LINE 52 "Graphics/UI/SDL/WindowManagement.hsc" #-}
fromGrabMode GrabOn = (1)
{-# LINE 53 "Graphics/UI/SDL/WindowManagement.hsc" #-}

-- void SDL_WM_SetCaption(const char *title, const char *icon);
foreign import ccall unsafe "SDL_WM_SetCaption" sdlSetCaption :: CString -> CString -> IO ()
-- | Sets the window title and icon name.
setCaption :: String -> String -> IO ()
setCaption :: String -> String -> IO ()
setCaption String
title String
icon
    = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
title ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
titlePtr ->
      String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
icon ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
iconPtr ->
      CString -> CString -> IO ()
sdlSetCaption CString
titlePtr CString
iconPtr

-- | Sets the window title and icon name. Use @Nothing@ to unset.
rawSetCaption :: Maybe String -> Maybe String -> IO ()
rawSetCaption :: Maybe String -> Maybe String -> IO ()
rawSetCaption Maybe String
title Maybe String
icon
    = Maybe String -> (CString -> IO ()) -> IO ()
forall {a}. Maybe String -> (CString -> IO a) -> IO a
maybeStr Maybe String
title ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
titlePtr ->
      Maybe String -> (CString -> IO ()) -> IO ()
forall {a}. Maybe String -> (CString -> IO a) -> IO a
maybeStr Maybe String
icon ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
iconPtr ->
      CString -> CString -> IO ()
sdlSetCaption CString
titlePtr CString
iconPtr
    where maybeStr :: Maybe String -> (CString -> IO a) -> IO a
maybeStr Maybe String
Nothing CString -> IO a
action = CString -> IO a
action CString
forall a. Ptr a
nullPtr
          maybeStr (Just String
s) CString -> IO a
action = String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString String
s CString -> IO a
action
-- void SDL_WM_GetCaption(char **title, char **icon);
foreign import ccall unsafe "SDL_WM_GetCaption" sdlGetCaption :: Ptr CString -> Ptr CString -> IO ()
-- | Gets the window title and icon name.
getCaption :: IO (Maybe String,Maybe String)
getCaption :: IO (Maybe String, Maybe String)
getCaption
    = (Ptr CString -> IO (Maybe String, Maybe String))
-> IO (Maybe String, Maybe String)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO (Maybe String, Maybe String))
 -> IO (Maybe String, Maybe String))
-> (Ptr CString -> IO (Maybe String, Maybe String))
-> IO (Maybe String, Maybe String)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
cTitle ->
      (Ptr CString -> IO (Maybe String, Maybe String))
-> IO (Maybe String, Maybe String)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO (Maybe String, Maybe String))
 -> IO (Maybe String, Maybe String))
-> (Ptr CString -> IO (Maybe String, Maybe String))
-> IO (Maybe String, Maybe String)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
cIcon ->
      do Ptr CString -> Ptr CString -> IO ()
sdlGetCaption Ptr CString
cTitle Ptr CString
cIcon
         Maybe String
title <- (Ptr CString -> IO String) -> Ptr CString -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek ((CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)(IO CString -> IO String)
-> (Ptr CString -> IO CString) -> Ptr CString -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek) Ptr CString
cTitle
         Maybe String
icon <- (Ptr CString -> IO String) -> Ptr CString -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek ((CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)(IO CString -> IO String)
-> (Ptr CString -> IO CString) -> Ptr CString -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek) Ptr CString
cIcon
         (Maybe String, Maybe String) -> IO (Maybe String, Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String
title,Maybe String
icon)

-- int SDL_WM_IconifyWindow(void);
foreign import ccall unsafe "SDL_WM_IconifyWindow" sdlIconifyWindow :: IO Int
-- | Iconify\/Minimise the window.
iconifyWindow :: IO Bool
iconifyWindow :: IO Bool
iconifyWindow = (Int -> Bool) -> IO Int -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool IO Int
sdlIconifyWindow

-- int SDL_WM_ToggleFullScreen(SDL_Surface *surface);
foreign import ccall unsafe "SDL_WM_ToggleFullScreen" sdlToggleFullScreen :: Ptr SurfaceStruct -> IO Int
-- |Toggles fullscreen mode. Returns @False@ on error.
tryToggleFullscreen :: Surface -> IO Bool
tryToggleFullscreen :: Surface -> IO Bool
tryToggleFullscreen Surface
surface
    = Surface -> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Surface
surface ((Ptr SurfaceStruct -> IO Bool) -> IO Bool)
-> (Ptr SurfaceStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> IO Int -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO Int -> IO Bool)
-> (Ptr SurfaceStruct -> IO Int) -> Ptr SurfaceStruct -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr SurfaceStruct -> IO Int
sdlToggleFullScreen

-- | Toggles fullscreen mode. Throws an exception on error.
toggleFullscreen :: Surface -> IO ()
toggleFullscreen :: Surface -> IO ()
toggleFullscreen = String -> IO Bool -> IO ()
unwrapBool String
"SDL_WM_ToggleFullScreen" (IO Bool -> IO ()) -> (Surface -> IO Bool) -> Surface -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Surface -> IO Bool
tryToggleFullscreen

-- SDL_GrabMode SDL_WM_GrabInput(SDL_GrabMode mode);
foreign import ccall unsafe "SDL_WM_GrabInput" sdlGrabInput :: Int32 -> IO Int32
{-# LINE 102 "Graphics/UI/SDL/WindowManagement.hsc" #-}
-- | Grabbing means that the mouse is confined to the application
--   window, and nearly all keyboard input is passed directly to
--   the application, and not interpreted by a window manager, if any.
grabInput :: Bool -> IO ()
grabInput :: Bool -> IO ()
grabInput = IO Int32 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int32 -> IO ()) -> (Bool -> IO Int32) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IO Int32
sdlGrabInput (Int32 -> IO Int32) -> (Bool -> Int32) -> Bool -> IO Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GrabMode -> Int32
fromGrabMode (GrabMode -> Int32) -> (Bool -> GrabMode) -> Bool -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> GrabMode
mkGrabMode
    where mkGrabMode :: Bool -> GrabMode
mkGrabMode Bool
True = GrabMode
GrabOn
          mkGrabMode Bool
False = GrabMode
GrabOff

-- | Returns the current grabbing mode.
queryGrabMode :: IO GrabMode
queryGrabMode :: IO GrabMode
queryGrabMode = (Int32 -> GrabMode) -> IO Int32 -> IO GrabMode
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> GrabMode
toGrabMode (IO Int32 -> IO GrabMode)
-> (GrabMode -> IO Int32) -> GrabMode -> IO GrabMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IO Int32
sdlGrabInput (Int32 -> IO Int32) -> (GrabMode -> Int32) -> GrabMode -> IO Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GrabMode -> Int32
fromGrabMode (GrabMode -> IO GrabMode) -> GrabMode -> IO GrabMode
forall a b. (a -> b) -> a -> b
$ GrabMode
GrabQuery