--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.GLUT.Colormap
-- Copyright   :  (c) Sven Panne 2002-2018
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- OpenGL supports both RGBA and color index rendering. The RGBA mode is
-- generally preferable to color index because more OpenGL rendering
-- capabilities are available and color index mode requires the loading of
-- colormap entries.
--
-- The GLUT color index state variables are used to read and write entries in a
-- window\'s color index colormap. Every GLUT color index window has its own
-- logical color index colormap. The size of a window\'s colormap can be
-- determined by reading 'numColorMapEntries'.
--
-- GLUT color index windows within a program can attempt to share colormap
-- resources by copying a single color index colormap to multiple windows using
-- 'copyColormap'. If possible GLUT will attempt to share the actual colormap.
-- While copying colormaps using 'copyColormap' can potentially allow sharing of
-- physical colormap resources, logically each window has its own colormap. So
-- changing a copied colormap of a window will force the duplication of the
-- colormap. For this reason, color index programs should generally load a
-- single color index colormap, copy it to all color index windows within the
-- program, and then not modify any colormap cells.
--
-- Use of multiple colormaps is likely to result in colormap installation
-- problems where some windows are displayed with an incorrect colormap due to
-- limitations on colormap resources.
--
--------------------------------------------------------------------------------

module Graphics.UI.GLUT.Colormap (
   colorMapEntry,
   copyColormap,
   numColorMapEntries,
   transparentIndex
) where

import Control.Monad.IO.Class ( MonadIO(..) )
import Data.StateVar ( GettableStateVar, makeGettableStateVar, StateVar, makeStateVar )
import Foreign.C.Types ( CInt )
import Graphics.Rendering.OpenGL.GL.VertexSpec ( Index1(..), Color3(..) )
import Graphics.Rendering.OpenGL ( GLint, GLfloat )

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

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

-- | Controls the color index colormap entry of the /current window/\'s logical
-- colormap for the /layer in use/. The /layer in use/ of the /current window/
-- should be a color index window. The color index should be zero or greater and
-- less than the total number of colormap entries for the window (see
-- 'numColorMapEntries') and different from an overlay\'s transparent index (see
-- 'transparentIndex').
--
-- If the /layer in use/\'s colormap was copied by reference, setting a colormap
-- entry will force the duplication of the colormap.

colorMapEntry :: Index1 GLint -> StateVar (Color3 GLfloat)
colorMapEntry :: Index1 GLint -> StateVar (Color3 GLfloat)
colorMapEntry (Index1 GLint
cell) =
   IO (Color3 GLfloat)
-> (Color3 GLfloat -> IO ()) -> StateVar (Color3 GLfloat)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar (CInt -> IO (Color3 GLfloat)
getColorMapEntry (GLint -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
cell))
                (CInt -> Color3 GLfloat -> IO ()
setColorMapEntry (GLint -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
cell))

setColorMapEntry :: CInt -> Color3 GLfloat -> IO ()
setColorMapEntry :: CInt -> Color3 GLfloat -> IO ()
setColorMapEntry CInt
cell (Color3 GLfloat
r GLfloat
g GLfloat
b) = CInt -> GLfloat -> GLfloat -> GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
CInt -> GLfloat -> GLfloat -> GLfloat -> m ()
glutSetColor CInt
cell GLfloat
r GLfloat
g GLfloat
b

getColorMapEntry :: CInt -> IO (Color3 GLfloat)
getColorMapEntry :: CInt -> IO (Color3 GLfloat)
getColorMapEntry CInt
cell = do
   GLfloat
r <- CInt -> CInt -> IO GLfloat
forall (m :: * -> *). MonadIO m => CInt -> CInt -> m GLfloat
glutGetColor CInt
cell CInt
glut_RED
   GLfloat
g <- CInt -> CInt -> IO GLfloat
forall (m :: * -> *). MonadIO m => CInt -> CInt -> m GLfloat
glutGetColor CInt
cell CInt
glut_GREEN
   GLfloat
b <- CInt -> CInt -> IO GLfloat
forall (m :: * -> *). MonadIO m => CInt -> CInt -> m GLfloat
glutGetColor CInt
cell CInt
glut_BLUE
   Color3 GLfloat -> IO (Color3 GLfloat)
forall (m :: * -> *) a. Monad m => a -> m a
return (Color3 GLfloat -> IO (Color3 GLfloat))
-> Color3 GLfloat -> IO (Color3 GLfloat)
forall a b. (a -> b) -> a -> b
$ GLfloat -> GLfloat -> GLfloat -> Color3 GLfloat
forall a. a -> a -> a -> Color3 a
Color3 GLfloat
r GLfloat
g GLfloat
b

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

-- | Copy (lazily if possible to promote sharing) the logical colormap from a
-- specified window to the /current window/\'s /layer in use/. The copy will be
-- from the normal plane to the normal plane; or from the overlay to the overlay
-- (never across different layers). Once a colormap has been copied, avoid
-- setting cells in the colormap via 'colorMapEntry' since that will force an
-- actual copy of the colormap if it was previously copied by reference.
-- 'copyColormap' should only be called when both the /current window/ and the
-- specified window are color index windows.

copyColormap :: MonadIO m => Window -> m ()
copyColormap :: Window -> m ()
copyColormap (Window CInt
win) = CInt -> m ()
forall (m :: * -> *). MonadIO m => CInt -> m ()
glutCopyColormap CInt
win

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

-- | Contains the number of entries in the colormap of the /current window/\'s
-- current layer (0 in RGBA mode).

numColorMapEntries :: GettableStateVar GLint
numColorMapEntries :: GettableStateVar GLint
numColorMapEntries =
   GettableStateVar GLint -> GettableStateVar GLint
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar GLint -> GettableStateVar GLint)
-> GettableStateVar GLint -> GettableStateVar GLint
forall a b. (a -> b) -> a -> b
$ Getter GLint
forall a. Getter a
simpleGet CInt -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
glut_WINDOW_COLORMAP_SIZE

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

-- | Contains the transparent color index of the overlay of the /current window/
-- or -1 if no overlay is in use.

transparentIndex :: GettableStateVar (Index1 GLint)
transparentIndex :: GettableStateVar (Index1 GLint)
transparentIndex =
   GettableStateVar (Index1 GLint) -> GettableStateVar (Index1 GLint)
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar (Index1 GLint)
 -> GettableStateVar (Index1 GLint))
-> GettableStateVar (Index1 GLint)
-> GettableStateVar (Index1 GLint)
forall a b. (a -> b) -> a -> b
$
      Getter (Index1 GLint)
forall a. Getter a
layerGet (GLint -> Index1 GLint
forall a. a -> Index1 a
Index1 (GLint -> Index1 GLint) -> (CInt -> GLint) -> CInt -> Index1 GLint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral) GLenum
glut_TRANSPARENT_INDEX