--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.GLUT.Callbacks.Global
-- Copyright   :  (c) Sven Panne 2002-2018
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
--------------------------------------------------------------------------------

module Graphics.UI.GLUT.Callbacks.Global (
   -- * Menu status callback
   MenuUsage(..), MenuStatusCallback, menuStatusCallback,

   -- * Idle callback
   IdleCallback, idleCallback,

   -- * Timer callbacks
   Timeout, TimerCallback, addTimerCallback
) where

import Control.Monad.Fix ( mfix )
import Data.StateVar ( SettableStateVar, makeSettableStateVar )
import Foreign.C.Types ( CInt )
import Graphics.Rendering.OpenGL ( Position(..) )

import Graphics.UI.GLUT.Callbacks.Registration
import Graphics.UI.GLUT.Raw

--------------------------------------------------------------------------------

data MenuUsage
   = NotInUse
   | InUse
   deriving ( MenuUsage -> MenuUsage -> Bool
(MenuUsage -> MenuUsage -> Bool)
-> (MenuUsage -> MenuUsage -> Bool) -> Eq MenuUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MenuUsage -> MenuUsage -> Bool
$c/= :: MenuUsage -> MenuUsage -> Bool
== :: MenuUsage -> MenuUsage -> Bool
$c== :: MenuUsage -> MenuUsage -> Bool
Eq, Eq MenuUsage
Eq MenuUsage
-> (MenuUsage -> MenuUsage -> Ordering)
-> (MenuUsage -> MenuUsage -> Bool)
-> (MenuUsage -> MenuUsage -> Bool)
-> (MenuUsage -> MenuUsage -> Bool)
-> (MenuUsage -> MenuUsage -> Bool)
-> (MenuUsage -> MenuUsage -> MenuUsage)
-> (MenuUsage -> MenuUsage -> MenuUsage)
-> Ord MenuUsage
MenuUsage -> MenuUsage -> Bool
MenuUsage -> MenuUsage -> Ordering
MenuUsage -> MenuUsage -> MenuUsage
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MenuUsage -> MenuUsage -> MenuUsage
$cmin :: MenuUsage -> MenuUsage -> MenuUsage
max :: MenuUsage -> MenuUsage -> MenuUsage
$cmax :: MenuUsage -> MenuUsage -> MenuUsage
>= :: MenuUsage -> MenuUsage -> Bool
$c>= :: MenuUsage -> MenuUsage -> Bool
> :: MenuUsage -> MenuUsage -> Bool
$c> :: MenuUsage -> MenuUsage -> Bool
<= :: MenuUsage -> MenuUsage -> Bool
$c<= :: MenuUsage -> MenuUsage -> Bool
< :: MenuUsage -> MenuUsage -> Bool
$c< :: MenuUsage -> MenuUsage -> Bool
compare :: MenuUsage -> MenuUsage -> Ordering
$ccompare :: MenuUsage -> MenuUsage -> Ordering
$cp1Ord :: Eq MenuUsage
Ord, Int -> MenuUsage -> ShowS
[MenuUsage] -> ShowS
MenuUsage -> String
(Int -> MenuUsage -> ShowS)
-> (MenuUsage -> String)
-> ([MenuUsage] -> ShowS)
-> Show MenuUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MenuUsage] -> ShowS
$cshowList :: [MenuUsage] -> ShowS
show :: MenuUsage -> String
$cshow :: MenuUsage -> String
showsPrec :: Int -> MenuUsage -> ShowS
$cshowsPrec :: Int -> MenuUsage -> ShowS
Show )

unmarshalMenuUsage :: CInt -> MenuUsage
unmarshalMenuUsage :: CInt -> MenuUsage
unmarshalMenuUsage CInt
x
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_MENU_NOT_IN_USE = MenuUsage
NotInUse
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_MENU_IN_USE = MenuUsage
InUse
   | Bool
otherwise = String -> MenuUsage
forall a. HasCallStack => String -> a
error (String
"unmarshalMenuUsage: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
x)

type MenuStatusCallback  = MenuUsage -> Position -> IO ()

-- | Controls the global menu status callback so a GLUT program can determine
-- when a menu is in use or not. When a menu status callback is registered, it
-- will be called with the value 'InUse' when pop-up menus are in use by the
-- user; and the callback will be called with the value 'NotInUse' when pop-up
-- menus are no longer in use. Additionally, the location in window coordinates
-- of the button press that caused the menu to go into use, or the location where
-- the menu was released (maybe outside the window). Other callbacks continue to
-- operate (except mouse motion callbacks) when pop-up menus are in use so the
-- menu status callback allows a program to suspend animation or other tasks
-- when menus are in use. The cascading and unmapping of sub-menus from an
-- initial pop-up menu does not generate menu status callbacks. There is a
-- single menu status callback for GLUT.
--
-- When the menu status callback is called, the /current menu/ will be set to
-- the initial pop-up menu in both the 'InUse' and 'NotInUse' cases. The
-- /current window/ will be set to the window from which the initial menu was
-- popped up from, also in both cases.

menuStatusCallback :: SettableStateVar (Maybe MenuStatusCallback)
menuStatusCallback :: SettableStateVar (Maybe MenuStatusCallback)
menuStatusCallback =
   (Maybe MenuStatusCallback -> IO ())
