    --------------------------------------------------------------------------------
    -- |
    -- 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
    $c== :: MenuUsage -> MenuUsage -> Bool
    == :: MenuUsage -> MenuUsage -> Bool
    $c/= :: MenuUsage -> MenuUsage -> Bool
    /= :: 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
    $ccompare :: MenuUsage -> MenuUsage -> Ordering
    compare :: MenuUsage -> MenuUsage -> Ordering
    $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
    >= :: MenuUsage -> MenuUsage -> Bool
    $cmax :: MenuUsage -> MenuUsage -> MenuUsage
    max :: MenuUsage -> MenuUsage -> MenuUsage
    $cmin :: MenuUsage -> MenuUsage -> MenuUsage
    min :: MenuUsage -> MenuUsage -> MenuUsage
    Ord, Timeout -> MenuUsage -> ShowS
    [MenuUsage] -> ShowS
    MenuUsage -> String
    (Timeout -> MenuUsage -> ShowS)
    -> (MenuUsage -> String)
    -> ([MenuUsage] -> ShowS)
    -> Show MenuUsage
    forall a.
    (Timeout -> a -> ShowS)
    -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Timeout -> MenuUsage -> ShowS
    showsPrec :: Timeout -> MenuUsage -> ShowS
    $cshow :: MenuUsage -> String
    show :: MenuUsage -> String
    $cshowList :: [MenuUsage] -> ShowS
    showList :: [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 :: Timeout -> IO () -> IO ()
    addTimerCallback Timeout
    msecs IO ()
    timerCallback = do
       funPtr <- (FunPtr TimerFunc -> IO (FunPtr TimerFunc))
    -> IO (FunPtr TimerFunc)
    forall a. (a -> IO a) -> IO a
    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))
       glutTimerFunc (fromIntegral msecs) funPtr 0