--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.GLUT.Initialization
-- Copyright   :  (c) Sven Panne 2002-2018
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- Actions and state variables in this module are used to initialize GLUT state.
-- The primary initialization routine is 'initialize', which should only be
-- called exactly once in a GLUT program. No other GLUT or OpenGL actions should
-- be called before 'initialize', apart from getting or setting the state
-- variables in this module.
--
-- The reason is that these state variables can be used to set default window
-- initialization state that might be modified by the command processing done in
-- 'initialize'. For example, 'initialWindowSize' can be set to @('Size'
-- 400 400)@ before 'initialize' is called to indicate 400 by 400 is the
-- program\'s default window size. Setting the initial window size or position
-- before 'initialize' allows the GLUT program user to specify the initial size
-- or position using command line arguments.
--
--------------------------------------------------------------------------------

module Graphics.UI.GLUT.Initialization (
   -- * Primary initialization
   initialize, getArgsAndInitialize, exit,

   -- * Initial window geometry
   initialWindowPosition, initialWindowSize,

   -- * Setting the initial display mode (I)
   DisplayMode(..), initialDisplayMode, displayModePossible,

   -- * Setting the initial display mode (II)
   DisplayCapability(..), Relation(..), DisplayCapabilityDescription(..),
   initialDisplayCapabilities,

   -- * Controlling the creation of rendering contexts
   RenderingContext(..), renderingContext,

   -- * Direct\/indirect rendering
   DirectRendering(..), directRendering,

   -- * OpenGL 3.x context support
   initialContextVersion, ContextFlag(..), initialContextFlags,
   ContextProfile(..), initialContextProfile
) where

import Control.Monad ( when )
import Control.Monad.IO.Class ( MonadIO(..) )
import Data.Bits ( Bits(..) )
import Data.List ( genericLength, intersperse, mapAccumR )
import Data.StateVar ( get, ($=), GettableStateVar, makeGettableStateVar
                     , SettableStateVar, makeSettableStateVar, StateVar, makeStateVar )
import Foreign.C.String ( peekCString, withCString )
import Foreign.C.Types ( CInt, CUInt )
import Foreign.Marshal.Array ( peekArray, withArray0 )
import Foreign.Marshal.Utils ( with, withMany )
import Foreign.Ptr ( nullPtr )
import Foreign.Storable ( peek )
import Graphics.Rendering.OpenGL ( Position(..), Size(..) )
import System.Environment ( getArgs, getProgName )

import Graphics.UI.GLUT.QueryUtils
import Graphics.UI.GLUT.Raw
import Graphics.UI.GLUT.Types

--------------------------------------------------------------------------------

-- | Given the program name and command line arguments, initialize the GLUT
-- library and negotiate a session with the window system. During this
-- process, 'initialize' may cause the termination of the GLUT program with an
-- error message to the user if GLUT cannot be properly initialized.
-- Examples of this situation include the failure to connect to the window
-- system, the lack of window system support for OpenGL, and invalid command
-- line options.
--
-- 'initialize' also processes command line options, but the specific options
-- parsed are window system dependent. Any command line arguments which are
-- not GLUT-specific are returned.
--
-- /X Implementation Notes:/ The X Window System specific options parsed by
-- 'initialize' are as follows:
--
-- * @-display /DISPLAY/@: Specify the X server to connect to. If not specified,
--   the value of the @DISPLAY@ environment variable is used.
--
-- * @-geometry /WxH+X+Y/@: Determines where windows should be created on the
--   screen. The parameter following @-geometry@ should be formatted as a
--   standard X geometry specification. The effect of using this option is to
--   change the GLUT initial size and initial position the same as if
--   'initialWindowSize' or 'initialWindowPosition' were modified directly.
--
-- * @-iconic@: Requests all top-level windows be created in an iconic state.
--
-- * @-indirect@: Force the use of indirect OpenGL rendering contexts.
--
-- * @-direct@: Force the use of direct OpenGL rendering contexts (not all GLX
--   implementations support direct rendering contexts). A fatal error is
--   generated if direct rendering is not supported by the OpenGL
--   implementation. If neither @-indirect@ or @-direct@ are used to force a
--   particular behavior, GLUT will attempt to use direct rendering if
--   possible and otherwise fallback to indirect rendering.
--
-- * @-gldebug@: After processing callbacks and\/or events, call
--   'Graphics.UI.GLUT.Debugging.reportErrors' to check if there are any pending
--   OpenGL errors. Using this option is helpful in detecting OpenGL run-time
--   errors.
--
-- * @-sync@: Enable synchronous X protocol transactions. This option makes
--   it easier to track down potential X protocol errors.

initialize :: MonadIO m
           => String      -- ^ The program name.
           -> [String]    -- ^ The command line arguments
           -> m [String] -- ^ Non-GLUT command line arguments
