{-# OPTIONS_HADDOCK hide #-}
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
createWindow
:: Backend a
=> a
-> Display
-> Color
-> [Callback]
-> (IORef a -> IO ())
-> IO ()
createWindow :: a -> Display -> Color -> [Callback] -> (IORef a -> IO ()) -> IO ()
createWindow
a
backend
Display
display
Color
clearColor
[Callback]
callbacks
IORef a -> IO ()
eatBackend
= do
let debug :: Bool
debug = Bool
False
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"
IORef a -> Bool -> IO ()
forall a. Backend a => IORef a -> Bool -> IO ()
initializeBackend IORef a
backendStateRef Bool
debug
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"
IORef a -> Display -> IO ()
forall a. Backend a => IORef a -> Display -> IO ()
openWindow IORef a
backendStateRef Display
display
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
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
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
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"
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"