File: Overlay.hs

package info (click to toggle)
haskell-glut 2.1.2.1-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 1,936 kB
  • ctags: 25
  • sloc: haskell: 10,092; sh: 2,811; ansic: 53; makefile: 2
file content (191 lines) | stat: -rw-r--r-- 7,851 bytes parent folder | download | duplicates (3)
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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.GLUT.Overlay
-- Copyright   :  (c) Sven Panne 2002-2005
-- License     :  BSD-style (see the file libraries/GLUT/LICENSE)
--
-- Maintainer  :  sven.panne@aedion.de
-- Stability   :  stable
-- Portability :  portable
--
-- When  overlay hardware is available, GLUT provides a set of routines for
-- establishing, using, and removing an overlay for GLUT windows. When an
-- overlay is established, a separate OpenGL context is also established. A
-- window\'s overlay OpenGL state is kept distinct from the normal planes\'
-- OpenGL state.
--
--------------------------------------------------------------------------------

module Graphics.UI.GLUT.Overlay (
   -- * Overlay creation and destruction
   hasOverlay, overlayPossible,

   -- * Showing and hiding an overlay
   overlayVisible,

   -- * Changing the /layer in use/
   Layer(..), layerInUse,

   -- * Re-displaying
   postOverlayRedisplay
) where

import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum )
import Graphics.Rendering.OpenGL.GL.StateVar (
   GettableStateVar, makeGettableStateVar,
   SettableStateVar, makeSettableStateVar,
   StateVar, makeStateVar )
import Graphics.UI.GLUT.Constants (
   glut_OVERLAY_POSSIBLE, glut_HAS_OVERLAY, glut_NORMAL, glut_OVERLAY,
   glut_LAYER_IN_USE )
import Graphics.UI.GLUT.QueryUtils ( layerGet )
#ifdef __NHC__
import NHC.FFI ( CInt )
#endif
import Graphics.UI.GLUT.Window ( Window )

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

-- | Controls the overlay for the /current window/. The requested display mode
-- for the overlay is determined by the /initial display mode/.
-- 'overlayPossible' can be used to determine if an overlay is possible for the
-- /current window/ with the current /initial display mode/. Do not attempt to
-- establish an overlay when one is not possible; GLUT will terminate the
-- program.
--
-- When 'hasOverlay' is set to 'True' when an overlay already exists, the
-- existing overlay is first removed, and then a new overlay is established. The
-- state of the old overlay\'s OpenGL context is discarded. Implicitly, the
-- window\'s /layer in use/ changes to the overlay immediately after the overlay
-- is established.
--
-- The initial display state of an overlay is shown, however the overlay is only
-- actually shown if the overlay\'s window is shown.
--
-- Setting 'hasOverlay' to 'False' is safe even if no overlay is currently
-- established, nothing happens in this case. Implicitly, the window\'s /layer
-- in use/ changes to the normal plane immediately once the overlay is removed.
--
-- If the program intends to re-establish the overlay later, it is typically
-- faster and less resource intensive to use 'overlayVisible' to simply change
-- the display status of the overlay.
--
-- /X Implementation Notes:/ GLUT for X uses the @SERVER_OVERLAY_VISUALS@
-- convention to determine if overlay visuals are available. While the
-- convention allows for opaque overlays (no transparency) and overlays with the
-- transparency specified as a bitmask, GLUT overlay management only provides
-- access to transparent pixel overlays.
--
-- Until RGBA overlays are better understood, GLUT only supports color index
-- overlays.

hasOverlay :: StateVar Bool
hasOverlay = makeStateVar getHasOverlay setHasOverlay

setHasOverlay :: Bool -> IO ()
setHasOverlay False = glutRemoveOverlay
setHasOverlay True  = glutEstablishOverlay

foreign import CALLCONV safe "glutRemoveOverlay" glutRemoveOverlay :: IO ()

foreign import CALLCONV safe "glutEstablishOverlay" glutEstablishOverlay :: IO ()

getHasOverlay :: IO Bool
getHasOverlay = layerGet (/= 0) glut_HAS_OVERLAY

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

