module Graphics.UI.GLUT.GameMode (
GameModeCapability(..), GameModeCapabilityDescription(..),
gameModeCapabilities, enterGameMode, leaveGameMode,
BitsPerPlane, RefreshRate, GameModeInfo(..), gameModeInfo,
gameModeActive
) where
import Control.Monad.IO.Class ( MonadIO(..) )
import Data.List ( intersperse )
import Data.StateVar ( GettableStateVar, makeGettableStateVar
, SettableStateVar, makeSettableStateVar )
import Foreign.C.String ( withCString )
import Graphics.Rendering.OpenGL ( Size(..), GLenum )
import Graphics.UI.GLUT.Raw
import Graphics.UI.GLUT.Types
data GameModeCapability
= GameModeWidth
| GameModeHeight
| GameModeBitsPerPlane
| GameModeRefreshRate
| GameModeNum
deriving ( GameModeCapability -> GameModeCapability -> Bool
(GameModeCapability -> GameModeCapability -> Bool)
-> (GameModeCapability -> GameModeCapability -> Bool)
-> Eq GameModeCapability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GameModeCapability -> GameModeCapability -> Bool
== :: GameModeCapability -> GameModeCapability -> Bool
$c/= :: GameModeCapability -> GameModeCapability -> Bool
/= :: GameModeCapability -> GameModeCapability -> Bool
Eq, Eq GameModeCapability
Eq GameModeCapability =>
(GameModeCapability -> GameModeCapability -> Ordering)
-> (GameModeCapability -> GameModeCapability -> Bool)
-> (GameModeCapability -> GameModeCapability -> Bool)
-> (GameModeCapability -> GameModeCapability -> Bool)
-> (GameModeCapability -> GameModeCapability -> Bool)
-> (GameModeCapability -> GameModeCapability -> GameModeCapability)
-> (GameModeCapability -> GameModeCapability -> GameModeCapability)
-> Ord GameModeCapability
GameModeCapability -> GameModeCapability -> Bool
GameModeCapability -> GameModeCapability -> Ordering
GameModeCapability -> GameModeCapability -> GameModeCapability
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GameModeCapability -> GameModeCapability -> Ordering
compare :: GameModeCapability -> GameModeCapability -> Ordering
$c< :: GameModeCapability -> GameModeCapability -> Bool
< :: GameModeCapability -> GameModeCapability -> Bool
$c<= :: GameModeCapability -> GameModeCapability -> Bool
<= :: GameModeCapability -> GameModeCapability -> Bool
$c> :: GameModeCapability -> GameModeCapability -> Bool
> :: GameModeCapability -> GameModeCapability -> Bool
$c>= :: GameModeCapability -> GameModeCapability -> Bool
>= :: GameModeCapability -> GameModeCapability -> Bool
$cmax :: GameModeCapability -> GameModeCapability -> GameModeCapability
max :: GameModeCapability -> GameModeCapability -> GameModeCapability
$cmin :: GameModeCapability -> GameModeCapability -> GameModeCapability
min :: GameModeCapability -> GameModeCapability -> GameModeCapability
Ord, BitsPerPlane -> GameModeCapability -> ShowS
[GameModeCapability] -> ShowS
GameModeCapability -> String
(BitsPerPlane -> GameModeCapability -> ShowS)
-> (GameModeCapability -> String)
-> ([GameModeCapability] -> ShowS)
-> Show GameModeCapability
forall a.
(BitsPerPlane -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: BitsPerPlane -> GameModeCapability -> ShowS
showsPrec :: BitsPerPlane -> GameModeCapability -> ShowS
$cshow :: GameModeCapability -> String
show :: GameModeCapability -> String
$cshowList :: [GameModeCapability] -> ShowS
showList :: [GameModeCapability] -> ShowS
Show )
gameModeCapabilityToString :: GameModeCapability -> String
gameModeCapabilityToString :: GameModeCapability -> String
gameModeCapabilityToString GameModeCapability
x = case GameModeCapability
x of
GameModeCapability
GameModeWidth -> String
"width"
GameModeCapability
GameModeHeight -> String
"height"
GameModeCapability
GameModeBitsPerPlane -> String
"bpp"
GameModeCapability
GameModeRefreshRate -> String
"hertz"
GameModeCapability
GameModeNum -> String
"num"
data GameModeCapabilityDescription = Where' GameModeCapability Relation Int
deriving ( GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool
(GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool)
-> (GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool)
-> Eq GameModeCapabilityDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool
== :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool
$c/= :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool
/= :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool
Eq, Eq GameModeCapabilityDescription
Eq GameModeCapabilityDescription =>
(GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Ordering)
-> (GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool)
-> (GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool)
-> (GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool)
-> (GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool)
-> (GameModeCapabilityDescription
-> GameModeCapabilityDescription -> GameModeCapabilityDescription)
-> (GameModeCapabilityDescription
-> GameModeCapabilityDescription -> GameModeCapabilityDescription)
-> Ord GameModeCapabilityDescription
GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool
GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Ordering
GameModeCapabilityDescription
-> GameModeCapabilityDescription -> GameModeCapabilityDescription
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Ordering
compare :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Ordering
$c< :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool
< :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool
$c<= :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool
<= :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool
$c> :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool
> :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool
$c>= :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool
>= :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> Bool
$cmax :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> GameModeCapabilityDescription
max :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> GameModeCapabilityDescription
$cmin :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> GameModeCapabilityDescription
min :: GameModeCapabilityDescription
-> GameModeCapabilityDescription -> GameModeCapabilityDescription
Ord, BitsPerPlane -> GameModeCapabilityDescription -> ShowS
[GameModeCapabilityDescription] -> ShowS
GameModeCapabilityDescription -> String
(BitsPerPlane -> GameModeCapabilityDescription -> ShowS)
-> (GameModeCapabilityDescription -> String)
-> ([GameModeCapabilityDescription] -> ShowS)
-> Show GameModeCapabilityDescription
forall a.
(BitsPerPlane -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: BitsPerPlane -> GameModeCapabilityDescription -> ShowS
showsPrec :: BitsPerPlane -> GameModeCapabilityDescription -> ShowS
$cshow :: GameModeCapabilityDescription -> String
show :: GameModeCapabilityDescription -> String
$cshowList :: [GameModeCapabilityDescription] -> ShowS
showList :: [GameModeCapabilityDescription] -> ShowS
Show )
gameModeCapabilityDescriptionToString :: GameModeCapabilityDescription -> String
gameModeCapabilityDescriptionToString :: GameModeCapabilityDescription -> String
gameModeCapabilityDescriptionToString (Where' GameModeCapability
c Relation
r BitsPerPlane
i) =
GameModeCapability -> String
gameModeCapabilityToString GameModeCapability
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ Relation -> String
relationToString Relation
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ BitsPerPlane -> String
forall a. Show a => a -> String
show BitsPerPlane
i
gameModeCapabilities :: SettableStateVar [GameModeCapabilityDescription]
gameModeCapabilities :: SettableStateVar [GameModeCapabilityDescription]
gameModeCapabilities = ([GameModeCapabilityDescription] -> IO ())
-> SettableStateVar [GameModeCapabilityDescription]
forall a. (a -> IO ()) -> SettableStateVar a
makeSettableStateVar (([GameModeCapabilityDescription] -> IO ())
-> SettableStateVar [GameModeCapabilityDescription])
-> ([GameModeCapabilityDescription] -> IO ())
-> SettableStateVar [GameModeCapabilityDescription]
forall a b. (a -> b) -> a -> b
$ \[GameModeCapabilityDescription]
ds ->
String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString ([GameModeCapabilityDescription] -> String
descriptionsToString [GameModeCapabilityDescription]
ds) CString -> IO ()
forall (m :: * -> *). MonadIO m => CString -> m ()
glutGameModeString
descriptionsToString :: [GameModeCapabilityDescription] -> String
descriptionsToString :: [GameModeCapabilityDescription] -> String
descriptionsToString [GameModeCapabilityDescription]
ds =
let ws :: [BitsPerPlane]
ws = [ BitsPerPlane
x | Where' GameModeCapability
GameModeWidth Relation
IsEqualTo BitsPerPlane
x <- [GameModeCapabilityDescription]
ds ]
hs :: [BitsPerPlane]
hs = [ BitsPerPlane
x | Where' GameModeCapability
GameModeHeight Relation
IsEqualTo BitsPerPlane
x <- [GameModeCapabilityDescription]
ds ]
bs :: [BitsPerPlane]
bs = [ BitsPerPlane
x | Where' GameModeCapability
GameModeBitsPerPlane Relation
IsEqualTo BitsPerPlane
x <- [GameModeCapabilityDescription]
ds ]
rs :: [BitsPerPlane]
rs = [ BitsPerPlane
x | Where' GameModeCapability
GameModeRefreshRate Relation
IsEqualTo BitsPerPlane
x <- [GameModeCapabilityDescription]
ds ]
allSimple :: Bool
allSimple = ([BitsPerPlane] -> BitsPerPlane
forall a. [a] -> BitsPerPlane
forall (t :: * -> *) a. Foldable t => t a -> BitsPerPlane
length [BitsPerPlane]
ws BitsPerPlane -> BitsPerPlane -> BitsPerPlane
forall a. Num a => a -> a -> a
+ [BitsPerPlane] -> BitsPerPlane
forall a. [a] -> BitsPerPlane
forall (t :: * -> *) a. Foldable t => t a -> BitsPerPlane
length [BitsPerPlane]
hs BitsPerPlane -> BitsPerPlane -> BitsPerPlane
forall a. Num a => a -> a -> a
+ [BitsPerPlane] -> BitsPerPlane
forall a. [a] -> BitsPerPlane
forall (t :: * -> *) a. Foldable t => t a -> BitsPerPlane
length [BitsPerPlane]
bs BitsPerPlane -> BitsPerPlane -> BitsPerPlane
forall a. Num a => a -> a -> a
+ [BitsPerPlane] -> BitsPerPlane
forall a. [a] -> BitsPerPlane
forall (t :: * -> *) a. Foldable t => t a -> BitsPerPlane
length [BitsPerPlane]
rs) BitsPerPlane -> BitsPerPlane -> Bool
forall a. Eq a => a -> a -> Bool
== ([GameModeCapabilityDescription] -> BitsPerPlane
forall a. [a] -> BitsPerPlane
forall (t :: * -> *) a. Foldable t => t a -> BitsPerPlane
length [GameModeCapabilityDescription]
ds)
dimensionsOK :: Bool
dimensionsOK = ([BitsPerPlane] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BitsPerPlane]
ws) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ([BitsPerPlane] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BitsPerPlane]
hs)
in if Bool
allSimple Bool -> Bool -> Bool
&& Bool
dimensionsOK
then [BitsPerPlane]
-> [BitsPerPlane] -> [BitsPerPlane] -> [BitsPerPlane] -> String
simpleCapStr [BitsPerPlane]
ws [BitsPerPlane]
hs [BitsPerPlane]
bs [BitsPerPlane]
rs
else [GameModeCapabilityDescription] -> String
generalCapStr [GameModeCapabilityDescription]
ds
simpleCapStr :: [Int] -> [Int] -> [Int] -> [Int] -> String
simpleCapStr :: [BitsPerPlane]
-> [BitsPerPlane] -> [BitsPerPlane] -> [BitsPerPlane] -> String
simpleCapStr [BitsPerPlane]
ws [BitsPerPlane]
hs [BitsPerPlane]
bs [BitsPerPlane]
rs =
String -> [BitsPerPlane] -> String
forall {a}. Show a => String -> [a] -> String
showCap String
"" [BitsPerPlane]
ws String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [BitsPerPlane] -> String
forall {a}. Show a => String -> [a] -> String
showCap String
"x" [BitsPerPlane]
hs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [BitsPerPlane] -> String
forall {a}. Show a => String -> [a] -> String
showCap String
":" [BitsPerPlane]
bs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [BitsPerPlane] -> String
forall {a}. Show a => String -> [a] -> String
showCap String
"@" [BitsPerPlane]
rs
where showCap :: String -> [a] -> String
showCap String
_ [] = String
""
showCap String
prefix (a
x:[a]
_) = String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x
generalCapStr :: [GameModeCapabilityDescription] -> String
generalCapStr :: [GameModeCapabilityDescription] -> String
generalCapStr =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([GameModeCapabilityDescription] -> [String])
-> [GameModeCapabilityDescription]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" " ([String] -> [String])
-> ([GameModeCapabilityDescription] -> [String])
-> [GameModeCapabilityDescription]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameModeCapabilityDescription -> String)
-> [GameModeCapabilityDescription] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map GameModeCapabilityDescription -> String
gameModeCapabilityDescriptionToString
enterGameMode :: MonadIO m => m (Window, Bool)
enterGameMode :: forall (m :: * -> *). MonadIO m => m (Window, Bool)
enterGameMode = do
CInt
w <- m CInt
forall (m :: * -> *). MonadIO m => m CInt
glutEnterGameMode
Bool
c <- GLenum -> m Bool
forall (m :: * -> *). MonadIO m => GLenum -> m Bool
getBool GLenum
glut_GAME_MODE_DISPLAY_CHANGED
(Window, Bool) -> m (Window, Bool)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Window
Window CInt
w, Bool
c)
leaveGameMode :: MonadIO m => m ()
leaveGameMode :: forall (m :: * -> *). MonadIO m => m ()
leaveGameMode = m ()
forall (m :: * -> *). MonadIO m => m ()
glutLeaveGameMode
type BitsPerPlane = Int
type RefreshRate = Int
data GameModeInfo = GameModeInfo Size BitsPerPlane RefreshRate
deriving ( GameModeInfo -> GameModeInfo -> Bool
(GameModeInfo -> GameModeInfo -> Bool)
-> (GameModeInfo -> GameModeInfo -> Bool) -> Eq GameModeInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GameModeInfo -> GameModeInfo -> Bool
== :: GameModeInfo -> GameModeInfo -> Bool
$c/= :: GameModeInfo -> GameModeInfo -> Bool
/= :: GameModeInfo -> GameModeInfo -> Bool
Eq, Eq GameModeInfo
Eq GameModeInfo =>
(GameModeInfo -> GameModeInfo -> Ordering)
-> (GameModeInfo -> GameModeInfo -> Bool)
-> (GameModeInfo -> GameModeInfo -> Bool)
-> (GameModeInfo -> GameModeInfo -> Bool)
-> (GameModeInfo -> GameModeInfo -> Bool)
-> (GameModeInfo -> GameModeInfo -> GameModeInfo)
-> (GameModeInfo -> GameModeInfo -> GameModeInfo)
-> Ord GameModeInfo
GameModeInfo -> GameModeInfo -> Bool
GameModeInfo -> GameModeInfo -> Ordering
GameModeInfo -> GameModeInfo -> GameModeInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GameModeInfo -> GameModeInfo -> Ordering
compare :: GameModeInfo -> GameModeInfo -> Ordering
$c< :: GameModeInfo -> GameModeInfo -> Bool
< :: GameModeInfo -> GameModeInfo -> Bool
$c<= :: GameModeInfo -> GameModeInfo -> Bool
<= :: GameModeInfo -> GameModeInfo -> Bool
$c> :: GameModeInfo -> GameModeInfo -> Bool
> :: GameModeInfo -> GameModeInfo -> Bool
$c>= :: GameModeInfo -> GameModeInfo -> Bool
>= :: GameModeInfo -> GameModeInfo -> Bool
$cmax :: GameModeInfo -> GameModeInfo -> GameModeInfo
max :: GameModeInfo -> GameModeInfo -> GameModeInfo
$cmin :: GameModeInfo -> GameModeInfo -> GameModeInfo
min :: GameModeInfo -> GameModeInfo -> GameModeInfo
Ord, BitsPerPlane -> GameModeInfo -> ShowS
[GameModeInfo] -> ShowS
GameModeInfo -> String
(BitsPerPlane -> GameModeInfo -> ShowS)
-> (GameModeInfo -> String)
-> ([GameModeInfo] -> ShowS)
-> Show GameModeInfo
forall a.
(BitsPerPlane -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: BitsPerPlane -> GameModeInfo -> ShowS
showsPrec :: BitsPerPlane -> GameModeInfo -> ShowS
$cshow :: GameModeInfo -> String
show :: GameModeInfo -> String
$cshowList :: [GameModeInfo] -> ShowS
showList :: [GameModeInfo] -> ShowS
Show )
gameModeInfo :: GettableStateVar (Maybe GameModeInfo)
gameModeInfo :: GettableStateVar (Maybe GameModeInfo)
gameModeInfo = GettableStateVar (Maybe GameModeInfo)
-> GettableStateVar (Maybe GameModeInfo)
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar (Maybe GameModeInfo)
-> GettableStateVar (Maybe GameModeInfo))
-> GettableStateVar (Maybe GameModeInfo)
-> GettableStateVar (Maybe GameModeInfo)
forall a b. (a -> b) -> a -> b
$ do
Bool
possible <- GLenum -> IO Bool
forall (m :: * -> *). MonadIO m => GLenum -> m Bool
getBool GLenum
glut_GAME_MODE_POSSIBLE
if Bool
possible
then do
CInt
w <- GLenum -> IO CInt
forall (m :: * -> *). MonadIO m => GLenum -> m CInt
glutGameModeGet GLenum
glut_GAME_MODE_WIDTH
CInt
h <- GLenum -> IO CInt
forall (m :: * -> *). MonadIO m => GLenum -> m CInt
glutGameModeGet GLenum
glut_GAME_MODE_HEIGHT
let size :: Size
size = GLsizei -> GLsizei -> Size
Size (CInt -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
w) (CInt -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
h)
CInt
b <- GLenum -> IO CInt
forall (m :: * -> *). MonadIO m => GLenum -> m CInt
glutGameModeGet GLenum
glut_GAME_MODE_PIXEL_DEPTH
CInt
r <- GLenum -> IO CInt
forall (m :: * -> *). MonadIO m => GLenum -> m CInt
glutGameModeGet GLenum
glut_GAME_MODE_REFRESH_RATE
Maybe GameModeInfo -> GettableStateVar (Maybe GameModeInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GameModeInfo -> GettableStateVar (Maybe GameModeInfo))
-> Maybe GameModeInfo -> GettableStateVar (Maybe GameModeInfo)
forall a b. (a -> b) -> a -> b
$ GameModeInfo -> Maybe GameModeInfo
forall a. a -> Maybe a
Just (GameModeInfo -> Maybe GameModeInfo)
-> GameModeInfo -> Maybe GameModeInfo
forall a b. (a -> b) -> a -> b
$ Size -> BitsPerPlane -> BitsPerPlane -> GameModeInfo
GameModeInfo Size
size (CInt -> BitsPerPlane
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
b) (CInt -> BitsPerPlane
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
r)
else Maybe GameModeInfo -> GettableStateVar (Maybe GameModeInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GameModeInfo
forall a. Maybe a
Nothing
getBool :: MonadIO m => GLenum -> m Bool
getBool :: forall (m :: * -> *). MonadIO m => GLenum -> m Bool
getBool GLenum
x = do
CInt
val <- GLenum -> m CInt
forall (m :: * -> *). MonadIO m => GLenum -> m CInt
glutGameModeGet GLenum
x
Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ CInt
val CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
gameModeActive :: GettableStateVar Bool
gameModeActive :: IO Bool
gameModeActive = IO Bool -> IO Bool
forall a. IO a -> IO a
makeGettableStateVar (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ GLenum -> IO Bool
forall (m :: * -> *). MonadIO m => GLenum -> m Bool
getBool GLenum
glut_GAME_MODE_ACTIVE