/usr/lib/hugs/packages/GLUT/Graphics/UI/GLUT/Callbacks/Global.hs is in libhugs-glut-bundled 98.200609.21-5.4build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 | --------------------------------------------------------------------------------
-- |
-- Module : Graphics.UI.GLUT.Callbacks.Global
-- Copyright : (c) Sven Panne 2002-2005
-- License : BSD-style (see the file libraries/GLUT/LICENSE)
--
-- Maintainer : sven.panne@aedion.de
-- 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 ( MonadFix(..) )
import Foreign.C.Types ( CInt, CUInt )
import Foreign.Ptr ( FunPtr )
import Graphics.Rendering.OpenGL.GL.CoordTrans ( Position(..) )
import Graphics.Rendering.OpenGL.GL.StateVar (
SettableStateVar, makeSettableStateVar )
import Graphics.UI.GLUT.Constants ( glut_MENU_NOT_IN_USE, glut_MENU_IN_USE )
import Graphics.UI.GLUT.Callbacks.Registration (
CallbackType(..), setCallback, registerForCleanup )
--------------------------------------------------------------------------------
data MenuUsage
= NotInUse
| InUse
deriving ( Eq, Ord, Show )
unmarshalMenuUsage :: CInt -> MenuUsage
unmarshalMenuUsage x
| x == glut_MENU_NOT_IN_USE = NotInUse
| x == glut_MENU_IN_USE = InUse
| otherwise = error ("unmarshalMenuUsage: illegal value " ++ show x)
type MenuStatusCallback = MenuUsage -> Position -> IO ()
type MenuStatusCallback' = CInt -> CInt -> CInt -> 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 =
makeSettableStateVar $
setCallback MenuStatusCB glutMenuStatusFunc
(makeMenuStatusCallback . unmarshal)
where unmarshal cb s x y =
cb (unmarshalMenuUsage s)
(Position (fromIntegral x) (fromIntegral y))
foreign import ccall "wrapper" makeMenuStatusCallback ::
MenuStatusCallback' -> IO (FunPtr MenuStatusCallback')
foreign import ccall unsafe "glutMenuStatusFunc" glutMenuStatusFunc ::
FunPtr MenuStatusCallback' -> IO ()
--------------------------------------------------------------------------------
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 =
makeSettableStateVar $ setCallback IdleCB glutIdleFunc makeIdleCallback
foreign import ccall "wrapper" makeIdleCallback ::
IdleCallback -> IO (FunPtr IdleCallback)
foreign import ccall unsafe "glutIdleFunc" glutIdleFunc ::
FunPtr IdleCallback -> IO ()
--------------------------------------------------------------------------------
-- | Timeout for the timer callback in milliseconds
type Timeout = Int
type TimerCallback = IO ()
type TimerCallback' = CInt -> 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 msecs timerCallback = do
funPtr <- mfix (\self -> makeTimerCallback (\_ -> do registerForCleanup self
timerCallback))
glutTimerFunc (fromIntegral msecs) funPtr 0
foreign import ccall "wrapper" makeTimerCallback ::
TimerCallback' -> IO (FunPtr TimerCallback')
foreign import ccall unsafe "glutTimerFunc" glutTimerFunc ::
CUInt -> FunPtr TimerCallback' -> CInt -> IO ()
|