initialize :: String -> [String] -> m [String]
initialize String
prog [String]
args = IO [String] -> m [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> m [String]) -> IO [String] -> m [String]
forall a b. (a -> b) -> a -> b
$
   CInt -> (Ptr CInt -> IO [String]) -> IO [String]
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (CInt
1 CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ [String] -> CInt
forall i a. Num i => [a] -> i
genericLength [String]
args) ((Ptr CInt -> IO [String]) -> IO [String])
-> (Ptr CInt -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
argcBuf ->
   (String -> (CString -> IO [String]) -> IO [String])
-> [String] -> ([CString] -> IO [String]) -> IO [String]
forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
withMany String -> (CString -> IO [String]) -> IO [String]
forall a. String -> (CString -> IO a) -> IO a
withCString (String
prog String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args) (([CString] -> IO [String]) -> IO [String])
-> ([CString] -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \[CString]
argvPtrs ->
   CString -> [CString] -> (Ptr CString -> IO [String]) -> IO [String]
forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 CString
forall a. Ptr a
nullPtr [CString]
argvPtrs ((Ptr CString -> IO [String]) -> IO [String])
-> (Ptr CString -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \Ptr CString
argvBuf -> do
   Ptr CInt -> Ptr CString -> IO ()
forall (m :: * -> *). MonadIO m => Ptr CInt -> Ptr CString -> m ()
glutInit Ptr CInt
argcBuf Ptr CString
argvBuf
   CInt
newArgc <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
argcBuf
   [CString]
newArgvPtrs <- Int -> Ptr CString -> IO [CString]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
newArgc) Ptr CString
argvBuf
   [String]
newArgv <- (CString -> IO String) -> [CString] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CString -> IO String
peekCString [CString]
newArgvPtrs
   [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
tail [String]
newArgv

-- | Convenience action: Initialize GLUT, returning the program name and any
-- non-GLUT command line arguments.

getArgsAndInitialize :: MonadIO m => m (String, [String])
getArgsAndInitialize :: m (String, [String])
getArgsAndInitialize = IO (String, [String]) -> m (String, [String])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (String, [String]) -> m (String, [String]))
-> IO (String, [String]) -> m (String, [String])
forall a b. (a -> b) -> a -> b
$ do
   String
prog <- IO String
getProgName
   [String]
args <- IO [String]
getArgs
   [String]
nonGLUTArgs <- String -> [String] -> IO [String]
forall (m :: * -> *). MonadIO m => String -> [String] -> m [String]
initialize String
prog [String]
args
   (String, [String]) -> IO (String, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
prog, [String]
nonGLUTArgs)

-----------------------------------------------------------------------------

-- | (/freeglut only/) De-initialize GLUT. After this, one has to use
-- 'initialize' or 'getArgsAndInitialize' to initialize GLUT again.

exit :: MonadIO m => m ()
exit :: m ()
exit = m ()
forall (m :: * -> *). MonadIO m => m ()
glutExit

--------------------------------------------------------------------------------

-- | Controls the /initial window position/.  Windows created by
-- 'Graphics.UI.GLUT.Window.createWindow' will be requested to be created with
-- the current /initial window position/. The initial value of the /initial
-- window position/ GLUT state is @'Position' (-1) (-1)@. If either the X or Y
-- component of the /initial window position/ is negative, the actual window
-- position is left to the window system to determine.
--
-- The intent of the /initial window position/ is to provide a suggestion to
-- the window system for a window\'s initial position. The window system is
-- not obligated to use this information. Therefore, GLUT programs should not
-- assume the window was created at the specified position.

initialWindowPosition :: StateVar Position
initialWindowPosition :: StateVar Position
initialWindowPosition =
   IO Position -> (Position -> IO ()) -> StateVar Position
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO Position
getInitialWindowPosition Position -> IO ()
setInitialWindowPosition

getInitialWindowPosition :: IO Position
getInitialWindowPosition :: IO Position
getInitialWindowPosition = do
   GLint
x <- Getter GLint
forall a. Getter a
simpleGet CInt -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_INIT_WINDOW_X
   GLint
y <- Getter GLint
forall a. Getter a
simpleGet CInt -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_INIT_WINDOW_Y
   Position -> IO Position
forall (m :: * -> *) a. Monad m => a -> m a
return (Position -> IO Position) -> Position -> IO Position
forall a b. (a -> b) -> a -> b
$ GLint -> GLint -> Position
Position GLint
x GLint
y

setInitialWindowPosition :: Position -> IO ()
setInitialWindowPosition :: Position -> IO ()
setInitialWindowPosition (Position GLint
x GLint
y) =
    CInt -> CInt -> IO ()
forall (m :: * -> *). MonadIO m => CInt -> CInt -> m ()
glutInitWindowPosition (GLint -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
x) (GLint -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
y)

--------------------------------------------------------------------------------

-- | Controls the /initial window size/.  Windows created by
-- 'Graphics.UI.GLUT.Window.createWindow' will be requested to be created with
-- the current /initial window size/. The initial value of the /initial window
-- size/ GLUT state is @'Size' 300 300@. If either the width or the height
-- component of the /initial window size/ is non-positive, the actual window
-- size is left to the window system to determine.
--
-- The intent of the /initial window size/ is to provide a suggestion to the
-- window system for a window\'s initial size. The window system is not
-- obligated to use this information. Therefore, GLUT programs should not
-- assume the window was created at the specified size. A GLUT program should
-- use the window\'s reshape callback to determine the true size of the
-- window.

initialWindowSize :: StateVar Size
initialWindowSize :: StateVar Size
initialWindowSize = IO Size -> (Size -> IO ()) -> StateVar Size
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO Size
getInitialWindowSize Size -> IO ()
setInitialWindowSize

getInitialWindowSize :: IO Size
getInitialWindowSize :: IO Size
getInitialWindowSize = do
   GLint
w <- Getter GLint
forall a. Getter a
simpleGet CInt -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_INIT_WINDOW_WIDTH
   GLint
h <- Getter GLint
forall a. Getter a
simpleGet CInt -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_INIT_WINDOW_HEIGHT
   Size -> IO Size
forall (m :: * -> *) a. Monad m => a -> m a
return (Size -> IO Size) -> Size -> IO Size
forall a b. (a -> b) -> a -> b
$ GLint -> GLint -> Size
Size GLint
w GLint
h

setInitialWindowSize :: Size -> IO ()
setInitialWindowSize :: Size -> IO ()
setInitialWindowSize (Size GLint
w GLint
h) =
   CInt -> CInt -> IO ()
forall (m :: * -> *). MonadIO m => CInt -> CInt -> m ()
glutInitWindowSize (GLint -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
w) (GLint -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
h)

--------------------------------------------------------------------------------

-- | A single aspect of a window which is to be created, used in conjunction
-- with 'initialDisplayMode'.

data DisplayMode
   = RGBAMode
     -- ^ Select an RGBA mode window. This is the default if neither 'RGBAMode'
     -- nor 'IndexMode' are specified.
   | RGBMode
     -- ^ An alias for 'RGBAMode'.
   | IndexMode
     -- ^ Select a color index mode window. This overrides 'RGBAMode' if it is
     -- also specified.
   | LuminanceMode
     -- ^ Select a window with a \"luminance\" color model. This model provides
     -- the functionality of OpenGL\'s RGBA color model, but the green and blue
     -- components are not maintained in the frame buffer. Instead each pixel\'s
     -- red component is converted to an index between zero and
     --  'Graphics.UI.GLUT.Colormap.numColorMapEntries' and looked up in a
     -- per-window color map to determine the color of pixels within the window.
     -- The initial colormap of 'LuminanceMode' windows is initialized to be a
     -- linear gray ramp, but can be modified with GLUT\'s colormap actions.
     -- /Implementation Notes:/ 'LuminanceMode' is not supported on most OpenGL
     -- platforms.
   | WithAlphaComponent
     -- ^ Select a window with an alpha component to the color buffer(s).
   | WithAccumBuffer
     -- ^ Select a window with an accumulation buffer.
   | WithDepthBuffer
     -- ^ Select a window with a depth buffer.
   | WithStencilBuffer
     -- ^ Select a window with a stencil buffer.
   | WithAuxBuffers Int
     -- ^ (/freeglut only/) Select a window with /n/ (1 .. 4) auxiliary buffers.
     -- Any /n/ outside the range 1 .. 4 is a fatal error.
   | SingleBuffered
     -- ^ Select a single buffered window. This is the default if neither
     -- 'DoubleBuffered' nor 'SingleBuffered' are specified.
   | DoubleBuffered
     -- ^ Select a double buffered window. This overrides 'SingleBuffered' if it
     -- is also specified.
   | Multisampling
     -- ^ Select a window with multisampling support. If multisampling is not
     -- available, a non-multisampling window will automatically be chosen.
     -- Note: both the OpenGL client-side and server-side implementations must
     -- support the @GLX_SAMPLE_SGIS@ extension for multisampling to be
     -- available. Deprecated, use 'WithSamplesPerPixel'.
   | WithSamplesPerPixel Int
     -- ^ Select a window with multisampling, using the given samples per pixel.
   | Stereoscopic
     -- ^ Select a stereo window.
   | Captionless
     -- ^ Select a window without a caption (/freeglut only/).
   | Borderless
     -- ^ Select a window without any borders (/freeglut only/).
   | SRGBMode
     -- ^ Select an sRGB mode window (/freeglut only/).
   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, 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, 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 )

marshalDisplayMode :: DisplayMode -> CUInt
marshalDisplayMode :: DisplayMode -> CUInt
marshalDisplayMode DisplayMode
m = case DisplayMode
m of
   DisplayMode
RGBAMode -> CUInt
glut_RGBA
   DisplayMode
RGBMode -> CUInt
glut_RGB
   DisplayMode
IndexMode -> CUInt
glut_INDEX
   DisplayMode
LuminanceMode -> CUInt
glut_LUMINANCE
   DisplayMode
WithAlphaComponent -> CUInt
glut_ALPHA
   DisplayMode
WithAccumBuffer -> CUInt
glut_ACCUM
   DisplayMode
WithDepthBuffer -> CUInt
glut_DEPTH
   DisplayMode
WithStencilBuffer -> CUInt
glut_STENCIL
   WithAuxBuffers Int
1 -> CUInt
glut_AUX1
   WithAuxBuffers Int
2 -> CUInt
glut_AUX2
   WithAuxBuffers Int
3 -> CUInt
glut_AUX3
   WithAuxBuffers Int
4 -> CUInt
glut_AUX4
   WithAuxBuffers Int
n ->
      String -> CUInt
forall a. HasCallStack => String -> a
error (String
"marshalDisplayMode: illegal number of auxiliary buffers: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
   DisplayMode
SingleBuffered -> CUInt
glut_SINGLE
   DisplayMode
DoubleBuffered -> CUInt
glut_DOUBLE
   DisplayMode
Multisampling -> CUInt
glut_MULTISAMPLE
   WithSamplesPerPixel Int
_ -> String -> CUInt
forall a. HasCallStack => String -> a
error (String
"marshalDisplayMode: this should not happen")
   DisplayMode
Stereoscopic -> CUInt
glut_STEREO
   DisplayMode
Captionless -> CUInt
glut_CAPTIONLESS
   DisplayMode
Borderless -> CUInt
glut_BORDERLESS
   DisplayMode
SRGBMode -> CUInt
glut_SRGB

--------------------------------------------------------------------------------

-- | Controls the /initial display mode/ used when creating top-level windows,
-- subwindows, and overlays to determine the OpenGL display mode for the
-- to-be-created window or overlay.
--
-- Note that 'RGBAMode' selects the RGBA color model, but it does not request any
-- bits of alpha (sometimes called an /alpha buffer/ or /destination alpha/)
-- be allocated. To request alpha, specify 'WithAlphaComponent'. The same
-- applies to 'LuminanceMode'.

initialDisplayMode :: StateVar [DisplayMode]
initialDisplayMode :: StateVar [DisplayMode]
initialDisplayMode = IO [DisplayMode]
-> ([DisplayMode] -> IO ()) -> StateVar [DisplayMode]
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO [DisplayMode]
getInitialDisplayMode [DisplayMode] -> IO ()
setInitialDisplayMode

getInitialDisplayMode :: IO [DisplayMode]
getInitialDisplayMode :: IO [DisplayMode]
getInitialDisplayMode = do
   CUInt
mode <- Getter CUInt
forall a. Getter a
simpleGet CInt -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_INIT_DISPLAY_MODE
   let displayModes :: [DisplayMode]
displayModes = CUInt -> [DisplayMode]
i2dms (CUInt
mode CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.&. CUInt -> CUInt
forall a. Bits a => a -> a
complement CUInt
glut_MULTISAMPLE)
   if CUInt
mode CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.&. CUInt
glut_MULTISAMPLE CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
0
      then [DisplayMode] -> IO [DisplayMode]
forall (m :: * -> *) a. Monad m => a -> m a
return [DisplayMode]
displayModes
      else do
         Int
n <- StateVar Int -> IO Int
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get StateVar Int
samplesPerPixel
         [DisplayMode] -> IO [DisplayMode]
forall (m :: * -> *) a. Monad m => a -> m a
return ([DisplayMode] -> IO [DisplayMode])
-> [DisplayMode] -> IO [DisplayMode]
forall a b. (a -> b) -> a -> b
$ Int -> DisplayMode
WithSamplesPerPixel Int
n DisplayMode -> [DisplayMode] -> [DisplayMode]
forall a. a -> [a] -> [a]
: [DisplayMode]
displayModes

i2dms :: CUInt -> [DisplayMode]
i2dms :: CUInt -> [DisplayMode]
i2dms CUInt
bitfield | DisplayMode
IndexMode DisplayMode -> [DisplayMode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DisplayMode]
modes Bool -> Bool -> Bool
|| DisplayMode
LuminanceMode DisplayMode -> [DisplayMode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DisplayMode]
modes = [DisplayMode]
modes
               | Bool
otherwise = DisplayMode
RGBAMode DisplayMode -> [DisplayMode] -> [DisplayMode]
forall a. a -> [a] -> [a]
: [DisplayMode]
modes
   where modes :: [DisplayMode]
modes = CUInt -> [DisplayMode]
i2dmsWithoutRGBA CUInt
bitfield

i2dmsWithoutRGBA :: CUInt -> [DisplayMode]
i2dmsWithoutRGBA :: CUInt -> [DisplayMode]
i2dmsWithoutRGBA CUInt
bitfield =
   [ DisplayMode
c | DisplayMode
c <- [ DisplayMode
IndexMode, DisplayMode
LuminanceMode, DisplayMode
WithAlphaComponent,
                DisplayMode
WithAccumBuffer, DisplayMode
WithDepthBuffer, DisplayMode
WithStencilBuffer,
                Int -> DisplayMode
WithAuxBuffers Int
1, Int -> DisplayMode
WithAuxBuffers Int
2, Int -> DisplayMode
WithAuxBuffers Int
3,
                Int -> DisplayMode
WithAuxBuffers Int
4, DisplayMode
SingleBuffered, DisplayMode
DoubleBuffered, DisplayMode
Multisampling,
                DisplayMode
Stereoscopic, DisplayMode
Captionless, DisplayMode
Borderless, DisplayMode
SRGBMode ]
       , (CUInt
bitfield CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.&. DisplayMode -> CUInt
marshalDisplayMode DisplayMode
c) CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CUInt
0 ]

setInitialDisplayMode :: [DisplayMode] -> IO ()
setInitialDisplayMode :: [DisplayMode] -> IO ()
setInitialDisplayMode [DisplayMode]
modes = do
   let ([Int]
spps, [DisplayMode]
transformedModes) = ([Int] -> DisplayMode -> ([Int], DisplayMode))
-> [Int] -> [DisplayMode] -> ([Int], [DisplayMode])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumR [Int] -> DisplayMode -> ([Int], DisplayMode)
handleMultisampling [] [DisplayMode]
modes
   (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (StateVar Int
samplesPerPixel StateVar Int -> Int -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=) [Int]
spps
   CUInt -> IO ()
forall (m :: * -> *). MonadIO m => CUInt -> m ()
glutInitDisplayMode ((DisplayMode -> CUInt) -> [DisplayMode] -> CUInt
forall b a. (Num b, Bits b) => (a -> b) -> [a] -> b
toBitfield DisplayMode -> CUInt
marshalDisplayMode [DisplayMode]
transformedModes)

handleMultisampling :: [Int] -> DisplayMode -> ([Int], DisplayMode)
handleMultisampling :: [Int] -> DisplayMode -> ([Int], DisplayMode)
handleMultisampling [Int]
spps (WithSamplesPerPixel Int
spp) = (Int
spp Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
spps, DisplayMode
Multisampling)
handleMultisampling [Int]
spps DisplayMode
mode                      = ([Int]
spps, DisplayMode
mode)

toBitfield :: (Num b, Bits b) => (a -> b) -> [a] -> b
toBitfield :: (a -> b) -> [a] -> b
toBitfield a -> b
marshal = (b -> b -> b) -> b -> [b] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> b -> b
forall a. Bits a => a -> a -> a
(.|.) b
0 ([b] -> b) -> ([a] -> [b]) -> [a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
marshal

-- | Contains 'True' if the /current display mode/ is supported, 'False'
-- otherwise.

displayModePossible :: GettableStateVar Bool
displayModePossible :: GettableStateVar Bool
displayModePossible =
   GettableStateVar Bool -> GettableStateVar Bool
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar Bool -> GettableStateVar Bool)
-> GettableStateVar Bool -> GettableStateVar Bool
forall a b. (a -> b) -> a -> b
$ Getter Bool
forall a. Getter a
simpleGet (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) GLenum
glut_DISPLAY_MODE_POSSIBLE

--------------------------------------------------------------------------------

samplesPerPixel :: StateVar Int
samplesPerPixel :: StateVar Int
samplesPerPixel = IO Int -> (Int -> IO ()) -> StateVar Int
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO Int
getSamplesPerPixel Int -> IO ()
setSamplesPerPixel

getSamplesPerPixel :: IO Int
getSamplesPerPixel :: IO Int
getSamplesPerPixel = do
   Bool
m <- GettableStateVar Bool
multisamplingSupported
   if Bool
m
      then Getter Int
forall a. Getter a
simpleGet CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
glut_MULTISAMPLE)
      else Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
defaultSamplesPerPixels

defaultSamplesPerPixels :: Int
defaultSamplesPerPixels :: Int
defaultSamplesPerPixels = Int
4

setSamplesPerPixel :: Int -> IO ()
setSamplesPerPixel :: Int -> IO ()
setSamplesPerPixel Int
spp = do
   Bool
m <- GettableStateVar Bool
multisamplingSupported
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
m (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      GLenum -> CInt -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> CInt -> m ()
glutSetOption (CUInt -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
glut_MULTISAMPLE) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
spp)

multisamplingSupported :: IO Bool
multisamplingSupported :: GettableStateVar Bool
multisamplingSupported = String -> GettableStateVar Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
isKnown String
"glutGetModeValues"

--------------------------------------------------------------------------------

-- | Capabilities for 'initialDisplayCapabilities', most of them are extensions
-- of the constructors of 'DisplayMode'.

data DisplayCapability
   = DisplayRGBA  -- ^ Number of bits of red, green, blue, and alpha in the RGBA
                  --   color buffer. Default is \"'IsAtLeast' @1@\" for red,
                  --   green, blue, and alpha capabilities, and \"'IsEqualTo'
                  --   @1@\" for the RGBA color model capability.
   | DisplayRGB   -- ^ Number of bits of red, green, and blue in the RGBA color
                  --   buffer and zero bits of alpha color buffer precision.
                  --   Default is \"'IsAtLeast' @1@\" for the red, green, and
                  --   blue capabilities, and \"'IsNotLessThan' @0@\" for alpha
                  --   capability, and \"'IsEqualTo' @1@\" for the RGBA color
                  --   model capability.
   | DisplayRed   -- ^ Red color buffer precision in bits. Default is
                  --   \"'IsAtLeast' @1@\".
   | DisplayGreen -- ^ Green color buffer precision in bits. Default is
                  --   \"'IsAtLeast' @1@\".
   | DisplayBlue  -- ^ Blue color buffer precision in bits. Default is
                  --   \"'IsAtLeast' @1@\".
   | DisplayIndex -- ^ Boolean if the color model is color index or not. True is
                  --   color index. Default is \"'IsAtLeast' @1@\".
   | DisplayBuffer -- ^ Number of bits in the color index color buffer. Default
                  --   is \"'IsAtLeast' @1@\".
   | DisplaySingle -- ^ Boolean indicate the color buffer is single buffered.
                  --   Default is \"'IsEqualTo' @1@\".
   | DisplayDouble -- ^ Boolean indicating if the color buffer is double
                  --   buffered. Default is \"'IsEqualTo' @1@\".
   | DisplayAccA  -- ^ Red, green, blue, and alpha accumulation buffer precision
                  --   in  bits. Default is \"'IsAtLeast' @1@\" for red, green,
                  --   blue, and alpha capabilities.
   | DisplayAcc   -- ^ Red, green, and green accumulation buffer precision in
                  --   bits and zero bits of alpha accumulation buffer precision.
                  --   Default is \"'IsAtLeast' @1@\" for red, green, and blue
                  --   capabilities, and \"'IsNotLessThan' @0@\" for the alpha
                  --   capability.
   | DisplayAlpha -- ^ Alpha color buffer precision in bits. Default is
                  --   \"'IsAtLeast' @1@\".
   | DisplayDepth -- ^ Number of bits of precsion in the depth buffer. Default
                  --   is \"'IsAtLeast' @12@\".
   | DisplayStencil -- ^ Number of bits in the stencil buffer. Default is
                  --   \"'IsNotLessThan' @1@\".
   | DisplaySamples -- ^ Indicates the number of multisamples to use based on
                  --   GLX\'s @SGIS_multisample@ extension (for antialiasing).
                  --   Default is \"'IsNotGreaterThan' @4@\". This default means
                  --   that a GLUT application can request multisampling if
                  --   available by simply specifying \"'With' 'DisplaySamples'\".
   | DisplayStereo -- ^ Boolean indicating the color buffer is supports
                  --   OpenGL-style stereo. Default is \"'IsEqualTo' @1@\".
   | DisplayLuminance -- ^ Number of bits of red in the RGBA and zero bits of green,
                  --   blue (alpha not specified) of color buffer precision.
                  --   Default is \"'IsAtLeast' @1@\" for the red capabilitis,
                  --   and \"'IsEqualTo' @0@\" for the green and blue
                  --   capabilities, and \"'IsEqualTo' @1@\" for the RGBA color
                  --   model capability, and, for X11, \"'IsEqualTo' @1@\" for
                  --   the 'DisplayXStaticGray' capability. SGI InfiniteReality (and
                  --   other future machines) support a 16-bit luminance (single
                  --   channel) display mode (an additional 16-bit alpha channel
                  --   can also be requested). The red channel maps to gray
                  --   scale and green and blue channels are not available. A
                  --   16-bit precision luminance display mode is often
                  --   appropriate for medical imaging applications. Do not
                  --   expect many machines to support extended precision
                  --   luminance display modes.
   | DisplayAux   -- ^ (/freeglut only/) Number of auxiliary buffers. Default is
                  --   \"'IsEqualTo' @1@\".
   | DisplayNum   -- ^ A special capability name indicating where the value
                  --   represents the Nth frame buffer configuration matching
                  --   the description string. When not specified,
                  --   'initialDisplayCapabilities' also uses the first
                  --   (best matching) configuration. 'Num' requires a relation
                  --   and numeric value.
   | DisplayConformant -- ^ Boolean indicating if the frame buffer configuration is
                  --   conformant or not. Conformance information is based on
                  --   GLX\'s @EXT_visual_rating@ extension if supported. If the
                  --   extension is not supported, all visuals are assumed
                  --   conformant. Default is \"'IsEqualTo' @1@\".
   | DisplaySlow  -- ^ Boolean indicating if the frame buffer configuration is
                  --   slow or not. Slowness information is based on GLX\'s
                  --   @EXT_visual_rating@ extension if supported. If the
                  --   extension is not supported, all visuals are assumed fast.
                  --   Note that slowness is a relative designation relative to
                  --   other frame buffer configurations available. The intent
                  --   of the slow capability is to help programs avoid frame
                  --   buffer configurations that are slower (but perhaps higher
                  --   precision) for the current machine. Default is
                  --   \"'IsAtLeast' @0@\". This default means that slow visuals
                  --   are used in preference to fast visuals, but fast visuals
                  --   will still be allowed.
   | DisplayWin32PFD -- ^ Only recognized on GLUT implementations for Win32, this
                  --   capability name matches the Win32 Pixel Format Descriptor
                  --   by number. 'DisplayWin32PFD' can only be used with 'Where'.
   | DisplayXVisual -- ^ Only recongized on GLUT implementations for the X Window
                  --   System, this capability name matches the X visual ID by
                  --   number. 'DisplayXVisual' requires a relation and numeric value.
   | DisplayXStaticGray -- ^ Only recongized on GLUT implementations for the X Window
                  --   System, boolean indicating if the frame buffer
                  --   configuration\'s X visual is of type @StaticGray@.
                  --   Default is \"'IsEqualTo' @1@\".
   | DisplayXGrayScale -- ^ Only recongized on GLUT implementations for the X Window
                  --   System, boolean indicating if the frame buffer
                  --   configuration\'s X visual is of type @GrayScale@. Default
                  --   is \"'IsEqualTo' @1@\".
   | DisplayXStaticColor -- ^ Only recongized on GLUT implementations for the X Window
                  --   System, boolean indicating if the frame buffer
                  --   configuration\'s X visual is of type @StaticColor@.
                  --   Default is \"'IsEqualTo' @1@\".
   | DisplayXPseudoColor -- ^ Only recongized on GLUT implementations for the X Window
                  --   System, boolean indicating if the frame buffer
                  --   configuration\'s X visual is of type @PsuedoColor@.
                  --   Default is \"'IsEqualTo' @1@\".
   | DisplayXTrueColor -- ^ Only recongized on GLUT implementations for the X Window
                  --   System, boolean indicating if the frame buffer
                  --   configuration\'s X visual is of type @TrueColor@. Default
                  --   is \"'IsEqualTo' @1@\".
   | DisplayXDirectColor -- ^ Only recongized on GLUT implementations for the X Window
                  --   System, boolean indicating if the frame buffer
                  --   configuration\'s X visual is of type @DirectColor@.
                  --   Default is \"'IsEqualTo' @1@\".
   deriving ( DisplayCapability -> DisplayCapability -> Bool
(DisplayCapability -> DisplayCapability -> Bool)
-> (DisplayCapability -> DisplayCapability -> Bool)
-> Eq DisplayCapability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayCapability -> DisplayCapability -> Bool
$c/= :: DisplayCapability -> DisplayCapability -> Bool
== :: DisplayCapability -> DisplayCapability -> Bool
$c== :: DisplayCapability -> DisplayCapability -> Bool
Eq, Eq DisplayCapability
Eq DisplayCapability
-> (DisplayCapability -> DisplayCapability -> Ordering)
-> (DisplayCapability -> DisplayCapability -> Bool)
-> (DisplayCapability -> DisplayCapability -> Bool)
-> (DisplayCapability -> DisplayCapability -> Bool)
-> (DisplayCapability -> DisplayCapability -> Bool)
-> (DisplayCapability -> DisplayCapability -> DisplayCapability)
-> (DisplayCapability -> DisplayCapability -> DisplayCapability)
-> Ord DisplayCapability
DisplayCapability -> DisplayCapability -> Bool
DisplayCapability -> DisplayCapability -> Ordering
DisplayCapability -> DisplayCapability -> DisplayCapability
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 :: DisplayCapability -> DisplayCapability -> DisplayCapability
$cmin :: DisplayCapability -> DisplayCapability -> DisplayCapability
max :: DisplayCapability -> DisplayCapability -> DisplayCapability
$cmax :: DisplayCapability -> DisplayCapability -> DisplayCapability
>= :: DisplayCapability -> DisplayCapability -> Bool
$c>= :: DisplayCapability -> DisplayCapability -> Bool
> :: DisplayCapability -> DisplayCapability -> Bool
$c> :: DisplayCapability -> DisplayCapability -> Bool
<= :: DisplayCapability -> DisplayCapability -> Bool
$c<= :: DisplayCapability -> DisplayCapability -> Bool
< :: DisplayCapability -> DisplayCapability -> Bool
$c< :: DisplayCapability -> DisplayCapability -> Bool
compare :: DisplayCapability -> DisplayCapability -> Ordering
$ccompare :: DisplayCapability -> DisplayCapability -> Ordering
$cp1Ord :: Eq DisplayCapability
Ord, Int -> DisplayCapability -> ShowS
[DisplayCapability] -> ShowS
DisplayCapability -> String
(Int -> DisplayCapability -> ShowS)
-> (DisplayCapability -> String)
-> ([DisplayCapability] -> ShowS)
-> Show DisplayCapability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisplayCapability] -> ShowS
$cshowList :: [DisplayCapability] -> ShowS
show :: DisplayCapability -> String
$cshow :: DisplayCapability -> String
showsPrec :: Int -> DisplayCapability -> ShowS
$cshowsPrec :: Int -> DisplayCapability -> ShowS
Show )

displayCapabilityToString :: DisplayCapability -> String
displayCapabilityToString :: DisplayCapability -> String
displayCapabilityToString DisplayCapability
x = case DisplayCapability
x of
   DisplayCapability
DisplayRGBA         -> String
"rgba"
   DisplayCapability
DisplayRGB          -> String
"rgb"
   DisplayCapability
DisplayRed          -> String
"red"
   DisplayCapability
DisplayGreen        -> String
"green"
   DisplayCapability
DisplayBlue         -> String
"blue"
   DisplayCapability
DisplayIndex        -> String
"index"
   DisplayCapability
DisplayBuffer       -> String
"buffer"
   DisplayCapability
DisplaySingle       -> String
"single"
   DisplayCapability
DisplayDouble       -> String
"double"
   DisplayCapability
DisplayAccA         -> String
"acca"
   DisplayCapability
DisplayAcc          -> String
"acc"
   DisplayCapability
DisplayAlpha        -> String
"alpha"
   DisplayCapability
DisplayDepth        -> String
"depth"
   DisplayCapability
DisplayStencil      -> String
"stencil"
   DisplayCapability
DisplaySamples      -> String
"samples"
   DisplayCapability
DisplayStereo       -> String
"stereo"
   DisplayCapability
DisplayLuminance    -> String
"luminance"
   DisplayCapability
DisplayAux          -> String
"aux"
   DisplayCapability
DisplayNum          -> String
"num"
   DisplayCapability
DisplayConformant   -> String
"conformant"
   DisplayCapability
DisplaySlow         -> String
"slow"
   DisplayCapability
DisplayWin32PFD     -> String
"win32pfd"
   DisplayCapability
DisplayXVisual      -> String
"xvisual"
   DisplayCapability
DisplayXStaticGray  -> String
"xstaticgray"
   DisplayCapability
DisplayXGrayScale   -> String
"xgrayscale"
   DisplayCapability
DisplayXStaticColor -> String
"xstaticcolor"
   DisplayCapability
DisplayXPseudoColor -> String
"xpseudocolor"
   DisplayCapability
DisplayXTrueColor   -> String
"xtruecolor"
   DisplayCapability
DisplayXDirectColor -> String
"xdirectcolor"

-- | A single capability description for 'initialDisplayCapabilities'.

data DisplayCapabilityDescription
   = Where DisplayCapability Relation Int
     -- ^ A description of a capability with a specific relation to a numeric
     --   value.
   | With  DisplayCapability
     -- ^ When the relation and numeric value are not specified, each capability
     --   has a different default, see the different constructors of
     --   'DisplayCapability'.
   deriving ( DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Bool
(DisplayCapabilityDescription
 -> DisplayCapabilityDescription -> Bool)
-> (DisplayCapabilityDescription
    -> DisplayCapabilityDescription -> Bool)
-> Eq DisplayCapabilityDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Bool
$c/= :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Bool
== :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Bool
$c== :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Bool
Eq, Eq DisplayCapabilityDescription
Eq DisplayCapabilityDescription
-> (DisplayCapabilityDescription
    -> DisplayCapabilityDescription -> Ordering)
-> (DisplayCapabilityDescription
    -> DisplayCapabilityDescription -> Bool)
-> (DisplayCapabilityDescription
    -> DisplayCapabilityDescription -> Bool)
-> (DisplayCapabilityDescription
    -> DisplayCapabilityDescription -> Bool)
-> (DisplayCapabilityDescription
    -> DisplayCapabilityDescription -> Bool)
-> (DisplayCapabilityDescription
    -> DisplayCapabilityDescription -> DisplayCapabilityDescription)
-> (DisplayCapabilityDescription
    -> DisplayCapabilityDescription -> DisplayCapabilityDescription)
-> Ord DisplayCapabilityDescription
DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Bool
DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Ordering
DisplayCapabilityDescription
-> DisplayCapabilityDescription -> DisplayCapabilityDescription
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 :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> DisplayCapabilityDescription
$cmin :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> DisplayCapabilityDescription
max :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> DisplayCapabilityDescription
$cmax :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> DisplayCapabilityDescription
>= :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Bool
$c>= :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Bool
> :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Bool
$c> :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Bool
<= :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Bool
$c<= :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Bool
< :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Bool
$c< :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Bool
compare :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Ordering
$ccompare :: DisplayCapabilityDescription
-> DisplayCapabilityDescription -> Ordering
$cp1Ord :: Eq DisplayCapabilityDescription
Ord, Int -> DisplayCapabilityDescription -> ShowS
[DisplayCapabilityDescription] -> ShowS
DisplayCapabilityDescription -> String
(Int -> DisplayCapabilityDescription -> ShowS)
-> (DisplayCapabilityDescription -> String)
-> ([DisplayCapabilityDescription] -> ShowS)
-> Show DisplayCapabilityDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisplayCapabilityDescription] -> ShowS
$cshowList :: [DisplayCapabilityDescription] -> ShowS
show :: DisplayCapabilityDescription -> String
$cshow :: DisplayCapabilityDescription -> String
showsPrec :: Int -> DisplayCapabilityDescription -> ShowS
$cshowsPrec :: Int -> DisplayCapabilityDescription -> ShowS
Show )

