    {-# OPTIONS_HADDOCK hide #-}

    -- |    The main display function.
    module  Graphics.Gloss.Internals.Interface.Window
            ( createWindow )
    where
    import Graphics.Gloss.Data.Color
    import Graphics.Gloss.Internals.Color
    import Graphics.Gloss.Internals.Interface.Backend
    import Graphics.Gloss.Internals.Interface.Debug
    import Graphics.Rendering.OpenGL                        (($=))
    import qualified Graphics.Rendering.OpenGL.GL           as GL
    import Data.IORef (IORef, newIORef)
    import Control.Monad

    -- | Open a window and use the supplied callbacks to handle window events.
    createWindow
            :: Backend a
            => a
            -> Display
            -> Color                -- ^ Color to use when clearing.
            -> [Callback]           -- ^ Callbacks to use.
            -> (IORef a -> IO ())   -- ^ Give the backend back to the caller before
                                    --   entering the main loop.
            -> IO ()

    createWindow :: a -> Display -> Color -> [Callback] -> (IORef a -> IO ()) -> IO ()
    createWindow
            backend :: a
    backend
            display :: Display
    display
            clearColor :: Color
    clearColor
            callbacks :: [Callback]
    callbacks
            eatBackend :: IORef a -> IO ()
    eatBackend
     = do
            -- Turn this on to spew debugging info to stdout
            let debug :: Bool
    debug       = Bool
    False

            -- Initialize backend state
            IORef a
    backendStateRef <- a -> IO (IORef a)
    forall a. a -> IO (IORef a)
    newIORef a
    backend

            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    debug
             (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do   String -> IO ()
    putStr  (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "* displayInWindow\n"

            -- Intialize backend
            IORef a -> Bool -> IO ()
    forall a. Backend a => IORef a -> Bool -> IO ()
    initializeBackend IORef a
    backendStateRef Bool
    debug

            -- Here we go!
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    debug
             (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do   String -> IO ()
    putStr  (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "* c window\n\n"

            -- Open window
            IORef a -> Display -> IO ()
    forall a. Backend a => IORef a -> Display -> IO ()
    openWindow IORef a
    backendStateRef Display
    display

            -- Setup callbacks
            IORef a -> [Callback] -> IO ()
    forall a. Backend a => IORef a -> [Callback] -> IO ()
    installDisplayCallback     IORef a
    backendStateRef [Callback]
    callbacks
            IORef a -> IO ()
    forall a. Backend a => IORef a -> IO ()
    installWindowCloseCallback IORef a
    backendStateRef
            IORef a -> [Callback] -> IO ()
    forall a. Backend a => IORef a -> [Callback] -> IO ()
    installReshapeCallback     IORef a
    backendStateRef [Callback]
    callbacks
            IORef a -> [Callback] -> IO ()
    forall a. Backend a => IORef a -> [Callback] -> IO ()
    installKeyMouseCallback    IORef a
    backendStateRef [Callback]
    callbacks
            IORef a -> [Callback] -> IO ()
    forall a. Backend a => IORef a -> [Callback] -> IO ()
    installMotionCallback      IORef a
    backendStateRef [Callback]
    callbacks
            IORef a -> [Callback] -> IO ()
    forall a. Backend a => IORef a -> [Callback] -> IO ()
    installIdleCallback        IORef a
    backendStateRef [Callback]
    callbacks

            -- we don't need the depth buffer for 2d.
            StateVar (Maybe ComparisonFunction)
    GL.depthFunc    StateVar (Maybe ComparisonFunction)
    -> Maybe ComparisonFunction -> IO ()
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    $= ComparisonFunction -> Maybe ComparisonFunction
    forall a. a -> Maybe a
    Just ComparisonFunction
    GL.Always

            -- always clear the buffer to white
            StateVar (Color4 GLfloat)
    GL.clearColor   StateVar (Color4 GLfloat) -> Color4 GLfloat -> IO ()
    forall t a (m :: * -> *).
    (HasSetter t a, MonadIO m) =>
    t -> a -> m ()
    $= Color -> Color4 GLfloat
    forall a. Color -> Color4 a
    glColor4OfColor Color
    clearColor

            -- Dump some debugging info
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    debug
             (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do   IORef a -> IO ()
    forall a. Backend a => IORef a -> IO ()
    dumpBackendState IORef a
    backendStateRef
                    IO ()
    dumpFramebufferState
                    IO ()
    dumpFragmentState

            IORef a -> IO ()
    eatBackend IORef a
    backendStateRef

            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    debug
             (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do   String -> IO ()
    putStr  (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "* entering mainloop..\n"

            -- Start the main backend loop
            IORef a -> IO ()
    forall a. Backend a => IORef a -> IO ()
    runMainLoop IORef a
    backendStateRef

            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    debug
             (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $      String -> IO ()
    putStr  (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "* all done\n"