Added appStatusCallback.

haskell-opengl · Jan 29, 2014 · ebc76d8 · ebc76d8
1 parent 63f95bc
commit ebc76d8
Show file tree

Hide file tree

Showing 5 changed files with 46 additions and 2 deletions.
diff --git a/Graphics/UI/GLUT/Callbacks/Registration.hs b/Graphics/UI/GLUT/Callbacks/Registration.hs
@@ -43,7 +43,7 @@ data CallbackType
    -- freeglut-only callback types
    | CloseCB           | MouseWheelCB      | PositionCB
    | MultiEntryCB      | MultiMotionCB     | MultiButtonCB
-   | MultiPassiveCB    | InitContextCB
+   | MultiPassiveCB    | InitContextCB     | AppStatusCB
    deriving ( Eq, Ord )
 
 isGlobal :: CallbackType -> Bool

diff --git a/Graphics/UI/GLUT/Callbacks/Window.hs b/Graphics/UI/GLUT/Callbacks/Window.hs
@@ -27,8 +27,9 @@ module Graphics.UI.GLUT.Callbacks.Window (
    -- * Window close callback
    CloseCallback, closeCallback,
 
-   -- * Initialize context callback
+   -- * Life cycle callbacks for mobile platforms
    InitContextCallback, initContextCallback,
+   AppStatus(..), AppStatusCallback, appStatusCallback,
 
    -- * Keyboard callback
    KeyboardCallback, keyboardCallback, keyboardUpCallback,
@@ -329,6 +330,35 @@ initContextCallback = makeSettableStateVar $
 
 --------------------------------------------------------------------------------
 
+-- | The application status of the /current window/
+
+data AppStatus
+   = AppStatusPause
+   | AppStatusResume
+   deriving ( Eq, Ord, Show )
+
+unmarshalAppStatus :: CInt -> AppStatus
+unmarshalAppStatus x
+   | x == glut_APPSTATUS_PAUSE = AppStatusPause
+   | x == glut_APPSTATUS_RESUME = AppStatusResume
+   | otherwise = error ("unmarshalAppStatus: illegal value " ++ show x)
+
+--------------------------------------------------------------------------------
+
+-- | An application status callback
+
+type AppStatusCallback = AppStatus -> IO ()
+
+-- | Controls the application status callback for the /current window./
+
+appStatusCallback :: SettableStateVar (Maybe AppStatusCallback)
+appStatusCallback = makeSettableStateVar $
+   setCallback AppStatusCB glutAppStatusFunc
+               (makeAppStatusFunc . unmarshal)
+   where unmarshal cb  = cb . unmarshalAppStatus
+
+--------------------------------------------------------------------------------
+
 -- | A keyboard callback
 
 type KeyboardCallback = Char -> Position -> IO ()

diff --git a/Graphics/UI/GLUT/Raw/Callbacks.hs b/Graphics/UI/GLUT/Raw/Callbacks.hs
@@ -15,6 +15,7 @@
 -----------------------------------------------------------------------------
 
 module Graphics.UI.GLUT.Raw.Callbacks (
+   AppStatusFunc, makeAppStatusFunc,
    ButtonBoxFunc, makeButtonBoxFunc,
    CloseFunc, makeCloseFunc,
    DialsFunc, makeDialsFunc,
@@ -56,6 +57,11 @@ module Graphics.UI.GLUT.Raw.Callbacks (
 import Foreign.C.Types
 import Foreign.Ptr
 
+type AppStatusFunc = CInt -> IO ()
+
+foreign import ccall "wrapper"
+   makeAppStatusFunc :: AppStatusFunc -> IO (FunPtr AppStatusFunc)
+
 type ButtonBoxFunc = CInt -> CInt -> IO ()
 
 foreign import ccall "wrapper"

diff --git a/Graphics/UI/GLUT/Raw/Functions.hs b/Graphics/UI/GLUT/Raw/Functions.hs
@@ -17,6 +17,7 @@
 module Graphics.UI.GLUT.Raw.Functions (
    glutAddMenuEntry,
    glutAddSubMenu,
+   glutAppStatusFunc,
    glutAttachMenu,
    glutBitmapCharacter,
    glutBitmapHeight,
@@ -184,6 +185,7 @@ import Graphics.UI.GLUT.Raw.Callbacks
 
 API_ENTRY(glutAddMenuEntry,Ptr CChar -> CInt -> IO ())
 API_ENTRY(glutAddSubMenu,Ptr CChar -> CInt -> IO ())
+API_ENTRY(glutAppStatusFunc,FunPtr AppStatusFunc -> IO ())
 API_ENTRY(glutAttachMenu,CInt -> IO ())
 API_ENTRY(glutBitmapCharacter,Ptr a -> CInt -> IO ())
 API_ENTRY(glutBitmapHeight,Ptr a -> IO CInt)

diff --git a/Graphics/UI/GLUT/Raw/Tokens.hs b/Graphics/UI/GLUT/Raw/Tokens.hs
@@ -48,6 +48,12 @@ glut_ALLOW_DIRECT_CONTEXT = 1
 glut_ALPHA :: CUInt
 glut_ALPHA = 0x0008
 
+glut_APPSTATUS_PAUSE :: CInt
+glut_APPSTATUS_PAUSE = 0x0001
+
+glut_APPSTATUS_RESUME :: CInt
+glut_APPSTATUS_RESUME = 0x0002
+
 glut_AUX :: GLenum
 glut_AUX = 0x1000