module Graphics.UI.GLUT.State (
windowBorderWidth, windowHeaderHeight, skipStaleMotionEvents,
rgba,
BufferDepth, rgbaBufferDepths, colorBufferDepth,
doubleBuffered, stereo,
accumBufferDepths, depthBufferDepth, stencilBufferDepth,
SampleCount, sampleCount, formatID,
fullScreenMode,
geometryVisualizeNormals,
vertexAttribCoord3, vertexAttribNormal, vertexAttribTexCoord2,
damaged,
elapsedTime,
screenSize, screenSizeMM,
hasKeyboard,
ButtonCount, numMouseButtons,
numSpaceballButtons,
DialCount, numDialsAndButtons,
numTabletButtons,
AxisCount, PollRate, joystickInfo,
supportedNumAuxBuffers, supportedSamplesPerPixel,
glutVersion, initState
) where
import Control.Monad ( unless )
import Data.StateVar ( GettableStateVar, makeGettableStateVar
, SettableStateVar, makeSettableStateVar
, StateVar, makeStateVar )
import Foreign.C.Types ( CInt )
import Foreign.Marshal.Alloc ( alloca )
import Foreign.Marshal.Array ( peekArray )
import Foreign.Storable ( peek )
import Graphics.Rendering.OpenGL ( AttribLocation(..), Size(..), GLenum, GLint )
import Graphics.UI.GLUT.Overlay
import Graphics.UI.GLUT.QueryUtils
import Graphics.UI.GLUT.Raw
import Graphics.UI.GLUT.Window
rgba :: GettableStateVar Bool
rgba :: GettableStateVar Bool
rgba = forall a. IO a -> IO a
makeGettableStateVarforall a b. (a -> b) -> a -> b
$ forall a. Getter a
simpleGet CInt -> Bool
i2b GLenum
glut_WINDOW_RGBA
type BufferDepth = Int
rgbaBufferDepths ::
GettableStateVar (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
rgbaBufferDepths :: GettableStateVar (Int, Int, Int, Int)
rgbaBufferDepths = forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ do
Int
r <- forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_RED_SIZE
Int
g <- forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_GREEN_SIZE
Int
b <- forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_BLUE_SIZE
Int
a <- forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_ALPHA_SIZE
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
r, Int
g, Int
b, Int
a)
colorBufferDepth :: GettableStateVar BufferDepth
colorBufferDepth :: GettableStateVar Int
colorBufferDepth =
forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_BUFFER_SIZE
doubleBuffered :: GettableStateVar Bool
doubleBuffered :: GettableStateVar Bool
doubleBuffered = forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ forall a. Getter a
simpleGet CInt -> Bool
i2b GLenum
glut_WINDOW_DOUBLEBUFFER
stereo :: GettableStateVar Bool
stereo :: GettableStateVar Bool
stereo = forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ forall a. Getter a
simpleGet CInt -> Bool
i2b GLenum
glut_WINDOW_STEREO
accumBufferDepths ::
GettableStateVar (BufferDepth, BufferDepth, BufferDepth, BufferDepth)
accumBufferDepths :: GettableStateVar (Int, Int, Int, Int)
accumBufferDepths = forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ do
Int
r <- forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_ACCUM_RED_SIZE
Int
g <- forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_ACCUM_GREEN_SIZE
Int
b <- forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_ACCUM_BLUE_SIZE
Int
a <- forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_ACCUM_ALPHA_SIZE
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
r, Int
g, Int
b, Int
a)
depthBufferDepth :: GettableStateVar BufferDepth
depthBufferDepth :: GettableStateVar Int
depthBufferDepth =
forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_DEPTH_SIZE
stencilBufferDepth :: GettableStateVar BufferDepth
stencilBufferDepth :: GettableStateVar Int
stencilBufferDepth =
forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_STENCIL_SIZE
type SampleCount = Int
sampleCount :: GettableStateVar SampleCount
sampleCount :: GettableStateVar Int
sampleCount =
forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_NUM_SAMPLES
formatID :: GettableStateVar Int
formatID :: GettableStateVar Int
formatID = forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_FORMAT_ID
fullScreenMode :: StateVar Bool
fullScreenMode :: StateVar Bool
fullScreenMode = forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar GettableStateVar Bool
getFullScreenMode Bool -> IO ()
setFullScreenMode
getFullScreenMode :: IO Bool
getFullScreenMode :: GettableStateVar Bool
getFullScreenMode = forall a. Getter a
simpleGet CInt -> Bool
i2b GLenum
glut_FULL_SCREEN
setFullScreenMode :: Bool -> IO ()
setFullScreenMode :: Bool -> IO ()
setFullScreenMode Bool
newMode = do
Bool
oldMode <- GettableStateVar Bool
getFullScreenMode
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
newMode forall a. Eq a => a -> a -> Bool
== Bool
oldMode) forall (m :: * -> *). MonadIO m => m ()
fullScreenToggle
geometryVisualizeNormals :: StateVar Bool
geometryVisualizeNormals :: StateVar Bool
geometryVisualizeNormals =
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
(forall a. Getter a
simpleGet CInt -> Bool
i2b GLenum
glut_GEOMETRY_VISUALIZE_NORMALS)
(forall (m :: * -> *). MonadIO m => GLenum -> CInt -> m ()
glutSetOption GLenum
glut_GEOMETRY_VISUALIZE_NORMALS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CInt
b2i)
vertexAttribCoord3 :: SettableStateVar (Maybe AttribLocation)
vertexAttribCoord3 :: SettableStateVar (Maybe AttribLocation)
vertexAttribCoord3 = (GLsizei -> IO ()) -> SettableStateVar (Maybe AttribLocation)
setVertexAttribWith forall (m :: * -> *). MonadIO m => GLsizei -> m ()
glutSetVertexAttribCoord3
setVertexAttribWith :: (GLint -> IO ()) -> SettableStateVar (Maybe AttribLocation)
setVertexAttribWith :: (GLsizei -> IO ()) -> SettableStateVar (Maybe AttribLocation)
setVertexAttribWith GLsizei -> IO ()
f = forall a. (a -> IO ()) -> SettableStateVar a
makeSettableStateVar forall a b. (a -> b) -> a -> b
$ GLsizei -> IO ()
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe AttribLocation -> GLsizei
getLocation
where getLocation :: Maybe AttribLocation -> GLsizei
getLocation = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-GLsizei
1) (\(AttribLocation GLenum
l) -> forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
l)
vertexAttribNormal :: SettableStateVar (Maybe AttribLocation)
vertexAttribNormal :: SettableStateVar (Maybe AttribLocation)
vertexAttribNormal = (GLsizei -> IO ()) -> SettableStateVar (Maybe AttribLocation)
setVertexAttribWith forall (m :: * -> *). MonadIO m => GLsizei -> m ()
glutSetVertexAttribNormal
vertexAttribTexCoord2 :: SettableStateVar (Maybe AttribLocation)
vertexAttribTexCoord2 :: SettableStateVar (Maybe AttribLocation)
vertexAttribTexCoord2 = (GLsizei -> IO ()) -> SettableStateVar (Maybe AttribLocation)
setVertexAttribWith forall (m :: * -> *). MonadIO m => GLsizei -> m ()
glutSetVertexAttribTexCoord2
elapsedTime :: GettableStateVar Int
elapsedTime :: GettableStateVar Int
elapsedTime = forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_ELAPSED_TIME
damaged :: Layer -> GettableStateVar Bool
damaged :: Layer -> GettableStateVar Bool
damaged Layer
l = forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ forall a. Getter a
layerGet forall {a}. (Eq a, Num a) => a -> Bool
isDamaged (Layer -> GLenum
marshalDamagedLayer Layer
l)
where isDamaged :: a -> Bool
isDamaged a
d = a
d forall a. Eq a => a -> a -> Bool
/= a
0 Bool -> Bool -> Bool
&& a
d forall a. Eq a => a -> a -> Bool
/= -a
1
marshalDamagedLayer :: Layer -> GLenum
marshalDamagedLayer Layer
x = case Layer
x of
Layer
Normal -> GLenum
glut_NORMAL_DAMAGED
Layer
Overlay -> GLenum
glut_OVERLAY_DAMAGED
screenSize :: GettableStateVar Size
screenSize :: GettableStateVar Size
screenSize =
forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ do
GLsizei
wpx <- forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_SCREEN_WIDTH
GLsizei
hpx <- forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_SCREEN_HEIGHT
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ GLsizei -> GLsizei -> Size
Size GLsizei
wpx GLsizei
hpx
screenSizeMM :: GettableStateVar Size
screenSizeMM :: GettableStateVar Size
screenSizeMM =
forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ do
GLsizei
wmm <- forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_SCREEN_WIDTH_MM
GLsizei
hmm <- forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_SCREEN_HEIGHT_MM
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ GLsizei -> GLsizei -> Size
Size GLsizei
wmm GLsizei
hmm
hasKeyboard :: GettableStateVar Bool
hasKeyboard :: GettableStateVar Bool
hasKeyboard = forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ forall a. Getter a
deviceGet CInt -> Bool
i2b GLenum
glut_HAS_KEYBOARD
type ButtonCount = Int
numMouseButtons :: GettableStateVar (Maybe ButtonCount)
numMouseButtons :: GettableStateVar (Maybe Int)
numMouseButtons =
forall a. GLenum -> IO a -> GettableStateVar (Maybe a)
getDeviceInfo GLenum
glut_HAS_MOUSE forall a b. (a -> b) -> a -> b
$
forall a. Getter a
deviceGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_NUM_MOUSE_BUTTONS
numSpaceballButtons :: GettableStateVar (Maybe ButtonCount)
numSpaceballButtons :: GettableStateVar (Maybe Int)
numSpaceballButtons =
forall a. GLenum -> IO a -> GettableStateVar (Maybe a)
getDeviceInfo GLenum
glut_HAS_SPACEBALL forall a b. (a -> b) -> a -> b
$
forall a. Getter a
deviceGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_NUM_SPACEBALL_BUTTONS
type DialCount = Int
numDialsAndButtons :: GettableStateVar (Maybe (DialCount, ButtonCount))
numDialsAndButtons :: GettableStateVar (Maybe (Int, Int))
numDialsAndButtons =
forall a. GLenum -> IO a -> GettableStateVar (Maybe a)
getDeviceInfo GLenum
glut_HAS_DIAL_AND_BUTTON_BOX forall a b. (a -> b) -> a -> b
$ do
Int
d <- forall a. Getter a
deviceGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_NUM_DIALS
Int
b <- forall a. Getter a
deviceGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_NUM_BUTTON_BOX_BUTTONS
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
d, Int
b)
numTabletButtons :: GettableStateVar (Maybe ButtonCount)
numTabletButtons :: GettableStateVar (Maybe Int)
numTabletButtons =
forall a. GLenum -> IO a -> GettableStateVar (Maybe a)
getDeviceInfo GLenum
glut_HAS_TABLET forall a b. (a -> b) -> a -> b
$
forall a. Getter a
deviceGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_NUM_TABLET_BUTTONS
type AxisCount = Int
type PollRate = Int
joystickInfo :: GettableStateVar (Maybe (ButtonCount, PollRate, AxisCount))
joystickInfo :: GettableStateVar (Maybe (Int, Int, Int))
joystickInfo =
forall a. GLenum -> IO a -> GettableStateVar (Maybe a)
getDeviceInfo GLenum
glut_HAS_JOYSTICK forall a b. (a -> b) -> a -> b
$ do
Int
b <- forall a. Getter a
deviceGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_JOYSTICK_BUTTONS
Int
a <- forall a. Getter a
deviceGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_JOYSTICK_AXES
Int
r <- forall a. Getter a
deviceGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_JOYSTICK_POLL_RATE
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
b, Int
a, Int
r)
supportedNumAuxBuffers :: GettableStateVar [Int]
supportedNumAuxBuffers :: GettableStateVar [Int]
supportedNumAuxBuffers = forall a. Integral a => GLenum -> GettableStateVar [a]
getModeValues GLenum
glut_AUX
supportedSamplesPerPixel :: GettableStateVar [SampleCount]
supportedSamplesPerPixel :: GettableStateVar [Int]
supportedSamplesPerPixel = forall a. Integral a => GLenum -> GettableStateVar [a]
getModeValues (forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
glut_MULTISAMPLE)
getModeValues :: Integral a => GLenum -> GettableStateVar [a]
getModeValues :: forall a. Integral a => GLenum -> GettableStateVar [a]
getModeValues GLenum
what = forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
sizeBuffer -> do
Ptr CInt
valuesBuffer <- forall (m :: * -> *).
MonadIO m =>
GLenum -> Ptr CInt -> m (Ptr CInt)
glutGetModeValues GLenum
what Ptr CInt
sizeBuffer
CInt
size <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
sizeBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
size) Ptr CInt
valuesBuffer
i2b :: CInt -> Bool
i2b :: CInt -> Bool
i2b = (forall a. Eq a => a -> a -> Bool
/= CInt
0)
b2i :: Bool -> CInt
b2i :: Bool -> CInt
b2i Bool
False = CInt
0
b2i Bool
True = CInt
1
getDeviceInfo :: GLenum -> IO a -> GettableStateVar (Maybe a)
getDeviceInfo :: forall a. GLenum -> IO a -> GettableStateVar (Maybe a)
getDeviceInfo GLenum
dev IO a
act =
forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ do
Bool
hasDevice <- forall a. Getter a
deviceGet CInt -> Bool
i2b GLenum
dev
if Bool
hasDevice then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just IO a
act else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
glutVersion :: GettableStateVar String
glutVersion :: GettableStateVar String
glutVersion = forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ do
let isGLUT :: GettableStateVar Bool
isGLUT = Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *). MonadIO m => String -> m Bool
isKnown String
"glutSetOption"
isFreeglut :: GettableStateVar Bool
isFreeglut = Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *). MonadIO m => String -> m Bool
isKnown String
"glutSetWindowStayOnTop"
showVersionPart :: a -> ShowS
showVersionPart a
x = forall a. Show a => a -> ShowS
shows (a
x forall a. Integral a => a -> a -> a
`mod` a
100)
showVersion :: a -> ShowS
showVersion a
v = forall {a}. (Show a, Integral a) => a -> ShowS
showVersionPart (a
v forall a. Integral a => a -> a -> a
`div` a
10000) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'.' forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {a}. (Show a, Integral a) => a -> ShowS
showVersionPart (a
v forall a. Integral a => a -> a -> a
`div` a
100) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'.' forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {a}. (Show a, Integral a) => a -> ShowS
showVersionPart a
v
Bool
g <- GettableStateVar Bool
isGLUT
if Bool
g
then forall (m :: * -> *) a. Monad m => a -> m a
return String
"GLUT 3.7"
else do Bool
f <- GettableStateVar Bool
isFreeglut
CInt
v <- forall a. Getter a
simpleGet forall a. a -> a
id GLenum
glut_VERSION
let prefix :: String
prefix = if Bool
f then String
"freeglut" else String
"OpenGLUT"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
prefix forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Show a, Integral a) => a -> ShowS
showVersion CInt
v forall a b. (a -> b) -> a -> b
$ String
""
windowBorderWidth :: GettableStateVar Int
windowBorderWidth :: GettableStateVar Int
windowBorderWidth =
forall a. IO a -> IO a
makeGettableStateVar (forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_BORDER_WIDTH)
windowHeaderHeight :: GettableStateVar Int
=
forall a. IO a -> IO a
makeGettableStateVar (forall a. Getter a
simpleGet forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_HEADER_HEIGHT)
skipStaleMotionEvents :: StateVar Bool
skipStaleMotionEvents :: StateVar Bool
skipStaleMotionEvents =
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
(forall a. Getter a
simpleGet CInt -> Bool
i2b GLenum
glut_SKIP_STALE_MOTION_EVENTS)
(forall (m :: * -> *). MonadIO m => GLenum -> CInt -> m ()
glutSetOption GLenum
glut_SKIP_STALE_MOTION_EVENTS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CInt
b2i)
initState :: GettableStateVar Bool
initState :: GettableStateVar Bool
initState = forall a. IO a -> IO a
makeGettableStateVarforall a b. (a -> b) -> a -> b
$ forall a. Getter a
simpleGet CInt -> Bool
i2b GLenum
glut_INIT_STATE