displayCapabilityDescriptionToString ::  DisplayCapabilityDescription -> String
displayCapabilityDescriptionToString :: DisplayCapabilityDescription -> String
displayCapabilityDescriptionToString (Where DisplayCapability
c Relation
r Int
i) =
   DisplayCapability -> String
displayCapabilityToString DisplayCapability
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ Relation -> String
relationToString Relation
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
displayCapabilityDescriptionToString (With DisplayCapability
c) = DisplayCapability -> String
displayCapabilityToString DisplayCapability
c

-- | Controls the /initial display mode/ used when creating top-level windows,
-- subwindows, and overlays to determine the OpenGL display mode for the
-- to-be-created window or overlay. It is described by a list of zero or more
-- capability descriptions, which are translated into a set of criteria used to
-- select the appropriate frame buffer configuration. The criteria are matched
-- in strict left to right order of precdence. That is, the first specified
-- criterion (leftmost) takes precedence over the later criteria for non-exact
-- criteria ('IsGreaterThan', 'IsLessThan', etc.). Exact criteria ('IsEqualTo',
-- 'IsNotEqualTo') must match exactly so precedence is not relevant.
--
-- Unspecified capability descriptions will result in unspecified criteria being
-- generated. These unspecified criteria help 'initialDisplayCapabilities'
-- behave sensibly with terse display mode descriptions.
--
-- Here is an example using 'initialDisplayCapabilities':
--
-- @
--    initialDisplayCapabilities $= [ With  DisplayRGB,
--                                    Where DisplayDepth IsAtLeast 16,
--                                    With  DisplaySamples,
--                                    Where DisplayStencil IsNotLessThan 2,
--                                    With  DisplayDouble ]
-- @
--
-- The above call requests a window with an RGBA color model (but requesting
-- no bits of alpha), a depth buffer with at least 16 bits of precision but
-- preferring more, multisampling if available, at least 2 bits of stencil
-- (favoring less stencil to more as long as 2 bits are available), and double
-- buffering.

