Added initContextCallback

Author: svenpanne

Graphics/UI/GLUT/Callbacks/Registration.hs

@@ -43,7 +43,7 @@ data CallbackType
    -- freeglut-only callback types
    | CloseCB           | MouseWheelCB      | PositionCB
    | MultiEntryCB      | MultiMotionCB     | MultiButtonCB
-   | MultiPassiveCB
+   | MultiPassiveCB    | InitContextCB
    deriving ( Eq, Ord )
 
 isGlobal :: CallbackType -> Bool

Graphics/UI/GLUT/Callbacks/Window.hs

@@ -27,6 +27,9 @@ module Graphics.UI.GLUT.Callbacks.Window (
    -- * Window close callback
    CloseCallback, closeCallback,
 
+   -- * Initialize context callback
+   InitContextCallback, initContextCallback,
+
    -- * Keyboard callback
    KeyboardCallback, keyboardCallback, keyboardUpCallback,
 
@@ -313,6 +316,19 @@ closeCallback = makeSettableStateVar $
 
 --------------------------------------------------------------------------------
 
+-- | An initialize context callback
+
+type InitContextCallback = IO ()
+
+-- | (/freeglut only/) Controls the initialize context callback for the /current
+-- window/.
+
+initContextCallback :: SettableStateVar (Maybe InitContextCallback)
+initContextCallback = makeSettableStateVar $
+   setCallback InitContextCB glutInitContextFunc makeInitContextFunc
+
+--------------------------------------------------------------------------------
+
 -- | A keyboard callback
 
 type KeyboardCallback = Char -> Position -> IO ()

Graphics/UI/GLUT/Raw/Callbacks.hs

@@ -21,6 +21,7 @@ module Graphics.UI.GLUT.Raw.Callbacks (
    DisplayFunc, makeDisplayFunc,
    EntryFunc, makeEntryFunc,
    IdleFunc, makeIdleFunc,
+   InitContextFunc, makeInitContextFunc,
    JoystickFunc, makeJoystickFunc,
    KeyboardFunc, makeKeyboardFunc,
    KeyboardUpFunc, makeKeyboardUpFunc,
@@ -85,6 +86,11 @@ type IdleFunc = IO ()
 foreign import ccall "wrapper"
    makeIdleFunc :: IdleFunc -> IO (FunPtr IdleFunc)
 
+type InitContextFunc = IO ()
+
+foreign import ccall "wrapper"
+   makeInitContextFunc :: InitContextFunc -> IO (FunPtr InitContextFunc)
+
 type JoystickFunc = CUInt -> CInt -> CInt -> CInt -> IO ()
 
 foreign import ccall "wrapper"

Graphics/UI/GLUT/Raw/Functions.hs

@@ -63,6 +63,7 @@ module Graphics.UI.GLUT.Raw.Functions (
    glutIgnoreKeyRepeat,
    glutInit,
    glutInitContextFlags,
+   glutInitContextFunc,
    glutInitContextProfile,
    glutInitContextVersion,
    glutInitDisplayMode,
@@ -229,6 +230,7 @@ API_ENTRY(glutIdleFunc,FunPtr IdleFunc -> IO ())
 API_ENTRY(glutIgnoreKeyRepeat,CInt -> IO ())
 API_ENTRY(glutInit,Ptr CInt -> Ptr (Ptr CChar) -> IO ())
 API_ENTRY(glutInitContextFlags,CInt -> IO ())
+API_ENTRY(glutInitContextFunc,FunPtr InitContextFunc -> IO ())
 API_ENTRY(glutInitContextProfile,CInt -> IO ())
 API_ENTRY(glutInitContextVersion,CInt -> CInt -> IO ())
 API_ENTRY(glutInitDisplayMode,CUInt -> IO ())