-> SettableStateVar (Maybe MenuStatusCallback)
forall a. (a -> IO ()) -> SettableStateVar a
makeSettableStateVar ((Maybe MenuStatusCallback -> IO ())
 -> SettableStateVar (Maybe MenuStatusCallback))
-> (Maybe MenuStatusCallback -> IO ())
-> SettableStateVar (Maybe MenuStatusCallback)
forall a b. (a -> b) -> a -> b
$
      CallbackType
-> (FunPtr MenuStatusFunc -> IO ())
-> (MenuStatusCallback -> IO (FunPtr MenuStatusFunc))
-> Maybe MenuStatusCallback
-> IO ()
forall a b.
CallbackType
-> (FunPtr a -> IO ()) -> (b -> IO (FunPtr a)) -> Maybe b -> IO ()
setCallback CallbackType
MenuStatusCB FunPtr MenuStatusFunc -> IO ()
forall (m :: * -> *). MonadIO m => FunPtr MenuStatusFunc -> m ()
glutMenuStatusFunc
                  (MenuStatusFunc -> IO (FunPtr MenuStatusFunc)
makeMenuStatusFunc (MenuStatusFunc -> IO (FunPtr MenuStatusFunc))
-> (MenuStatusCallback -> MenuStatusFunc)
-> MenuStatusCallback
-> IO (FunPtr MenuStatusFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MenuStatusCallback -> MenuStatusFunc
forall a a t.
(Integral a, Integral a) =>
(MenuUsage -> Position -> t) -> CInt -> a -> a -> t
unmarshal)
   where unmarshal :: (MenuUsage -> Position -> t) -> CInt -> a -> a -> t
unmarshal MenuUsage -> Position -> t
cb CInt
s a
x a
y =
            MenuUsage -> Position -> t
cb (CInt -> MenuUsage
unmarshalMenuUsage CInt
s)
               (GLint -> GLint -> Position
Position (a -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (a -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y))

--------------------------------------------------------------------------------

type IdleCallback = IO ()

-- | Controls the global idle callback so a GLUT program can perform background
-- processing tasks or continuous animation when window system events are not
-- being received. If enabled, the idle callback is continuously called when
-- events are not being received. The /current window/ and /current menu/ will
-- not be changed before the idle callback. Programs with multiple windows
-- and\/or menus should explicitly set the /current window/ and\/or /current
-- menu/ and not rely on its current setting.
--
-- The amount of computation and rendering done in an idle callback should be
-- minimized to avoid affecting the program\'s interactive response. In general,
-- not more than a single frame of rendering should be done in an idle callback.

idleCallback :: SettableStateVar (Maybe IdleCallback)
idleCallback :: SettableStateVar (Maybe (IO ()))
idleCallback =
   (Maybe (IO ()) -> IO ()) -> SettableStateVar (Maybe (IO ()))
forall a. (a -> IO ()) -> SettableStateVar a
makeSettableStateVar ((Maybe (IO ()) -> IO ()) -> SettableStateVar (Maybe (IO ())))
-> (Maybe (IO ()) -> IO ()) -> SettableStateVar (Maybe (IO ()))
forall a b. (a -> b) -> a -> b
$ CallbackType
-> (FunPtr (IO ()) -> IO ())
-> (IO () -> IO (FunPtr (IO ())))
-> Maybe (IO ())
-> IO ()
forall a b.
CallbackType
-> (FunPtr a -> IO ()) -> (b -> IO (FunPtr a)) -> Maybe b -> IO ()
setCallback CallbackType
IdleCB FunPtr (IO ()) -> IO ()
forall (m :: * -> *). MonadIO m => FunPtr (IO ()) -> m ()
glutIdleFunc IO () -> IO (FunPtr (IO ()))
makeIdleFunc

--------------------------------------------------------------------------------

-- | Timeout for the timer callback in milliseconds
type Timeout = Int

type TimerCallback  = IO ()

-- | Register a one-shot timer callback to be triggered after at least the given
-- amount of time. Multiple timer callbacks at same or differing times may be
-- registered simultaneously. There is no support for canceling a registered
-- callback.
--
-- The number of milliseconds is a lower bound on the time before the callback
-- is generated. GLUT attempts to deliver the timer callback as soon as possible
-- after the expiration of the callback\'s time interval.

addTimerCallback :: Timeout -> TimerCallback -> IO ()
addTimerCallback :: Int -> IO () -> IO ()
addTimerCallback Int
msecs IO ()
timerCallback = do
   FunPtr TimerFunc
funPtr <- (FunPtr TimerFunc -> IO (FunPtr TimerFunc))
-> IO (FunPtr TimerFunc)
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (\FunPtr TimerFunc
self -> TimerFunc -> IO (FunPtr TimerFunc)
makeTimerFunc (\CInt
_ -> do FunPtr TimerFunc -> IO ()
forall a. FunPtr a -> IO ()
registerForCleanup FunPtr TimerFunc
self
                                                    IO ()
timerCallback))
   CUInt -> FunPtr TimerFunc -> TimerFunc
forall (m :: * -> *).
MonadIO m =>
CUInt -> FunPtr TimerFunc -> CInt -> m ()
glutTimerFunc (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
msecs) FunPtr TimerFunc
funPtr CInt
0