initialDisplayCapabilities :: SettableStateVar [DisplayCapabilityDescription]
initialDisplayCapabilities :: SettableStateVar [DisplayCapabilityDescription]
initialDisplayCapabilities =
   ([DisplayCapabilityDescription] -> IO ())
-> SettableStateVar [DisplayCapabilityDescription]
forall a. (a -> IO ()) -> SettableStateVar a
makeSettableStateVar (([DisplayCapabilityDescription] -> IO ())
 -> SettableStateVar [DisplayCapabilityDescription])
-> ([DisplayCapabilityDescription] -> IO ())
-> SettableStateVar [DisplayCapabilityDescription]
forall a b. (a -> b) -> a -> b
$ \[DisplayCapabilityDescription]
caps ->
      String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString
         ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([DisplayCapabilityDescription] -> [String])
-> [DisplayCapabilityDescription]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" " ([String] -> [String])
-> ([DisplayCapabilityDescription] -> [String])
-> [DisplayCapabilityDescription]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DisplayCapabilityDescription -> String)
-> [DisplayCapabilityDescription] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map DisplayCapabilityDescription -> String
displayCapabilityDescriptionToString ([DisplayCapabilityDescription] -> String)
-> [DisplayCapabilityDescription] -> String
forall a b. (a -> b) -> a -> b
$
          [DisplayCapabilityDescription]
