{-# 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
        a
backend
        Display
display
        Color
clearColor
        [Callback]
callbacks
        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
$ String
"* 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
$ String
"* 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
$ String
"* 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
$ String
"* all done\n"