From ebc76d8f9580298d403b22576647eccb3d4a4a49 Mon Sep 17 00:00:00 2001
From: Sven Panne <svenpanne@gmail.com>
Date: Wed, 29 Jan 2014 11:07:56 +0100
Subject: [PATCH] Added appStatusCallback.

---
 Graphics/UI/GLUT/Callbacks/Registration.hs |  2 +-
 Graphics/UI/GLUT/Callbacks/Window.hs       | 32 +++++++++++++++++++++-
 Graphics/UI/GLUT/Raw/Callbacks.hs          |  6 ++++
 Graphics/UI/GLUT/Raw/Functions.hs          |  2 ++
 Graphics/UI/GLUT/Raw/Tokens.hs             |  6 ++++
 5 files changed, 46 insertions(+), 2 deletions(-)

diff --git a/Graphics/UI/GLUT/Callbacks/Registration.hs b/Graphics/UI/GLUT/Callbacks/Registration.hs
index 37cac2b..bc6d686 100644
--- 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
index 1772420..39c9705 100644
--- 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
index 9d51c6a..6c9bc44 100644
--- 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
index adec275..6f76bc2 100644
--- 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
index 5ed538a..b0fbaba 100644
--- 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