caps)
         CString -> IO ()
forall (m :: * -> *). MonadIO m => CString -> m ()
glutInitDisplayString

-----------------------------------------------------------------------------

-- | How rendering context for new windows are created.

data RenderingContext
   = -- | Create a new context via @glXCreateContext@ or @wglCreateContext@
     --   (default).
     CreateNewContext
   | -- | Re-use the current rendering context.
     UseCurrentContext
   deriving ( RenderingContext -> RenderingContext -> Bool
(RenderingContext -> RenderingContext -> Bool)
-> (RenderingContext -> RenderingContext -> Bool)
-> Eq RenderingContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderingContext -> RenderingContext -> Bool
$c/= :: RenderingContext -> RenderingContext -> Bool
== :: RenderingContext -> RenderingContext -> Bool
$c== :: RenderingContext -> RenderingContext -> Bool
Eq, Eq RenderingContext
Eq RenderingContext
-> (RenderingContext -> RenderingContext -> Ordering)
-> (RenderingContext -> RenderingContext -> Bool)
-> (RenderingContext -> RenderingContext -> Bool)
-> (RenderingContext -> RenderingContext -> Bool)
-> (RenderingContext -> RenderingContext -> Bool)
-> (RenderingContext -> RenderingContext -> RenderingContext)
-> (RenderingContext -> RenderingContext -> RenderingContext)
-> Ord RenderingContext
RenderingContext -> RenderingContext -> Bool
RenderingContext -> RenderingContext -> Ordering
RenderingContext -> RenderingContext -> RenderingContext
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 :: RenderingContext -> RenderingContext -> RenderingContext
$cmin :: RenderingContext -> RenderingContext -> RenderingContext
max :: RenderingContext -> RenderingContext -> RenderingContext
$cmax :: RenderingContext -> RenderingContext -> RenderingContext
>= :: RenderingContext -> RenderingContext -> Bool
$c>= :: RenderingContext -> RenderingContext -> Bool
> :: RenderingContext -> RenderingContext -> Bool
$c> :: RenderingContext -> RenderingContext -> Bool
<= :: RenderingContext -> RenderingContext -> Bool
$c<= :: RenderingContext -> RenderingContext -> Bool
< :: RenderingContext -> RenderingContext -> Bool
$c< :: RenderingContext -> RenderingContext -> Bool
compare :: RenderingContext -> RenderingContext -> Ordering
$ccompare :: RenderingContext -> RenderingContext -> Ordering
$cp1Ord :: Eq RenderingContext
Ord, Int -> RenderingContext -> ShowS
[RenderingContext] -> ShowS
RenderingContext -> String
(Int -> RenderingContext -> ShowS)
-> (RenderingContext -> String)
-> ([RenderingContext] -> ShowS)
-> Show RenderingContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderingContext] -> ShowS
$cshowList :: [RenderingContext] -> ShowS
show :: RenderingContext -> String
$cshow :: RenderingContext -> String
showsPrec :: Int -> RenderingContext -> ShowS
$cshowsPrec :: Int -> RenderingContext -> ShowS
Show )

