    {-# OPTIONS_HADDOCK hide #-}
    module Graphics.Gloss.Internals.Interface.Backend.GLUT
            (GLUTState,glutStateInit,initializeGLUT)
    where

    import Data.IORef
    import Control.Monad
    import Control.Concurrent
    import Graphics.UI.GLUT                           (get,($=))
    import qualified Graphics.Rendering.OpenGL as GL
    import qualified Graphics.UI.GLUT               as GLUT
    import qualified System.Exit                    as System
    import Graphics.Gloss.Internals.Interface.Backend.Types
    import System.IO.Unsafe

    -- Were we to support freeglut only, we could use GLUT.get to discover
    -- whether we are initialized or not. If not, we do a quick initialize,
    -- get the screenzie, and then do GLUT.exit. This avoids the use of
    -- global variables. Unfortunately, there is no failsafe way to check
    -- whether glut is initialized in some older versions of glut, which is
    -- what we'd use instead of the global variable to get the required info.
    glutInitialized :: IORef Bool
    {-# NOINLINE glutInitialized #-}
    glutInitialized :: IORef Bool
    glutInitialized = IO (IORef Bool) -> IORef Bool
    forall a. IO a -> a
    unsafePerformIO (IO (IORef Bool) -> IORef Bool) -> IO (IORef Bool) -> IORef Bool
    forall a b. (a -> b) -> a -> b
    $ do Bool -> IO (IORef Bool)
    forall a. a -> IO (IORef a)
    newIORef Bool
    False

    -- | State information for the GLUT backend.
    data GLUTState
            = GLUTState
            { -- Count of total number of frames that we have drawn.
              GLUTState -> Int
    glutStateFrameCount   :: !Int

              -- Bool to remember if we've set the timeout callback.
            , GLUTState -> Bool
    glutStateHasTimeout   :: Bool

              -- Bool to remember if we've set the idle callback.
            , GLUTState -> Bool
    glutStateHasIdle      :: Bool }
            deriving Int -> GLUTState -> ShowS
    [GLUTState] -> ShowS
    GLUTState -> String
    (Int -> GLUTState -> ShowS)
    -> (GLUTState -> String)
    -> ([GLUTState] -> ShowS)
    -> Show GLUTState
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> GLUTState -> ShowS
    showsPrec :: Int -> GLUTState -> ShowS
    $cshow :: GLUTState -> String
    show :: GLUTState -> String
    $cshowList :: [GLUTState] -> ShowS
    showList :: [GLUTState] -> ShowS
    Show

    -- | Initial GLUT state.
    glutStateInit :: GLUTState
    glutStateInit :: GLUTState
    glutStateInit
            = GLUTState
            { glutStateFrameCount :: Int
    glutStateFrameCount   = Int
    0
            , glutStateHasTimeout :: Bool
    glutStateHasTimeout   = Bool
    False
            , glutStateHasIdle :: Bool
    glutStateHasIdle      = Bool
    False }

    instance Backend GLUTState where
            initBackendState :: GLUTState
    initBackendState           = GLUTState
    glutStateInit
            initializeBackend :: IORef GLUTState -> Bool -> IdleCallback
    initializeBackend          = IORef GLUTState -> Bool -> IdleCallback
    initializeGLUT

            -- non-freeglut doesn't like this: (\_ -> GLUT.leaveMainLoop)
            exitBackend :: IORef GLUTState -> IdleCallback
    exitBackend                = (\IORef GLUTState
    _ -> ExitCode -> IdleCallback
    forall a. ExitCode -> IO a
    System.exitWith ExitCode
    System.ExitSuccess)

            openWindow :: IORef GLUTState -> Display -> IdleCallback
    openWindow                 = IORef GLUTState -> Display -> IdleCallback
    openWindowGLUT
            dumpBackendState :: IORef GLUTState -> IdleCallback
    dumpBackendState           = IORef GLUTState -> IdleCallback
    dumpStateGLUT
            installDisplayCallback :: IORef GLUTState -> [Callback] -> IdleCallback
    installDisplayCallback     = IORef GLUTState -> [Callback] -> IdleCallback
    installDisplayCallbackGLUT

            -- We can ask for this in freeglut, but it doesn't seem to work :(.
            -- (\_ -> GLUT.actionOnWindowClose $= GLUT.MainLoopReturns)
            installWindowCloseCallback :: IORef GLUTState -> IdleCallback
    installWindowCloseCallback = (\IORef GLUTState
    _ -> () -> IdleCallback
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

            installReshapeCallback :: IORef GLUTState -> [Callback] -> IdleCallback
    installReshapeCallback     = IORef GLUTState -> [Callback] -> IdleCallback
    installReshapeCallbackGLUT
            installKeyMouseCallback :: IORef GLUTState -> [Callback] -> IdleCallback
    installKeyMouseCallback    = IORef GLUTState -> [Callback] -> IdleCallback
    installKeyMouseCallbackGLUT
            installMotionCallback :: IORef GLUTState -> [Callback] -> IdleCallback
    installMotionCallback      = IORef GLUTState -> [Callback] -> IdleCallback
    installMotionCallbackGLUT
            installIdleCallback :: IORef GLUTState -> [Callback] -> IdleCallback
    installIdleCallback        = IORef GLUTState -> [Callback] -> IdleCallback
    installIdleCallbackGLUT

            -- Call the GLUT mainloop.
            -- This function will return when something calls GLUT.leaveMainLoop
            runMainLoop :: IORef GLUTState -> IdleCallback
    runMainLoop IORef GLUTState
    _
             =      IdleCallback
    forall (m :: * -> *). MonadIO m => m ()
    GLUT.mainLoop

            postRedisplay :: IORef GLUTState -> IdleCallback
    postRedisplay IORef GLUTState
    _
             =      Maybe Window -> IdleCallback
    forall (m :: * -> *). MonadIO m => Maybe Window -> m ()
    GLUT.postRedisplay Maybe Window
    forall a. Maybe a
    Nothing

            getWindowDimensions :: IORef GLUTState -> IO (Int, Int)
    getWindowDimensions IORef GLUTState
    _
             = do   GL.Size GLsizei
    sizeX GLsizei
    sizeY   <- StateVar Size -> GettableStateVar Size
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *). MonadIO m => StateVar Size -> m Size
    get StateVar Size
    GLUT.windowSize
                    (Int, Int) -> IO (Int, Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GLsizei -> Int
    forall a. Enum a => a -> Int
    fromEnum GLsizei
    sizeX,GLsizei -> Int
    forall a. Enum a => a -> Int
    fromEnum GLsizei
    sizeY)

            getScreenSize :: IORef GLUTState -> IO (Int, Int)
    getScreenSize IORef GLUTState
    _
             = do   GL.Size GLsizei
    width GLsizei
    height  <- GettableStateVar Size -> GettableStateVar Size
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *). MonadIO m => GettableStateVar Size -> m Size
    get GettableStateVar Size
    GLUT.screenSize
                    (Int, Int) -> IO (Int, Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GLsizei -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral GLsizei
    width, GLsizei -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral GLsizei
    height)

            elapsedTime :: IORef GLUTState -> IO Double
    elapsedTime IORef GLUTState
    _
             = do   Int
    t       <- GettableStateVar Int -> GettableStateVar Int
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *). MonadIO m => GettableStateVar Int -> m Int
    get GettableStateVar Int
    GLUT.elapsedTime
                    Double -> IO Double
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Double -> IO Double) -> Double -> IO Double
    forall a b. (a -> b) -> a -> b
    $ (Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    t) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    1000

            sleep :: IORef GLUTState -> Double -> IdleCallback
    sleep IORef GLUTState
    _ Double
    sec
             = do   Int -> IdleCallback
    threadDelay (Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Double -> Int) -> Double -> Int
    forall a b. (a -> b) -> a -> b
    $ Double
    sec Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    1000000)

    -- Initialise -----------------------------------------------------------------
    initializeGLUT
            :: IORef GLUTState
            -> Bool
            -> IO ()

    initializeGLUT :: IORef GLUTState -> Bool -> IdleCallback
    initializeGLUT IORef GLUTState
    _ Bool
    debug
      = do Bool
    initialized <- IORef Bool -> GettableStateVar Bool
    forall a. IORef a -> IO a
    readIORef IORef Bool
    glutInitialized
           if Bool -> Bool
    not Bool
    initialized
             then do  (String
    _progName, [String]
    _args)  <- IO (String, [String])
    forall (m :: * -> *). MonadIO m => m (String, [String])
    GLUT.getArgsAndInitialize
                      String
    glutVersion         <- GettableStateVar String -> GettableStateVar String
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *).
    MonadIO m =>
    GettableStateVar String -> m String
    get GettableStateVar String
    GLUT.glutVersion
                      Bool -> IdleCallback -> IdleCallback
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    debug
                        (IdleCallback -> IdleCallback) -> IdleCallback -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $ String -> IdleCallback
    putStr  (String -> IdleCallback) -> String -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $ String
    "  glutVersion        = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show String
    glutVersion   String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"

                      StateVar [DisplayMode]
    GLUT.initialDisplayMode
                        StateVar [DisplayMode] -> [DisplayMode] -> IdleCallback
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    StateVar [DisplayMode] -> [DisplayMode] -> m ()
    $= [ DisplayMode
    GLUT.RGBMode
                           , DisplayMode
    GLUT.DoubleBuffered]

                      IORef Bool -> Bool -> IdleCallback
    forall a. IORef a -> a -> IdleCallback
    writeIORef IORef Bool
    glutInitialized Bool
    True

                      -- See if our requested display mode is possible
                      [DisplayMode]
    displayMode         <- StateVar [DisplayMode] -> IO [DisplayMode]
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *).
    MonadIO m =>
    StateVar [DisplayMode] -> m [DisplayMode]
    get StateVar [DisplayMode]
    GLUT.initialDisplayMode
                      Bool
    displayModePossible <- GettableStateVar Bool -> GettableStateVar Bool
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *). MonadIO m => GettableStateVar Bool -> m Bool
    get GettableStateVar Bool
    GLUT.displayModePossible
                      Bool -> IdleCallback -> IdleCallback
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    debug
                        (IdleCallback -> IdleCallback) -> IdleCallback -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $ do String -> IdleCallback
    putStr (String -> IdleCallback) -> String -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $  String
    "  displayMode        = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [DisplayMode] -> String
    forall a. Show a => a -> String
    show [DisplayMode]
    displayMode String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                                    String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "       possible      = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Bool -> String
    forall a. Show a => a -> String
    show Bool
    displayModePossible String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                                    String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
             else Bool -> IdleCallback -> IdleCallback
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    debug (String -> IdleCallback
    putStrLn String
    "Already initialized")

    -- Open Window ----------------------------------------------------------------
    openWindowGLUT
            :: IORef GLUTState
            -> Display
            -> IO ()

    openWindowGLUT :: IORef GLUTState -> Display -> IdleCallback
    openWindowGLUT IORef GLUTState
    _ Display
    display
     = do
           -- Setup and create a new window.
           -- Be sure to set initialWindow{Position,Size} before calling
           -- createWindow. If we don't do this we get wierd half-created
           -- windows some of the time.
            case Display
    display of
              InWindow String
    windowName (Int
    sizeX, Int
    sizeY) (Int
    posX, Int
    posY) ->
                do StateVar Size
    GLUT.initialWindowSize
                         StateVar Size -> ReshapeCallback
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    forall (m :: * -> *). MonadIO m => StateVar Size -> Size -> m ()
    $= GLsizei -> GLsizei -> Size
    GL.Size
                              (Int -> GLsizei
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    sizeX)
                              (Int -> GLsizei
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    sizeY)

                   StateVar Position
    GLUT.initialWindowPosition
                         StateVar Position -> MotionCallback
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    StateVar Position -> Position -> m ()
    $= GLsizei -> GLsizei -> Position
    GL.Position
                              (Int -> GLsizei
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    posX)
                              (Int -> GLsizei
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    posY)

                   Window
    _ <- String -> IO Window
    forall (m :: * -> *). MonadIO m => String -> m Window
    GLUT.createWindow String
    windowName

                   StateVar Size
    GLUT.windowSize
                         StateVar Size -> ReshapeCallback
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    forall (m :: * -> *). MonadIO m => StateVar Size -> Size -> m ()
    $= GLsizei -> GLsizei -> Size
    GL.Size
                              (Int -> GLsizei
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    sizeX)
                              (Int -> GLsizei
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    sizeY)

              Display
    FullScreen ->
                do Size
    size <- GettableStateVar Size -> GettableStateVar Size
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *). MonadIO m => GettableStateVar Size -> m Size
    get GettableStateVar Size
    GLUT.screenSize
                   StateVar Size
    GLUT.initialWindowSize StateVar Size -> ReshapeCallback
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    forall (m :: * -> *). MonadIO m => StateVar Size -> Size -> m ()
    $= Size
    size
                   Window
    _ <- String -> IO Window
    forall (m :: * -> *). MonadIO m => String -> m Window
    GLUT.createWindow String
    "Gloss Application"
                   IdleCallback
    forall (m :: * -> *). MonadIO m => m ()
    GLUT.fullScreen

            --  Switch some things.
            --  auto repeat interferes with key up / key down checks.
            --  BUGS: this doesn't seem to work?
            StateVar PerWindowKeyRepeat
    GLUT.perWindowKeyRepeat   StateVar PerWindowKeyRepeat -> PerWindowKeyRepeat -> IdleCallback
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    StateVar PerWindowKeyRepeat -> PerWindowKeyRepeat -> m ()
    $= PerWindowKeyRepeat
    GLUT.PerWindowKeyRepeatOff

    -- Dump State -----------------------------------------------------------------
    dumpStateGLUT
            :: IORef GLUTState
            -> IO ()

    dumpStateGLUT :: IORef GLUTState -> IdleCallback
    dumpStateGLUT IORef GLUTState
    _
     = do
            Int
    wbw             <- GettableStateVar Int -> GettableStateVar Int
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *). MonadIO m => GettableStateVar Int -> m Int
    get GettableStateVar Int
    GLUT.windowBorderWidth
            Int
    whh             <- GettableStateVar Int -> GettableStateVar Int
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *). MonadIO m => GettableStateVar Int -> m Int
    get GettableStateVar Int
    GLUT.windowHeaderHeight
            Bool
    rgba            <- GettableStateVar Bool -> GettableStateVar Bool
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *). MonadIO m => GettableStateVar Bool -> m Bool
    get GettableStateVar Bool
    GLUT.rgba

            (Int, Int, Int, Int)
    rgbaBD          <- GettableStateVar (Int, Int, Int, Int)
    -> GettableStateVar (Int, Int, Int, Int)
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *).
    MonadIO m =>
    GettableStateVar (Int, Int, Int, Int) -> m (Int, Int, Int, Int)
    get GettableStateVar (Int, Int, Int, Int)
    GLUT.rgbaBufferDepths
            Int
    colorBD         <- GettableStateVar Int -> GettableStateVar Int
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *). MonadIO m => GettableStateVar Int -> m Int
    get GettableStateVar Int
    GLUT.colorBufferDepth
            Int
    depthBD         <- GettableStateVar Int -> GettableStateVar Int
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *). MonadIO m => GettableStateVar Int -> m Int
    get GettableStateVar Int
    GLUT.depthBufferDepth
            (Int, Int, Int, Int)
    accumBD         <- GettableStateVar (Int, Int, Int, Int)
    -> GettableStateVar (Int, Int, Int, Int)
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *).
    MonadIO m =>
    GettableStateVar (Int, Int, Int, Int) -> m (Int, Int, Int, Int)
    get GettableStateVar (Int, Int, Int, Int)
    GLUT.accumBufferDepths
            Int
    stencilBD       <- GettableStateVar Int -> GettableStateVar Int
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *). MonadIO m => GettableStateVar Int -> m Int
    get GettableStateVar Int
    GLUT.stencilBufferDepth

            Bool
    doubleBuffered  <- GettableStateVar Bool -> GettableStateVar Bool
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *). MonadIO m => GettableStateVar Bool -> m Bool
    get GettableStateVar Bool
    GLUT.doubleBuffered

            Color4 Capability
    colorMask       <- StateVar (Color4 Capability) -> IO (Color4 Capability)
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *).
    MonadIO m =>
    StateVar (Color4 Capability) -> m (Color4 Capability)
    get StateVar (Color4 Capability)
    GLUT.colorMask
            Capability
    depthMask       <- StateVar Capability -> IO Capability
    forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
    forall (m :: * -> *).
    MonadIO m =>
    StateVar Capability -> m Capability
    get StateVar Capability
    GLUT.depthMask

            String -> IdleCallback
    putStr  (String -> IdleCallback) -> String -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $  String
    "* dumpGlutState\n"
                    String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "  windowBorderWidth  = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    wbw            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                    String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "  windowHeaderHeight = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    whh            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                    String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "  rgba               = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Bool -> String
    forall a. Show a => a -> String
    show Bool
    rgba           String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                    String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "  depth      rgba    = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Int, Int, Int, Int) -> String
    forall a. Show a => a -> String
    show (Int, Int, Int, Int)
    rgbaBD         String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                    String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "             color   = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    colorBD        String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                    String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "             depth   = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    depthBD        String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                    String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "             accum   = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Int, Int, Int, Int) -> String
    forall a. Show a => a -> String
    show (Int, Int, Int, Int)
    accumBD        String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                    String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "             stencil = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    stencilBD      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                    String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "  doubleBuffered     = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Bool -> String
    forall a. Show a => a -> String
    show Bool
    doubleBuffered String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                    String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "  mask         color = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Color4 Capability -> String
    forall a. Show a => a -> String
    show Color4 Capability
    colorMask      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                    String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "               depth = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Capability -> String
    forall a. Show a => a -> String
    show Capability
    depthMask      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                    String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"

    -- Display Callback -----------------------------------------------------------
    installDisplayCallbackGLUT
            :: IORef GLUTState -> [Callback]
            -> IO ()
    installDisplayCallbackGLUT :: IORef GLUTState -> [Callback] -> IdleCallback
    installDisplayCallbackGLUT IORef GLUTState
    ref [Callback]
    callbacks
            = SettableStateVar IdleCallback
    GLUT.displayCallback SettableStateVar IdleCallback -> IdleCallback -> IdleCallback
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    SettableStateVar IdleCallback -> IdleCallback -> m ()
    $= IORef GLUTState -> [Callback] -> IdleCallback
    callbackDisplay IORef GLUTState
    ref [Callback]
    callbacks

    callbackDisplay
            :: IORef GLUTState -> [Callback]
            -> IO ()

    callbackDisplay :: IORef GLUTState -> [Callback] -> IdleCallback
    callbackDisplay IORef GLUTState
    refState [Callback]
    callbacks
     = do
            -- Clear the display
            [ClearBuffer] -> IdleCallback
    GL.clear [ClearBuffer
    GL.ColorBuffer, ClearBuffer
    GL.DepthBuffer]
            Color4 GLfloat -> IdleCallback
    forall a. Color a => a -> IdleCallback
    GL.color (Color4 GLfloat -> IdleCallback) -> Color4 GLfloat -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $ GLfloat -> GLfloat -> GLfloat -> GLfloat -> Color4 GLfloat
    forall a. a -> a -> a -> a -> Color4 a
    GL.Color4 GLfloat
    0 GLfloat
    0 GLfloat
    0 (GLfloat
    1 :: GL.GLfloat)

            -- Run all the display callbacks to draw the window contents.
            let funs :: [IdleCallback]
    funs  = [IORef GLUTState -> IdleCallback
    DisplayCallback
    f IORef GLUTState
    refState | (Display DisplayCallback
    f) <- [Callback]
    callbacks]
            [IdleCallback] -> IdleCallback
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [IdleCallback]
    funs

            -- Swap front and back buffers
            IdleCallback
    forall (m :: * -> *). MonadIO m => m ()
    GLUT.swapBuffers

            -- Timeout.
            -- When there is no idle callback set the GLUT mainloop will block
            -- forever waiting for display events. This prevents us from updating
            -- the display on external events like files changing. The API doesn't
            -- provide a way to wake it up on these other events.
            --
            -- Set a timeout so that GLUT will return from its mainloop after a
            -- a second and give us a chance to check for other events.
            --
            -- The alternative would be to set an Idle callback and spin the CPU.
            -- This is ok for real-time animations, but a CPU hog for mostly static
            -- displays.
            --
            -- We only want to add a timeout when one doesn't already exist,
            -- otherwise we'll get both events.
            --
            GLUTState
    state   <- IORef GLUTState -> IO GLUTState
    forall a. IORef a -> IO a
    readIORef IORef GLUTState
    refState
            Bool -> IdleCallback -> IdleCallback
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (  (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ GLUTState -> Bool
    glutStateHasTimeout GLUTState
    state)
                 Bool -> Bool -> Bool
    && (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ GLUTState -> Bool
    glutStateHasIdle    GLUTState
    state))
             (IdleCallback -> IdleCallback) -> IdleCallback -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $ do
                    -- Setting the timer interrupt to 1sec keeps CPU usage for a
                    -- single process to < 0.5% or so on OSX. This is the rate
                    -- that the process is woken up, but GLUT will only actually
                    -- call the display call if postRedisplay has been set.
                    let msecHeartbeat :: Int
    msecHeartbeat = Int
    1000

                    -- We're installing this callback on the first display
                    -- call because it's a GLUT specific mechanism.
                    -- We don't do the same thing for other Backends.
                    Int -> IdleCallback -> IdleCallback
    GLUT.addTimerCallback Int
    msecHeartbeat
                     (IdleCallback -> IdleCallback) -> IdleCallback -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $ Int -> IdleCallback
    timerCallback Int
    msecHeartbeat

                    -- Rember that we've done this filthy hack.
                    IORef GLUTState -> (GLUTState -> (GLUTState, ())) -> IdleCallback
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef GLUTState
    refState
                     ((GLUTState -> (GLUTState, ())) -> IdleCallback)
    -> (GLUTState -> (GLUTState, ())) -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $ \GLUTState
    s -> (GLUTState
    s { glutStateHasTimeout :: Bool
    glutStateHasTimeout = Bool
    True }, ())

        -- Don't report errors by default.
        -- The windows OpenGL implementation seems to complain for no reason.
        --  GLUT.reportErrors

            IORef GLUTState -> (GLUTState -> (GLUTState, ())) -> IdleCallback
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef GLUTState
    refState
             ((GLUTState -> (GLUTState, ())) -> IdleCallback)
    -> (GLUTState -> (GLUTState, ())) -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $ \GLUTState
    s -> ( GLUTState
    s { glutStateFrameCount :: Int
    glutStateFrameCount = GLUTState -> Int
    glutStateFrameCount GLUTState
    s Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 }
                     , ())

            () -> IdleCallback
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Oneshot timer callback that re-registers itself.
    timerCallback :: Int -> IO ()
    timerCallback :: Int -> IdleCallback
    timerCallback Int
    msec
     = do   Int -> IdleCallback -> IdleCallback
    GLUT.addTimerCallback Int
    msec
             (IdleCallback -> IdleCallback) -> IdleCallback -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $ do   Int -> IdleCallback
    timerCallback Int
    msec

    -- Reshape Callback -----------------------------------------------------------
    installReshapeCallbackGLUT
            :: IORef GLUTState -> [Callback]
            -> IO ()

    installReshapeCallbackGLUT :: IORef GLUTState -> [Callback] -> IdleCallback
    installReshapeCallbackGLUT IORef GLUTState
    ref [Callback]
    callbacks
            = SettableStateVar (Maybe ReshapeCallback)
    GLUT.reshapeCallback SettableStateVar (Maybe ReshapeCallback)
    -> Maybe ReshapeCallback -> IdleCallback
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    SettableStateVar (Maybe ReshapeCallback)
    -> Maybe ReshapeCallback -> m ()
    $= ReshapeCallback -> Maybe ReshapeCallback
    forall a. a -> Maybe a
    Just (IORef GLUTState -> [Callback] -> ReshapeCallback
    callbackReshape IORef GLUTState
    ref [Callback]
    callbacks)

    callbackReshape
            :: IORef GLUTState -> [Callback]
            -> GLUT.Size
            -> IO ()

    callbackReshape :: IORef GLUTState -> [Callback] -> ReshapeCallback
    callbackReshape IORef GLUTState
    ref [Callback]
    callbacks (GLUT.Size GLsizei
    sizeX GLsizei
    sizeY)
            = [IdleCallback] -> IdleCallback
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_
            ([IdleCallback] -> IdleCallback) -> [IdleCallback] -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $ (((Int, Int) -> IdleCallback) -> IdleCallback)
    -> [(Int, Int) -> IdleCallback] -> [IdleCallback]
    forall a b. (a -> b) -> [a] -> [b]
    map   (\(Int, Int) -> IdleCallback
    f -> (Int, Int) -> IdleCallback
    f (GLsizei -> Int
    forall a. Enum a => a -> Int
    fromEnum GLsizei
    sizeX, GLsizei -> Int
    forall a. Enum a => a -> Int
    fromEnum GLsizei
    sizeY))
                    [IORef GLUTState -> (Int, Int) -> IdleCallback
    ReshapeCallback
    f IORef GLUTState
    ref | Reshape ReshapeCallback
    f <- [Callback]
    callbacks]

    -- KeyMouse Callback ----------------------------------------------------------
    installKeyMouseCallbackGLUT
            :: IORef GLUTState -> [Callback]
            -> IO ()

    installKeyMouseCallbackGLUT :: IORef GLUTState -> [Callback] -> IdleCallback
    installKeyMouseCallbackGLUT IORef GLUTState
    ref [Callback]
    callbacks
            = SettableStateVar (Maybe KeyboardMouseCallback)
    GLUT.keyboardMouseCallback SettableStateVar (Maybe KeyboardMouseCallback)
    -> Maybe KeyboardMouseCallback -> IdleCallback
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    SettableStateVar (Maybe KeyboardMouseCallback)
    -> Maybe KeyboardMouseCallback -> m ()
    $= KeyboardMouseCallback -> Maybe KeyboardMouseCallback
    forall a. a -> Maybe a
    Just (IORef GLUTState -> [Callback] -> KeyboardMouseCallback
    callbackKeyMouse IORef GLUTState
    ref [Callback]
    callbacks)

    callbackKeyMouse
            :: IORef GLUTState -> [Callback]
            -> GLUT.Key
            -> GLUT.KeyState
            -> GLUT.Modifiers
            -> GLUT.Position
            -> IO ()

    callbackKeyMouse :: IORef GLUTState -> [Callback] -> KeyboardMouseCallback
    callbackKeyMouse IORef GLUTState
    ref [Callback]
    callbacks Key
    key KeyState
    keystate Modifiers
    modifiers (GLUT.Position GLsizei
    posX GLsizei
    posY)
      = [IdleCallback] -> IdleCallback
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_
      ([IdleCallback] -> IdleCallback) -> [IdleCallback] -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $ ((Key -> KeyState -> Modifiers -> (Int, Int) -> IdleCallback)
     -> IdleCallback)
    -> [Key -> KeyState -> Modifiers -> (Int, Int) -> IdleCallback]
    -> [IdleCallback]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Key -> KeyState -> Modifiers -> (Int, Int) -> IdleCallback
    f -> Key -> KeyState -> Modifiers -> (Int, Int) -> IdleCallback
    f Key
    key' KeyState
    keyState' Modifiers
    modifiers' (Int, Int)
    pos)
          [IORef GLUTState
    -> Key -> KeyState -> Modifiers -> (Int, Int) -> IdleCallback
    KeyboardMouseCallback
    f IORef GLUTState
    ref | KeyMouse KeyboardMouseCallback
    f <- [Callback]
    callbacks]
      where
        key' :: Key
    key'       = Key -> Key
    glutKeyToKey Key
    key
        keyState' :: KeyState
    keyState'  = KeyState -> KeyState
    glutKeyStateToKeyState KeyState
    keystate
        modifiers' :: Modifiers
    modifiers' = Modifiers -> Modifiers
    glutModifiersToModifiers Modifiers
    modifiers
        pos :: (Int, Int)
    pos        = (GLsizei -> Int
    forall a. Enum a => a -> Int
    fromEnum GLsizei
    posX, GLsizei -> Int
    forall a. Enum a => a -> Int
    fromEnum GLsizei
    posY)

    -- Motion Callback ------------------------------------------------------------
    installMotionCallbackGLUT
            :: IORef GLUTState -> [Callback]
            -> IO ()

    installMotionCallbackGLUT :: IORef GLUTState -> [Callback] -> IdleCallback
    installMotionCallbackGLUT IORef GLUTState
    ref [Callback]
    callbacks
     = do   SettableStateVar (Maybe MotionCallback)
    GLUT.motionCallback        SettableStateVar (Maybe MotionCallback)
    -> Maybe MotionCallback -> IdleCallback
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    SettableStateVar (Maybe MotionCallback)
    -> Maybe MotionCallback -> m ()
    $= MotionCallback -> Maybe MotionCallback
    forall a. a -> Maybe a
    Just (IORef GLUTState -> [Callback] -> MotionCallback
    callbackMotion IORef GLUTState
    ref [Callback]
    callbacks)
            SettableStateVar (Maybe MotionCallback)
    GLUT.passiveMotionCallback SettableStateVar (Maybe MotionCallback)
    -> Maybe MotionCallback -> IdleCallback
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    SettableStateVar (Maybe MotionCallback)
    -> Maybe MotionCallback -> m ()
    $= MotionCallback -> Maybe MotionCallback
    forall a. a -> Maybe a
    Just (IORef GLUTState -> [Callback] -> MotionCallback
    callbackMotion IORef GLUTState
    ref [Callback]
    callbacks)

    callbackMotion
            :: IORef GLUTState -> [Callback]
            -> GLUT.Position
            -> IO ()

    callbackMotion :: IORef GLUTState -> [Callback] -> MotionCallback
    callbackMotion IORef GLUTState
    ref [Callback]
    callbacks (GLUT.Position GLsizei
    posX GLsizei
    posY)
     = do   let pos :: (Int, Int)
    pos = (GLsizei -> Int
    forall a. Enum a => a -> Int
    fromEnum GLsizei
    posX, GLsizei -> Int
    forall a. Enum a => a -> Int
    fromEnum GLsizei
    posY)
            [IdleCallback] -> IdleCallback
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_
             ([IdleCallback] -> IdleCallback) -> [IdleCallback] -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $ (((Int, Int) -> IdleCallback) -> IdleCallback)
    -> [(Int, Int) -> IdleCallback] -> [IdleCallback]
    forall a b. (a -> b) -> [a] -> [b]
    map  (\(Int, Int) -> IdleCallback
    f -> (Int, Int) -> IdleCallback
    f (Int, Int)
    pos)
                    [IORef GLUTState -> (Int, Int) -> IdleCallback
    ReshapeCallback
    f IORef GLUTState
    ref | Motion ReshapeCallback
    f <- [Callback]
    callbacks]

    -- Idle Callback --------------------------------------------------------------
    installIdleCallbackGLUT
            :: IORef GLUTState -> [Callback]
            -> IO ()

    installIdleCallbackGLUT :: IORef GLUTState -> [Callback] -> IdleCallback
    installIdleCallbackGLUT IORef GLUTState
    refState [Callback]
    callbacks
            -- If the callback list does not actually contain an idle callback
            -- then don't install one that just does nothing. If we do then GLUT
            -- will still call us back after whenever it's idle and waste CPU time.
            | (Callback -> Bool) -> [Callback] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Callback -> Bool
    isIdleCallback [Callback]
    callbacks
            = do    SettableStateVar (Maybe IdleCallback)
    GLUT.idleCallback SettableStateVar (Maybe IdleCallback)
    -> Maybe IdleCallback -> IdleCallback
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    SettableStateVar (Maybe IdleCallback) -> Maybe IdleCallback -> m ()
    $= IdleCallback -> Maybe IdleCallback
    forall a. a -> Maybe a
    Just (IORef GLUTState -> [Callback] -> IdleCallback
    callbackIdle IORef GLUTState
    refState [Callback]
    callbacks)
                    IORef GLUTState -> (GLUTState -> (GLUTState, ())) -> IdleCallback
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef GLUTState
    refState
                     ((GLUTState -> (GLUTState, ())) -> IdleCallback)
    -> (GLUTState -> (GLUTState, ())) -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $ \GLUTState
    state -> (GLUTState
    state { glutStateHasIdle :: Bool
    glutStateHasIdle = Bool
    True }, ())

            | Bool
    otherwise
            = () -> IdleCallback
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Call back when glut is idle.
    callbackIdle
            :: IORef GLUTState -> [Callback]
            -> IO ()

    callbackIdle :: IORef GLUTState -> [Callback] -> IdleCallback
    callbackIdle IORef GLUTState
    ref [Callback]
    callbacks
            = [IdleCallback] -> IdleCallback
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_
            ([IdleCallback] -> IdleCallback) -> [IdleCallback] -> IdleCallback
    forall a b. (a -> b) -> a -> b
    $ [IORef GLUTState -> IdleCallback
    DisplayCallback
    f IORef GLUTState
    ref | Idle DisplayCallback
    f <- [Callback]
    callbacks]

    -------------------------------------------------------------------------------
    -- | Convert GLUTs key codes to our internal ones.
    glutKeyToKey :: GLUT.Key -> Key
    glutKeyToKey :: Key -> Key
    glutKeyToKey Key
    key
     = case Key
    key of
            GLUT.Char Char
    '\32'                            -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeySpace
            GLUT.Char Char
    '\13'                            -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyEnter
            GLUT.Char Char
    '\9'                             -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyTab
            GLUT.Char Char
    '\ESC'                           -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyEsc
            GLUT.Char Char
    '\DEL'                           -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyDelete
            GLUT.Char Char
    c                                -> Char -> Key
    Char Char
    c
            GLUT.SpecialKey SpecialKey
    GLUT.KeyF1                 -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyF1
            GLUT.SpecialKey SpecialKey
    GLUT.KeyF2                 -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyF2
            GLUT.SpecialKey SpecialKey
    GLUT.KeyF3                 -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyF3
            GLUT.SpecialKey SpecialKey
    GLUT.KeyF4                 -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyF4
            GLUT.SpecialKey SpecialKey
    GLUT.KeyF5                 -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyF5
            GLUT.SpecialKey SpecialKey
    GLUT.KeyF6                 -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyF6
            GLUT.SpecialKey SpecialKey
    GLUT.KeyF7                 -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyF7
            GLUT.SpecialKey SpecialKey
    GLUT.KeyF8                 -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyF8
            GLUT.SpecialKey SpecialKey
    GLUT.KeyF9                 -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyF9
            GLUT.SpecialKey SpecialKey
    GLUT.KeyF10                -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyF10
            GLUT.SpecialKey SpecialKey
    GLUT.KeyF11                -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyF11
            GLUT.SpecialKey SpecialKey
    GLUT.KeyF12                -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyF12
            GLUT.SpecialKey SpecialKey
    GLUT.KeyLeft               -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyLeft
            GLUT.SpecialKey SpecialKey
    GLUT.KeyUp                 -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyUp
            GLUT.SpecialKey SpecialKey
    GLUT.KeyRight              -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyRight
            GLUT.SpecialKey SpecialKey
    GLUT.KeyDown               -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyDown
            GLUT.SpecialKey SpecialKey
    GLUT.KeyPageUp             -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyPageUp
            GLUT.SpecialKey SpecialKey
    GLUT.KeyPageDown           -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyPageDown
            GLUT.SpecialKey SpecialKey
    GLUT.KeyHome               -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyHome
            GLUT.SpecialKey SpecialKey
    GLUT.KeyEnd                -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyEnd
            GLUT.SpecialKey SpecialKey
    GLUT.KeyInsert             -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyInsert
            GLUT.SpecialKey SpecialKey
    GLUT.KeyNumLock            -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyNumLock
            GLUT.SpecialKey SpecialKey
    GLUT.KeyBegin              -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyBegin
            GLUT.SpecialKey SpecialKey
    GLUT.KeyDelete             -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyDelete
            GLUT.SpecialKey (GLUT.KeyUnknown Int
    _)        -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyUnknown
            GLUT.SpecialKey SpecialKey
    GLUT.KeyShiftL             -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyShiftL
            GLUT.SpecialKey SpecialKey
    GLUT.KeyShiftR             -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyShiftR
            GLUT.SpecialKey SpecialKey
    GLUT.KeyCtrlL              -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyCtrlL
            GLUT.SpecialKey SpecialKey
    GLUT.KeyCtrlR              -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyCtrlR
            GLUT.SpecialKey SpecialKey
    GLUT.KeyAltL               -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyAltL
            GLUT.SpecialKey SpecialKey
    GLUT.KeyAltR               -> SpecialKey -> Key
    SpecialKey SpecialKey
    KeyAltR
            GLUT.MouseButton MouseButton
    GLUT.LeftButton           -> MouseButton -> Key
    MouseButton MouseButton
    LeftButton
            GLUT.MouseButton MouseButton
    GLUT.MiddleButton         -> MouseButton -> Key
    MouseButton MouseButton
    MiddleButton
            GLUT.MouseButton MouseButton
    GLUT.RightButton          -> MouseButton -> Key
    MouseButton MouseButton
    RightButton
            GLUT.MouseButton MouseButton
    GLUT.WheelUp              -> MouseButton -> Key
    MouseButton MouseButton
    WheelUp
            GLUT.MouseButton MouseButton
    GLUT.WheelDown            -> MouseButton -> Key
    MouseButton MouseButton
    WheelDown
            GLUT.MouseButton (GLUT.AdditionalButton Int
    i) -> MouseButton -> Key
    MouseButton (Int -> MouseButton
    AdditionalButton Int
    i)

    -- | Convert GLUTs key states to our internal ones.
    glutKeyStateToKeyState :: GLUT.KeyState -> KeyState
    glutKeyStateToKeyState :: KeyState -> KeyState
    glutKeyStateToKeyState KeyState
    state
     = case KeyState
    state of
            KeyState
    GLUT.Down       -> KeyState
    Down
            KeyState
    GLUT.Up         -> KeyState
    Up

    -- | Convert GLUTs key states to our internal ones.
    glutModifiersToModifiers
            :: GLUT.Modifiers
            -> Modifiers

    glutModifiersToModifiers :: Modifiers -> Modifiers
    glutModifiersToModifiers (GLUT.Modifiers KeyState
    a KeyState
    b KeyState
    c)
            = KeyState -> KeyState -> KeyState -> Modifiers
    Modifiers     (KeyState -> KeyState
    glutKeyStateToKeyState KeyState
    a)
                            (KeyState -> KeyState
    glutKeyStateToKeyState KeyState
    b)
                            (KeyState -> KeyState
    glutKeyStateToKeyState KeyState
    c)