-- | Contains 'True' if an overlay could be established for the /current window/
-- given the current /initial display mode/. If it contains 'False',
-- 'setHasOverlay' will fail with a fatal error if called.

overlayPossible :: GettableStateVar Bool
overlayPossible = makeGettableStateVar $ layerGet (/= 0) glut_OVERLAY_POSSIBLE

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

-- | Controls the visibility of the overlay of the /current window/.
--
-- The effect of showing or hiding an overlay takes place immediately. Note that
-- setting 'overlayVisible' to 'True' will not actually display the overlay
-- unless the window is also shown (and even a shown window may be obscured by
-- other windows, thereby obscuring the overlay). It is typically faster and
-- less resource intensive to use the routines below to control the display
-- status of an overlay as opposed to removing and re-establishing the overlay.

overlayVisible :: SettableStateVar Bool
overlayVisible =
   makeSettableStateVar $ \flag ->
      if flag then glutShowOverlay else glutHideOverlay

foreign import CALLCONV safe "glutShowOverlay" glutShowOverlay :: IO ()

foreign import CALLCONV safe "glutHideOverlay" glutHideOverlay :: IO ()

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

-- | The /layer in use/.
data Layer
   = Normal   -- ^ The normal plane.
   | Overlay  -- ^ The overlay.
   deriving ( Eq, Ord, Show )

marshalLayer :: Layer -> GLenum
marshalLayer x = case x of
   Normal -> glut_NORMAL
   Overlay -> glut_OVERLAY

unmarshalLayer :: GLenum -> Layer
unmarshalLayer x
   | x == glut_NORMAL  = Normal
   | x == glut_OVERLAY = Overlay
   | otherwise = error ("unmarshalLayer: illegal value " ++ show x)

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

-- | Controls the per-window /layer in use/ for the /current window/, which can
-- either be the normal plane or the overlay. Selecting the overlay should only
-- be done if an overlay exists, however windows without an overlay may still
-- set the /layer in use/ to 'Normal'. OpenGL commands for the window are
-- directed to the current /layer in use/.

layerInUse :: StateVar Layer
layerInUse =
   makeStateVar getLayerInUse setLayerInUse

setLayerInUse :: Layer -> IO ()
setLayerInUse = glutUseLayer . marshalLayer

foreign import CALLCONV safe "glutUseLayer" glutUseLayer :: GLenum -> IO ()

getLayerInUse :: IO Layer
getLayerInUse = layerGet (unmarshalLayer . fromIntegral) glut_LAYER_IN_USE

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

-- | Mark the overlay of the given window (or the /current window/, if none is
-- supplied) as needing to be redisplayed. The next iteration through
-- 'Graphics.UI.GLUT.Begin.mainLoop', the window\'s overlay display callback
-- (or simply the display callback if no overlay display callback is registered)
-- will be called to redisplay the window\'s overlay plane. Multiple calls to
-- 'postOverlayRedisplay' before the next display callback opportunity (or
-- overlay display callback opportunity if one is registered) generate only a
-- single redisplay. 'postOverlayRedisplay' may be called within a window\'s
-- display or overlay display callback to re-mark that window for redisplay.
--
-- Logically, overlay damage notification for a window is treated as a
-- 'postOverlayRedisplay' on the damaged window. Unlike damage reported by the
-- window system, 'postOverlayRedisplay' will not set to true the overlay\'s
-- damaged status (see 'Graphics.UI.GLUT.State.damaged').
--
-- Also, see 'Graphics.UI.GLUT.Window.postRedisplay'.

postOverlayRedisplay :: Maybe Window -> IO ()
postOverlayRedisplay =
   maybe glutPostOverlayRedisplay glutPostWindowOverlayRedisplay

foreign import CALLCONV safe "glutPostOverlayRedisplay"
   glutPostOverlayRedisplay :: IO ()

foreign import CALLCONV safe "glutPostWindowOverlayRedisplay"
   glutPostWindowOverlayRedisplay :: Window -> IO ()