marshalRenderingContext :: RenderingContext -> CInt
marshalRenderingContext :: RenderingContext -> CInt
marshalRenderingContext RenderingContext
CreateNewContext  = CInt
glut_CREATE_NEW_CONTEXT
marshalRenderingContext RenderingContext
UseCurrentContext = CInt
glut_USE_CURRENT_CONTEXT

unmarshalRenderingContext :: CInt -> RenderingContext
unmarshalRenderingContext :: CInt -> RenderingContext
unmarshalRenderingContext CInt
r
   | CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_CREATE_NEW_CONTEXT  = RenderingContext
CreateNewContext
   | CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_USE_CURRENT_CONTEXT = RenderingContext
UseCurrentContext
   | Bool
otherwise = String -> RenderingContext
forall a. HasCallStack => String -> a
error String
"unmarshalRenderingContext"

-----------------------------------------------------------------------------

-- | (/freeglut only/) Controls the creation of rendering contexts for new
-- windows.

renderingContext :: StateVar RenderingContext
renderingContext :: StateVar RenderingContext
renderingContext =
   IO RenderingContext
-> (RenderingContext -> IO ()) -> StateVar RenderingContext
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (Getter RenderingContext
forall a. Getter a
simpleGet CInt -> RenderingContext
unmarshalRenderingContext GLenum
glut_RENDERING_CONTEXT)
      (GLenum -> CInt -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> CInt -> m ()
glutSetOption GLenum
glut_RENDERING_CONTEXT (CInt -> IO ())
-> (RenderingContext -> CInt) -> RenderingContext -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderingContext -> CInt
marshalRenderingContext)

-----------------------------------------------------------------------------

-- | The kind of GLX rendering context used. Direct rendering provides a
-- performance advantage in some implementations. However, direct rendering
-- contexts cannot be shared outside a single process, and they may be unable
-- to render to GLX pixmaps.

