--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.GLUT.Begin
-- Copyright   :  (c) Sven Panne 2002-2018
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- After a GLUT program has done initial setup such as creating windows and
-- menus, GLUT programs enter the GLUT event processing loop by calling
-- 'mainLoop' or handle events iteratively with 'mainLoopEvent'.
--
--------------------------------------------------------------------------------

module Graphics.UI.GLUT.Begin (
   -- * Handling events
   mainLoop, mainLoopEvent, leaveMainLoop,

   -- * Controlling the behaviour when windows are closed
   ActionOnWindowClose(..), actionOnWindowClose
) where

import Control.Monad.IO.Class ( MonadIO(..) )
import Data.StateVar ( StateVar, makeStateVar )
import Foreign.C.Types ( CInt )

import Graphics.UI.GLUT.QueryUtils
import Graphics.UI.GLUT.Raw

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

-- | Enter the GLUT event processing loop; it will call as necessary any
-- callbacks that have been registered. This routine should be called at most
-- once in a GLUT program.

mainLoop :: MonadIO m => m ()
mainLoop :: m ()
mainLoop = m ()
forall (m :: * -> *). MonadIO m => m ()
glutMainLoop

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

-- | (/freeglut only/) Process one iteration's worth of events in its event loop.
-- This allows the application to control its own event loop and still use the
-- GLUT package.

mainLoopEvent :: MonadIO m => m ()
mainLoopEvent :: m ()
mainLoopEvent = m ()
forall (m :: * -> *). MonadIO m => m ()
glutMainLoopEvent

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

-- | (/freeglut only/) Stop the event loop. If 'actionOnWindowClose' contains
-- 'Exit', the application will exit; otherwise control will return to the
-- function which called 'mainLoop'.
--
-- If the application has two nested calls to 'mainLoop' and calls
-- 'leaveMainLoop', the behaviour is undefined. It may leave only the inner
-- nested loop or it may leave both loops. If the reader has a strong preference
-- for one behaviour over the other he should contact the freeglut Programming
-- Consortium and ask for the code to be fixed.

leaveMainLoop :: MonadIO m => m ()
leaveMainLoop :: m ()
leaveMainLoop = m ()
forall (m :: * -> *). MonadIO m => m ()
glutLeaveMainLoop

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

-- | The behaviour when the user closes a window.

