--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.GLUT.Overlay
-- Copyright   :  (c) Sven Panne 2002-2018
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- 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 Control.Monad.IO.Class ( MonadIO(..) )
import Data.StateVar ( GettableStateVar, makeGettableStateVar
                     , SettableStateVar, makeSettableStateVar
                     , StateVar, makeStateVar )
import Graphics.Rendering.OpenGL ( GLenum )

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

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

-- | 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 :: StateVar Bool
hasOverlay = IO Bool -> (Bool -> IO ()) -> StateVar Bool
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO Bool
getHasOverlay Bool -> IO ()
setHasOverlay

setHasOverlay :: Bool -> IO ()
setHasOverlay :: Bool -> IO ()
setHasOverlay Bool
False = IO ()
forall (m :: * -> *). MonadIO m => m ()
glutRemoveOverlay
setHasOverlay Bool
True  = IO ()
forall (m :: * -> *). MonadIO m => m ()
glutEstablishOverlay

getHasOverlay :: IO Bool
getHasOverlay :: IO Bool
getHasOverlay = Getter Bool
forall a. Getter a
layerGet (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) GLenum
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', setting
-- 'hasOverlay' will fail with a fatal error.

overlayPossible :: GettableStateVar Bool
overlayPossible :: IO Bool
overlayPossible = IO Bool -> IO Bool
forall a. IO a -> IO a
makeGettableStateVar (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Getter Bool
forall a. Getter a
layerGet (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) GLenum
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 :: SettableStateVar Bool
overlayVisible =
   (Bool -> IO ()) -> SettableStateVar Bool
forall a. (a -> IO ()) -> SettableStateVar a
makeSettableStateVar ((Bool -> IO ()) -> SettableStateVar Bool)
-> (Bool -> IO ()) -> SettableStateVar Bool
forall a b. (a -> b) -> a -> b
$ \Bool
flag ->
      if Bool
flag then IO ()
forall (m :: * -> *). MonadIO m => m ()
glutShowOverlay else IO ()
forall (m :: * -> *). MonadIO m => m ()
glutHideOverlay

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

-- | The /layer in use/.
data Layer
   = Normal   -- ^ The normal plane.
   | Overlay  -- ^ The overlay.
   deriving ( Layer -> Layer -> Bool
(Layer -> Layer -> Bool) -> (Layer -> Layer -> Bool) -> Eq Layer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Layer -> Layer -> Bool
$c/= :: Layer -> Layer -> Bool
== :: Layer -> Layer -> Bool
$c== :: Layer -> Layer -> Bool
Eq, Eq Layer
Eq Layer
-> (Layer -> Layer -> Ordering)
-> (Layer -> Layer -> Bool)
-> (Layer -> Layer -> Bool)
-> (Layer -> Layer -> Bool)
-> (Layer -> Layer -> Bool)
-> (Layer -> Layer -> Layer)
-> (Layer -> Layer -> Layer)
-> Ord Layer
Layer -> Layer -> Bool
Layer -> Layer -> Ordering
Layer -> Layer -> Layer
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 :: Layer -> Layer -> Layer
$cmin :: Layer -> Layer -> Layer
max :: Layer -> Layer -> Layer
$cmax :: Layer -> Layer -> Layer
>= :: Layer -> Layer -> Bool
$c>= :: Layer -> Layer -> Bool
> :: Layer -> Layer -> Bool
$c> :: Layer -> Layer -> Bool
<= :: Layer -> Layer -> Bool
$c<= :: Layer -> Layer -> Bool
< :: Layer -> Layer -> Bool
$c< :: Layer -> Layer -> Bool
compare :: Layer -> Layer -> Ordering
$ccompare :: Layer -> Layer -> Ordering
$cp1Ord :: Eq Layer
Ord, Int -> Layer -> ShowS
[Layer] -> ShowS
Layer -> String
(Int -> Layer -> ShowS)
-> (Layer -> String) -> ([Layer] -> ShowS) -> Show Layer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Layer] -> ShowS
$cshowList :: [Layer] -> ShowS
show :: Layer -> String
$cshow :: Layer -> String
showsPrec :: Int -> Layer -> ShowS
$cshowsPrec :: Int -> Layer -> ShowS
Show )

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

unmarshalLayer :: GLenum -> Layer
unmarshalLayer :: GLenum -> Layer
unmarshalLayer GLenum
x
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
glut_NORMAL  = Layer
Normal
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
glut_OVERLAY = Layer
Overlay
   | Bool
otherwise = String -> Layer
forall a. HasCallStack => String -> a
error (String
"unmarshalLayer: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GLenum -> String
forall a. Show a => a -> String
show GLenum
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 :: StateVar Layer
layerInUse =
   IO Layer -> (Layer -> IO ()) -> StateVar Layer
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO Layer
getLayerInUse Layer -> IO ()
setLayerInUse

setLayerInUse :: Layer -> IO ()
setLayerInUse :: Layer -> IO ()
setLayerInUse = GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glutUseLayer (GLenum -> IO ()) -> (Layer -> GLenum) -> Layer -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layer -> GLenum
marshalLayer

getLayerInUse :: IO Layer
getLayerInUse :: IO Layer
getLayerInUse = Getter Layer
forall a. Getter a
layerGet (GLenum -> Layer
unmarshalLayer (GLenum -> Layer) -> (CInt -> GLenum) -> CInt -> Layer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral) GLenum
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 :: MonadIO m => Maybe Window -> m ()
postOverlayRedisplay :: Maybe Window -> m ()
postOverlayRedisplay =
   m () -> (Window -> m ()) -> Maybe Window -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m ()
forall (m :: * -> *). MonadIO m => m ()
glutPostOverlayRedisplay (\(Window CInt
win) -> CInt -> m ()
forall (m :: * -> *). MonadIO m => CInt -> m ()
glutPostWindowOverlayRedisplay CInt
win)