data DirectRendering
   = -- | Rendering is always done through the X server. This corresponds to
     -- the command line argument @-indirect@, see 'initialize'.
     ForceIndirectContext
   | -- | Try to use direct rendering, silently using indirect rendering if this
     -- is not possible.
     AllowDirectContext
   | -- | Try to use direct rendering, issue a warning and use indirect
     -- rendering if this is not possible.
     TryDirectContext
   | -- | Try to use direct rendering, issue an error and terminate the program
     -- if this is not possible.This corresponds to the command line argument
     -- @-direct@, see 'initialize'.
     ForceDirectContext
   deriving ( DirectRendering -> DirectRendering -> Bool
(DirectRendering -> DirectRendering -> Bool)
-> (DirectRendering -> DirectRendering -> Bool)
-> Eq DirectRendering
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DirectRendering -> DirectRendering -> Bool
$c/= :: DirectRendering -> DirectRendering -> Bool
== :: DirectRendering -> DirectRendering -> Bool
$c== :: DirectRendering -> DirectRendering -> Bool
Eq, Eq DirectRendering
Eq DirectRendering
-> (DirectRendering -> DirectRendering -> Ordering)
-> (DirectRendering -> DirectRendering -> Bool)
-> (DirectRendering -> DirectRendering -> Bool)
-> (DirectRendering -> DirectRendering -> Bool)
-> (DirectRendering -> DirectRendering -> Bool)
-> (DirectRendering -> DirectRendering -> DirectRendering)
-> (DirectRendering -> DirectRendering -> DirectRendering)
-> Ord DirectRendering
DirectRendering -> DirectRendering -> Bool
DirectRendering -> DirectRendering -> Ordering
DirectRendering -> DirectRendering -> DirectRendering
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 :: DirectRendering -> DirectRendering -> DirectRendering
$cmin :: DirectRendering -> DirectRendering -> DirectRendering
max :: DirectRendering -> DirectRendering -> DirectRendering
$cmax :: DirectRendering -> DirectRendering -> DirectRendering
>= :: DirectRendering -> DirectRendering -> Bool
$c>= :: DirectRendering -> DirectRendering -> Bool
> :: DirectRendering -> DirectRendering -> Bool
$c> :: DirectRendering -> DirectRendering -> Bool
<= :: DirectRendering -> DirectRendering -> Bool
$c<= :: DirectRendering -> DirectRendering -> Bool
< :: DirectRendering -> DirectRendering -> Bool
$c< :: DirectRendering -> DirectRendering -> Bool
compare :: DirectRendering -> DirectRendering -> Ordering
$ccompare :: DirectRendering -> DirectRendering -> Ordering
$cp1Ord :: Eq DirectRendering
Ord, Int -> DirectRendering -> ShowS
[DirectRendering] -> ShowS
DirectRendering -> String
(Int -> DirectRendering -> ShowS)
-> (DirectRendering -> String)
-> ([DirectRendering] -> ShowS)
-> Show DirectRendering
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DirectRendering] -> ShowS
$cshowList :: [DirectRendering] -> ShowS
show :: DirectRendering -> String
$cshow :: DirectRendering -> String
showsPrec :: Int -> DirectRendering -> ShowS
$cshowsPrec :: Int -> DirectRendering -> ShowS
Show )

marshalDirectRendering :: DirectRendering -> CInt
marshalDirectRendering :: DirectRendering -> CInt
marshalDirectRendering DirectRendering
x = case DirectRendering
x of
   DirectRendering
ForceIndirectContext -> CInt
glut_FORCE_INDIRECT_CONTEXT
   DirectRendering
AllowDirectContext -> CInt
glut_ALLOW_DIRECT_CONTEXT
   DirectRendering
TryDirectContext -> CInt
glut_TRY_DIRECT_CONTEXT
   DirectRendering
ForceDirectContext -> CInt
glut_FORCE_DIRECT_CONTEXT

unmarshalDirectRendering :: CInt -> DirectRendering
unmarshalDirectRendering :: CInt -> DirectRendering
unmarshalDirectRendering CInt
x
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_FORCE_INDIRECT_CONTEXT = DirectRendering
ForceIndirectContext
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_ALLOW_DIRECT_CONTEXT = DirectRendering
AllowDirectContext
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_TRY_DIRECT_CONTEXT = DirectRendering
TryDirectContext
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_FORCE_DIRECT_CONTEXT = DirectRendering
ForceDirectContext
   | Bool
otherwise = String -> DirectRendering
forall a. HasCallStack => String -> a
error (String
"unmarshalDirectRendering: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
x)

-----------------------------------------------------------------------------

-- | (/freeglut on X11 only/) Controls which kind of rendering context is
-- created when a new one is required.

directRendering :: StateVar DirectRendering
directRendering :: StateVar DirectRendering
directRendering =
   IO DirectRendering
-> (DirectRendering -> IO ()) -> StateVar DirectRendering
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (Getter DirectRendering
forall a. Getter a
simpleGet CInt -> DirectRendering
unmarshalDirectRendering GLenum
glut_DIRECT_RENDERING)
      (GLenum -> CInt -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> CInt -> m ()
glutSetOption GLenum
glut_DIRECT_RENDERING (CInt -> IO ())
-> (DirectRendering -> CInt) -> DirectRendering -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirectRendering -> CInt
marshalDirectRendering)

-----------------------------------------------------------------------------

-- | (/freeglut only/) Controls the API major\/minor version of the OpenGL
-- context. If a version less than or equal to 2.1 is requested, the context
-- returned may implement any version no less than that requested and no
-- greater than 2.1. If version 3.0 is requested, the context returned must
-- implement exactly version 3.0. Versioning behavior once GL versions beyond
-- 3.0 are defined will be defined by an amendment to the OpenGL specification
-- to define dependencies on such GL versions.
--
-- 'Graphics.Rendering.OpenGL.GL.StringQueries.glVersion' and
-- 'Graphics.Rendering.OpenGL.GL.StringQueries.majorMinor' will return the
-- actual version supported by a context.
--
-- The default context version is (1, 0), which will typically return an
-- OpenGL 2.1 context, if one is available.

initialContextVersion :: StateVar (Int, Int)
initialContextVersion :: StateVar (Int, Int)
initialContextVersion = IO (Int, Int) -> ((Int, Int) -> IO ()) -> StateVar (Int, Int)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO (Int, Int)
getContextVersion (Int, Int) -> IO ()
setContextVersion

getContextVersion :: IO (Int, Int)
getContextVersion :: IO (Int, Int)
getContextVersion = do
   Int
major <- Getter Int
forall a. Getter a
simpleGet CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_INIT_MAJOR_VERSION
   Int
minor <- Getter Int
forall a. Getter a
simpleGet CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_INIT_MINOR_VERSION
   (Int, Int) -> IO (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
major, Int
minor)

setContextVersion :: (Int, Int) -> IO ()
setContextVersion :: (Int, Int) -> IO ()
setContextVersion (Int
major, Int
minor) =
   CInt -> CInt -> IO ()
forall (m :: * -> *). MonadIO m => CInt -> CInt -> m ()
glutInitContextVersion (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
major) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minor)

-----------------------------------------------------------------------------

-- | A flag affecting the rendering context to create, used in conjunction
-- with 'initialContextFlags'.

data ContextFlag
   = -- | Debug contexts are intended for use during application development,
     -- and provide additional runtime checking, validation, and logging
     -- functionality while possibly incurring performance penalties. The
     -- additional functionality provided by debug contexts may vary according
     -- to the implementation. In some cases a debug context may be identical
     -- to a non-debug context.
     DebugContext
   | -- | Forward-compatible contexts are defined only for OpenGL versions 3.0
     -- and later. They must not support functionality marked as /deprecated/
     -- by that version of the API, while a non-forward-compatible context must
     -- support all functionality in that version, deprecated or not.
     ForwardCompatibleContext
   deriving ( ContextFlag -> ContextFlag -> Bool
(ContextFlag -> ContextFlag -> Bool)
-> (ContextFlag -> ContextFlag -> Bool) -> Eq ContextFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContextFlag -> ContextFlag -> Bool
$c/= :: ContextFlag -> ContextFlag -> Bool
== :: ContextFlag -> ContextFlag -> Bool
$c== :: ContextFlag -> ContextFlag -> Bool
Eq, Eq ContextFlag
Eq ContextFlag
-> (ContextFlag -> ContextFlag -> Ordering)
-> (ContextFlag -> ContextFlag -> Bool)
-> (ContextFlag -> ContextFlag -> Bool)
-> (ContextFlag -> ContextFlag -> Bool)
-> (ContextFlag -> ContextFlag -> Bool)
-> (ContextFlag -> ContextFlag -> ContextFlag)
-> (ContextFlag -> ContextFlag -> ContextFlag)
-> Ord ContextFlag
ContextFlag -> ContextFlag -> Bool
ContextFlag -> ContextFlag -> Ordering
ContextFlag -> ContextFlag -> ContextFlag
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 :: ContextFlag -> ContextFlag -> ContextFlag
$cmin :: ContextFlag -> ContextFlag -> ContextFlag
max :: ContextFlag -> ContextFlag -> ContextFlag
$cmax :: ContextFlag -> ContextFlag -> ContextFlag
>= :: ContextFlag -> ContextFlag -> Bool
$c>= :: ContextFlag -> ContextFlag -> Bool
> :: ContextFlag -> ContextFlag -> Bool
$c> :: ContextFlag -> ContextFlag -> Bool
<= :: ContextFlag -> ContextFlag -> Bool
$c<= :: ContextFlag -> ContextFlag -> Bool
< :: ContextFlag -> ContextFlag -> Bool
$c< :: ContextFlag -> ContextFlag -> Bool
compare :: ContextFlag -> ContextFlag -> Ordering
$ccompare :: ContextFlag -> ContextFlag -> Ordering
$cp1Ord :: Eq ContextFlag
Ord, Int -> ContextFlag -> ShowS
[ContextFlag] -> ShowS
ContextFlag -> String
(Int -> ContextFlag -> ShowS)
-> (ContextFlag -> String)
-> ([ContextFlag] -> ShowS)
-> Show ContextFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContextFlag] -> ShowS
$cshowList :: [ContextFlag] -> ShowS
show :: ContextFlag -> String
$cshow :: ContextFlag -> String
showsPrec :: Int -> ContextFlag -> ShowS
$cshowsPrec :: Int -> ContextFlag -> ShowS
Show )