data ActionOnWindowClose
   = -- | Exit the whole program when any window is closed or 'leaveMainLoop'
     -- is called (default).
     Exit
   | -- | Return from mainLoop when any window is closed.
     MainLoopReturns
   | -- | Return from mainLoop after the last window is closed.
     ContinueExecution
   deriving ( ActionOnWindowClose -> ActionOnWindowClose -> Bool
(ActionOnWindowClose -> ActionOnWindowClose -> Bool)
-> (ActionOnWindowClose -> ActionOnWindowClose -> Bool)
-> Eq ActionOnWindowClose
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionOnWindowClose -> ActionOnWindowClose -> Bool
$c/= :: ActionOnWindowClose -> ActionOnWindowClose -> Bool
== :: ActionOnWindowClose -> ActionOnWindowClose -> Bool
$c== :: ActionOnWindowClose -> ActionOnWindowClose -> Bool
Eq, Eq ActionOnWindowClose
Eq ActionOnWindowClose
-> (ActionOnWindowClose -> ActionOnWindowClose -> Ordering)
-> (ActionOnWindowClose -> ActionOnWindowClose -> Bool)
-> (ActionOnWindowClose -> ActionOnWindowClose -> Bool)
-> (ActionOnWindowClose -> ActionOnWindowClose -> Bool)
-> (ActionOnWindowClose -> ActionOnWindowClose -> Bool)
-> (ActionOnWindowClose
    -> ActionOnWindowClose -> ActionOnWindowClose)
-> (ActionOnWindowClose
    -> ActionOnWindowClose -> ActionOnWindowClose)
-> Ord ActionOnWindowClose
ActionOnWindowClose -> ActionOnWindowClose -> Bool
ActionOnWindowClose -> ActionOnWindowClose -> Ordering
ActionOnWindowClose -> ActionOnWindowClose -> ActionOnWindowClose
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 :: ActionOnWindowClose -> ActionOnWindowClose -> ActionOnWindowClose
$cmin :: ActionOnWindowClose -> ActionOnWindowClose -> ActionOnWindowClose
max :: ActionOnWindowClose -> ActionOnWindowClose -> ActionOnWindowClose
$cmax :: ActionOnWindowClose -> ActionOnWindowClose -> ActionOnWindowClose
>= :: ActionOnWindowClose -> ActionOnWindowClose -> Bool
$c>= :: ActionOnWindowClose -> ActionOnWindowClose -> Bool
> :: ActionOnWindowClose -> ActionOnWindowClose -> Bool
$c> :: ActionOnWindowClose -> ActionOnWindowClose -> Bool
<= :: ActionOnWindowClose -> ActionOnWindowClose -> Bool
$c<= :: ActionOnWindowClose -> ActionOnWindowClose -> Bool
< :: ActionOnWindowClose -> ActionOnWindowClose -> Bool
$c< :: ActionOnWindowClose -> ActionOnWindowClose -> Bool
compare :: ActionOnWindowClose -> ActionOnWindowClose -> Ordering
$ccompare :: ActionOnWindowClose -> ActionOnWindowClose -> Ordering
$cp1Ord :: Eq ActionOnWindowClose
Ord, Int -> ActionOnWindowClose -> ShowS
[ActionOnWindowClose] -> ShowS
ActionOnWindowClose -> String
(Int -> ActionOnWindowClose -> ShowS)
-> (ActionOnWindowClose -> String)
-> ([ActionOnWindowClose] -> ShowS)
-> Show ActionOnWindowClose
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionOnWindowClose] -> ShowS
$cshowList :: [ActionOnWindowClose] -> ShowS
show :: ActionOnWindowClose -> String
$cshow :: ActionOnWindowClose -> String
showsPrec :: Int -> ActionOnWindowClose -> ShowS
$cshowsPrec :: Int -> ActionOnWindowClose -> ShowS
Show )

marshalActionOnWindowClose :: ActionOnWindowClose -> CInt
marshalActionOnWindowClose :: ActionOnWindowClose -> CInt
marshalActionOnWindowClose ActionOnWindowClose
x = case ActionOnWindowClose
x of
   ActionOnWindowClose
Exit ->  CInt
glut_ACTION_EXIT
   ActionOnWindowClose
MainLoopReturns -> CInt
glut_ACTION_GLUTMAINLOOP_RETURNS
   ActionOnWindowClose
ContinueExecution -> CInt
glut_ACTION_CONTINUE_EXECUTION

unmarshalActionOnWindowClose :: CInt -> ActionOnWindowClose
unmarshalActionOnWindowClose :: CInt -> ActionOnWindowClose
unmarshalActionOnWindowClose CInt
x
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_ACTION_EXIT = ActionOnWindowClose
Exit
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_ACTION_GLUTMAINLOOP_RETURNS = ActionOnWindowClose
MainLoopReturns
   | CInt
x CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
glut_ACTION_CONTINUE_EXECUTION = ActionOnWindowClose
ContinueExecution
   | Bool
otherwise = String -> ActionOnWindowClose
forall a. HasCallStack => String -> a
error (String
"unmarshalActionOnWindowClose: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
x)

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

-- | (/freeglut only/) Controls the behaviour when the user closes a window.

actionOnWindowClose :: StateVar ActionOnWindowClose
actionOnWindowClose :: StateVar ActionOnWindowClose
actionOnWindowClose =
   IO ActionOnWindowClose
-> (ActionOnWindowClose -> IO ()) -> StateVar ActionOnWindowClose
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (Getter ActionOnWindowClose
forall a. Getter a
simpleGet CInt -> ActionOnWindowClose
unmarshalActionOnWindowClose GLenum
glut_ACTION_ON_WINDOW_CLOSE)
      (GLenum -> CInt -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> CInt -> m ()
glutSetOption GLenum
glut_ACTION_ON_WINDOW_CLOSE (CInt -> IO ())
-> (ActionOnWindowClose -> CInt) -> ActionOnWindowClose -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionOnWindowClose -> CInt
marshalActionOnWindowClose)