marshalContextFlag :: ContextFlag -> CInt
marshalContextFlag :: ContextFlag -> CInt
marshalContextFlag ContextFlag
x = case ContextFlag
x of
   ContextFlag
DebugContext -> CInt
glut_DEBUG
   ContextFlag
ForwardCompatibleContext -> CInt
glut_FORWARD_COMPATIBLE

-----------------------------------------------------------------------------

-- | (/freeglut only/) Controls the set of flags for the rendering context.

initialContextFlags :: StateVar [ContextFlag]
initialContextFlags :: StateVar [ContextFlag]
initialContextFlags = IO [ContextFlag]
-> ([ContextFlag] -> IO ()) -> StateVar [ContextFlag]
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO [ContextFlag]
getContextFlags [ContextFlag] -> IO ()
setContextFlags

getContextFlags :: IO [ContextFlag]
getContextFlags :: IO [ContextFlag]
getContextFlags = Getter [ContextFlag]
forall a. Getter a
simpleGet CInt -> [ContextFlag]
i2cfs GLenum
glut_INIT_FLAGS

i2cfs :: CInt -> [ContextFlag]
i2cfs :: CInt -> [ContextFlag]
i2cfs CInt
bitfield =
   [ ContextFlag
c | ContextFlag
c <- [ ContextFlag
DebugContext, ContextFlag
ForwardCompatibleContext ]
       , (CInt -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
bitfield CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. ContextFlag -> CInt
marshalContextFlag ContextFlag
c) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0 ]

setContextFlags :: [ContextFlag] -> IO ()
setContextFlags :: [ContextFlag] -> IO ()
setContextFlags = CInt -> IO ()
forall (m :: * -> *). MonadIO m => CInt -> m ()
glutInitContextFlags (CInt -> IO ())
-> ([ContextFlag] -> CInt) -> [ContextFlag] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContextFlag -> CInt) -> [ContextFlag] -> CInt
forall b a. (Num b, Bits b) => (a -> b) -> [a] -> b
toBitfield ContextFlag -> CInt
marshalContextFlag


-----------------------------------------------------------------------------

-- | An OpenGL API profile, affecting the rendering context to create, used
-- in conjunction with 'initialContextProfile'.

data ContextProfile
   = -- | The OpenGL /core/ profile, which all OpenGL 3.2 implementations
     -- are required to support.
      CoreProfile
   | -- | The OpenGL /compatibility/ profile, which is optional for OpenGL
     -- 3.2 implementations.
     CompatibilityProfile
   deriving ( ContextProfile -> ContextProfile -> Bool
(ContextProfile -> ContextProfile -> Bool)
-> (ContextProfile -> ContextProfile -> Bool) -> Eq ContextProfile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContextProfile -> ContextProfile -> Bool
$c/= :: ContextProfile -> ContextProfile -> Bool
== :: ContextProfile -> ContextProfile -> Bool
$c== :: ContextProfile -> ContextProfile -> Bool
Eq, Eq ContextProfile
Eq ContextProfile
-> (ContextProfile -> ContextProfile -> Ordering)
-> (ContextProfile -> ContextProfile -> Bool)
-> (ContextProfile -> ContextProfile -> Bool)
-> (ContextProfile -> ContextProfile -> Bool)
-> (ContextProfile -> ContextProfile -> Bool)
-> (ContextProfile -> ContextProfile -> ContextProfile)
-> (ContextProfile -> ContextProfile -> ContextProfile)
-> Ord ContextProfile
ContextProfile -> ContextProfile -> Bool
ContextProfile -> ContextProfile -> Ordering
ContextProfile -> ContextProfile -> ContextProfile
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 :: ContextProfile -> ContextProfile -> ContextProfile
$cmin :: ContextProfile -> ContextProfile -> ContextProfile
max :: ContextProfile -> ContextProfile -> ContextProfile
$cmax :: ContextProfile -> ContextProfile -> ContextProfile
>= :: ContextProfile -> ContextProfile -> Bool
$c>= :: ContextProfile -> ContextProfile -> Bool
> :: ContextProfile -> ContextProfile -> Bool
$c> :: ContextProfile -> ContextProfile -> Bool
<= :: ContextProfile -> ContextProfile -> Bool
$c<= :: ContextProfile -> ContextProfile -> Bool
< :: ContextProfile -> ContextProfile -> Bool
$c< :: ContextProfile -> ContextProfile -> Bool
compare :: ContextProfile -> ContextProfile -> Ordering
$ccompare :: ContextProfile -> ContextProfile -> Ordering
$cp1Ord :: Eq ContextProfile
Ord, Int -> ContextProfile -> ShowS
[ContextProfile] -> ShowS
ContextProfile -> String
(Int -> ContextProfile -> ShowS)
-> (ContextProfile -> String)
-> ([ContextProfile] -> ShowS)
-> Show ContextProfile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContextProfile] -> ShowS
$cshowList :: [ContextProfile] -> ShowS
show :: ContextProfile -> String
$cshow :: ContextProfile -> String
showsPrec :: Int -> ContextProfile -> ShowS
$cshowsPrec :: Int -> ContextProfile -> ShowS
Show )

marshalContextProfile :: ContextProfile -> CInt
marshalContextProfile :: ContextProfile -> CInt
marshalContextProfile ContextProfile
x = case ContextProfile
x of
   ContextProfile
CoreProfile -> CInt
glut_CORE_PROFILE
   ContextProfile
CompatibilityProfile -> CInt
glut_COMPATIBILITY_PROFILE

-----------------------------------------------------------------------------

-- | (/freeglut only/) Controls the set of profiles for the rendering context.

initialContextProfile :: StateVar [ContextProfile]
initialContextProfile :: StateVar [ContextProfile]
initialContextProfile = IO [ContextProfile]
-> ([ContextProfile] -> IO ()) -> StateVar [ContextProfile]
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO [ContextProfile]
getContextProfiles [ContextProfile] -> IO ()
setContextProfiles

getContextProfiles :: IO [ContextProfile]
getContextProfiles :: IO [ContextProfile]
getContextProfiles = Getter [ContextProfile]
forall a. Getter a
simpleGet CInt -> [ContextProfile]
i2cps GLenum
glut_INIT_PROFILE

i2cps :: CInt -> [ContextProfile]
i2cps :: CInt -> [ContextProfile]
i2cps CInt
bitfield =
   [ ContextProfile
c | ContextProfile
c <- [ ContextProfile
CoreProfile, ContextProfile
CompatibilityProfile ]
       , (CInt -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
bitfield CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. ContextProfile -> CInt
marshalContextProfile ContextProfile
c) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0 ]

setContextProfiles :: [ContextProfile] -> IO ()
setContextProfiles :: [ContextProfile] -> IO ()
setContextProfiles = CInt -> IO ()
forall (m :: * -> *). MonadIO m => CInt -> m ()
glutInitContextProfile (CInt -> IO ())
-> ([ContextProfile] -> CInt) -> [ContextProfile] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContextProfile -> CInt) -> [ContextProfile] -> CInt
forall b a. (Num b, Bits b) => (a -> b) -> [a] -> b
toBitfield ContextProfile -> CInt
marshalContextProfile