--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of
-- the OpenGL 2.1 specs.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer (
   PixelTransferStage(..),
   mapColor, mapStencil, indexShift, indexOffset, depthScale, depthBias,
   rgbaScale, rgbaBias
) where

import Data.StateVar
import Graphics.Rendering.OpenGL.GL.Capability
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.VertexSpec
import Graphics.GL

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

data PixelTransfer =
     MapColor
   | MapStencil
   | IndexShift
   | IndexOffset
   | RedScale
   | RedBias
   | GreenScale
   | GreenBias
   | BlueScale
   | BlueBias
   | AlphaScale
   | AlphaBias
   | DepthScale
   | DepthBias
   | PostConvolutionRedScale
   | PostConvolutionGreenScale
   | PostConvolutionBlueScale
   | PostConvolutionAlphaScale
   | PostConvolutionRedBias
   | PostConvolutionGreenBias
   | PostConvolutionBlueBias
   | PostConvolutionAlphaBias
   | PostColorMatrixRedScale
   | PostColorMatrixGreenScale
   | PostColorMatrixBlueScale
   | PostColorMatrixAlphaScale
   | PostColorMatrixRedBias
   | PostColorMatrixGreenBias
   | PostColorMatrixBlueBias
   | PostColorMatrixAlphaBias

marshalPixelTransfer :: PixelTransfer -> GLenum
marshalPixelTransfer :: PixelTransfer -> GLenum
marshalPixelTransfer PixelTransfer
x = case PixelTransfer
x of
   PixelTransfer
MapColor -> GLenum
GL_MAP_COLOR
   PixelTransfer
MapStencil -> GLenum
GL_MAP_STENCIL
   PixelTransfer
IndexShift -> GLenum
GL_INDEX_SHIFT
   PixelTransfer
IndexOffset -> GLenum
GL_INDEX_OFFSET
   PixelTransfer
RedScale -> GLenum
GL_RED_SCALE
   PixelTransfer
RedBias -> GLenum
GL_RED_BIAS
   PixelTransfer
GreenScale -> GLenum
GL_GREEN_SCALE
   PixelTransfer
GreenBias -> GLenum
GL_GREEN_BIAS
   PixelTransfer
BlueScale -> GLenum
GL_BLUE_SCALE
   PixelTransfer
BlueBias -> GLenum
GL_BLUE_BIAS
   PixelTransfer
AlphaScale -> GLenum
GL_ALPHA_SCALE
   PixelTransfer
AlphaBias -> GLenum
GL_ALPHA_BIAS
   PixelTransfer
DepthScale -> GLenum
GL_DEPTH_SCALE
   PixelTransfer
DepthBias -> GLenum
GL_DEPTH_BIAS
   PixelTransfer
PostConvolutionRedScale -> GLenum
GL_POST_CONVOLUTION_RED_SCALE
   PixelTransfer
PostConvolutionGreenScale -> GLenum
GL_POST_CONVOLUTION_GREEN_SCALE
   PixelTransfer
PostConvolutionBlueScale -> GLenum
GL_POST_CONVOLUTION_BLUE_SCALE
   PixelTransfer
PostConvolutionAlphaScale -> GLenum
GL_POST_CONVOLUTION_ALPHA_SCALE
   PixelTransfer
PostConvolutionRedBias -> GLenum
GL_POST_CONVOLUTION_RED_BIAS
   PixelTransfer
PostConvolutionGreenBias -> GLenum
GL_POST_CONVOLUTION_GREEN_BIAS
   PixelTransfer
PostConvolutionBlueBias -> GLenum
GL_POST_CONVOLUTION_BLUE_BIAS
   PixelTransfer
PostConvolutionAlphaBias -> GLenum
GL_POST_CONVOLUTION_ALPHA_BIAS
   PixelTransfer
PostColorMatrixRedScale -> GLenum
GL_POST_COLOR_MATRIX_RED_SCALE
   PixelTransfer
PostColorMatrixGreenScale -> GLenum
GL_POST_COLOR_MATRIX_GREEN_SCALE
   PixelTransfer
PostColorMatrixBlueScale -> GLenum
GL_POST_COLOR_MATRIX_BLUE_SCALE
   PixelTransfer
PostColorMatrixAlphaScale -> GLenum
GL_POST_COLOR_MATRIX_ALPHA_SCALE
   PixelTransfer
PostColorMatrixRedBias -> GLenum
GL_POST_COLOR_MATRIX_RED_BIAS
   PixelTransfer
PostColorMatrixGreenBias -> GLenum
GL_POST_COLOR_MATRIX_GREEN_BIAS
   PixelTransfer
PostColorMatrixBlueBias -> GLenum
GL_POST_COLOR_MATRIX_BLUE_BIAS
   PixelTransfer
PostColorMatrixAlphaBias -> GLenum
GL_POST_COLOR_MATRIX_ALPHA_BIAS

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

data PixelTransferStage =
     PreConvolution
   | PostConvolution
   | PostColorMatrix
   deriving ( PixelTransferStage -> PixelTransferStage -> Bool
(PixelTransferStage -> PixelTransferStage -> Bool)
-> (PixelTransferStage -> PixelTransferStage -> Bool)
-> Eq PixelTransferStage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PixelTransferStage -> PixelTransferStage -> Bool
$c/= :: PixelTransferStage -> PixelTransferStage -> Bool
== :: PixelTransferStage -> PixelTransferStage -> Bool
$c== :: PixelTransferStage -> PixelTransferStage -> Bool
Eq, Eq PixelTransferStage
Eq PixelTransferStage
-> (PixelTransferStage -> PixelTransferStage -> Ordering)
-> (PixelTransferStage -> PixelTransferStage -> Bool)
-> (PixelTransferStage -> PixelTransferStage -> Bool)
-> (PixelTransferStage -> PixelTransferStage -> Bool)
-> (PixelTransferStage -> PixelTransferStage -> Bool)
-> (PixelTransferStage -> PixelTransferStage -> PixelTransferStage)
-> (PixelTransferStage -> PixelTransferStage -> PixelTransferStage)
-> Ord PixelTransferStage
PixelTransferStage -> PixelTransferStage -> Bool
PixelTransferStage -> PixelTransferStage -> Ordering
PixelTransferStage -> PixelTransferStage -> PixelTransferStage
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 :: PixelTransferStage -> PixelTransferStage -> PixelTransferStage
$cmin :: PixelTransferStage -> PixelTransferStage -> PixelTransferStage
max :: PixelTransferStage -> PixelTransferStage -> PixelTransferStage
$cmax :: PixelTransferStage -> PixelTransferStage -> PixelTransferStage
>= :: PixelTransferStage -> PixelTransferStage -> Bool
$c>= :: PixelTransferStage -> PixelTransferStage -> Bool
> :: PixelTransferStage -> PixelTransferStage -> Bool
$c> :: PixelTransferStage -> PixelTransferStage -> Bool
<= :: PixelTransferStage -> PixelTransferStage -> Bool
$c<= :: PixelTransferStage -> PixelTransferStage -> Bool
< :: PixelTransferStage -> PixelTransferStage -> Bool
$c< :: PixelTransferStage -> PixelTransferStage -> Bool
compare :: PixelTransferStage -> PixelTransferStage -> Ordering
$ccompare :: PixelTransferStage -> PixelTransferStage -> Ordering
$cp1Ord :: Eq PixelTransferStage
Ord, Int -> PixelTransferStage -> ShowS
[PixelTransferStage] -> ShowS
PixelTransferStage -> String
(Int -> PixelTransferStage -> ShowS)
-> (PixelTransferStage -> String)
-> ([PixelTransferStage] -> ShowS)
-> Show PixelTransferStage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PixelTransferStage] -> ShowS
$cshowList :: [PixelTransferStage] -> ShowS
show :: PixelTransferStage -> String
$cshow :: PixelTransferStage -> String
showsPrec :: Int -> PixelTransferStage -> ShowS
$cshowsPrec :: Int -> PixelTransferStage -> ShowS
Show )

stageToGetScales ::
      PixelTransferStage
   -> (PName1F, PName1F, PName1F, PName1F)
stageToGetScales :: PixelTransferStage -> (PName1F, PName1F, PName1F, PName1F)
stageToGetScales PixelTransferStage
s = case PixelTransferStage
s of
   PixelTransferStage
PreConvolution  -> (PName1F
GetRedScale,
                       PName1F
GetGreenScale,
                       PName1F
GetBlueScale,
                       PName1F
GetAlphaScale)
   PixelTransferStage
PostConvolution -> (PName1F
GetPostConvolutionRedScale,
                       PName1F
GetPostConvolutionGreenScale,
                       PName1F
GetPostConvolutionBlueScale,
                       PName1F
GetPostConvolutionAlphaScale)
   PixelTransferStage
PostColorMatrix -> (PName1F
GetPostColorMatrixRedScale,
                       PName1F
GetPostColorMatrixGreenScale,
                       PName1F
GetPostColorMatrixBlueScale,
                       PName1F
GetPostColorMatrixAlphaScale)

stageToSetScales ::
      PixelTransferStage
   -> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)
stageToSetScales :: PixelTransferStage
-> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)
stageToSetScales PixelTransferStage
s = case PixelTransferStage
s of
   PixelTransferStage
PreConvolution  -> (PixelTransfer
RedScale,
                       PixelTransfer
GreenScale,
                       PixelTransfer
BlueScale,
                       PixelTransfer
AlphaScale)
   PixelTransferStage
PostConvolution -> (PixelTransfer
PostConvolutionRedScale,
                       PixelTransfer
PostConvolutionGreenScale,
                       PixelTransfer
PostConvolutionBlueScale,
                       PixelTransfer
PostConvolutionAlphaScale)
   PixelTransferStage
PostColorMatrix -> (PixelTransfer
PostColorMatrixRedScale,
                       PixelTransfer
PostColorMatrixGreenScale,
                       PixelTransfer
PostColorMatrixBlueScale,
                       PixelTransfer
PostColorMatrixAlphaScale)

stageToGetBiases ::
      PixelTransferStage
   -> (PName1F, PName1F, PName1F, PName1F)
stageToGetBiases :: PixelTransferStage -> (PName1F, PName1F, PName1F, PName1F)
stageToGetBiases PixelTransferStage
s = case PixelTransferStage
s of
   PixelTransferStage
PreConvolution  -> (PName1F
GetRedBias,
                       PName1F
GetGreenBias,
                       PName1F
GetBlueBias,
                       PName1F
GetAlphaBias)
   PixelTransferStage
PostConvolution -> (PName1F
GetPostConvolutionRedBias,
                       PName1F
GetPostConvolutionGreenBias,
                       PName1F
GetPostConvolutionBlueBias,
                       PName1F
GetPostConvolutionAlphaBias)
   PixelTransferStage
PostColorMatrix -> (PName1F
GetPostColorMatrixRedBias,
                       PName1F
GetPostColorMatrixGreenBias,
                       PName1F
GetPostColorMatrixBlueBias,
                       PName1F
GetPostColorMatrixAlphaBias)

stageToSetBiases ::
      PixelTransferStage
   -> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)
stageToSetBiases :: PixelTransferStage
-> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)
stageToSetBiases PixelTransferStage
s = case PixelTransferStage
s of
   PixelTransferStage
PreConvolution  -> (PixelTransfer
RedBias,
                       PixelTransfer
GreenBias,
                       PixelTransfer
BlueBias,
                       PixelTransfer
AlphaBias)
   PixelTransferStage
PostConvolution -> (PixelTransfer
PostConvolutionRedBias,
                       PixelTransfer
PostConvolutionGreenBias,
                       PixelTransfer
PostConvolutionBlueBias,
                       PixelTransfer
PostConvolutionAlphaBias)
   PixelTransferStage
PostColorMatrix -> (PixelTransfer
PostColorMatrixRedBias,
                       PixelTransfer
PostColorMatrixGreenBias,
                       PixelTransfer
PostColorMatrixBlueBias,
                       PixelTransfer
PostColorMatrixAlphaBias)

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

mapColor :: StateVar Capability
mapColor :: StateVar Capability
mapColor = PName1I -> PixelTransfer -> StateVar Capability
forall p. GetPName1I p => p -> PixelTransfer -> StateVar Capability
pixelTransferb PName1I
GetMapColor PixelTransfer
MapColor

mapStencil :: StateVar Capability
mapStencil :: StateVar Capability
mapStencil = PName1I -> PixelTransfer -> StateVar Capability
forall p. GetPName1I p => p -> PixelTransfer -> StateVar Capability
pixelTransferb PName1I
GetMapStencil PixelTransfer
MapStencil

indexShift :: StateVar GLint
indexShift :: StateVar GLint
indexShift = PName1I -> PixelTransfer -> StateVar GLint
forall p. GetPName1I p => p -> PixelTransfer -> StateVar GLint
pixelTransferi PName1I
GetIndexShift PixelTransfer
IndexShift

indexOffset :: StateVar GLint
indexOffset :: StateVar GLint
indexOffset = PName1I -> PixelTransfer -> StateVar GLint
forall p. GetPName1I p => p -> PixelTransfer -> StateVar GLint
pixelTransferi PName1I
GetIndexOffset PixelTransfer
IndexOffset

depthScale :: StateVar GLfloat
depthScale :: StateVar GLfloat
depthScale = PName1F -> PixelTransfer -> StateVar GLfloat
forall p. GetPName1F p => p -> PixelTransfer -> StateVar GLfloat
pixelTransferf PName1F
GetDepthScale PixelTransfer
DepthScale

depthBias :: StateVar GLfloat
depthBias :: StateVar GLfloat
depthBias = PName1F -> PixelTransfer -> StateVar GLfloat
forall p. GetPName1F p => p -> PixelTransfer -> StateVar GLfloat
pixelTransferf PName1F
GetDepthBias PixelTransfer
DepthBias

rgbaScale :: PixelTransferStage -> StateVar (Color4 GLfloat)
rgbaScale :: PixelTransferStage -> StateVar (Color4 GLfloat)
rgbaScale PixelTransferStage
s = (PName1F, PName1F, PName1F, PName1F)
-> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)
-> StateVar (Color4 GLfloat)
forall p.
GetPName1F p =>
(p, p, p, p)
-> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)
-> StateVar (Color4 GLfloat)
pixelTransfer4f (PixelTransferStage -> (PName1F, PName1F, PName1F, PName1F)
stageToGetScales PixelTransferStage
s) (PixelTransferStage
-> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)
stageToSetScales PixelTransferStage
s)

rgbaBias :: PixelTransferStage -> StateVar (Color4 GLfloat)
rgbaBias :: PixelTransferStage -> StateVar (Color4 GLfloat)
rgbaBias PixelTransferStage
s = (PName1F, PName1F, PName1F, PName1F)
-> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)
-> StateVar (Color4 GLfloat)
forall p.
GetPName1F p =>
(p, p, p, p)
-> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)
-> StateVar (Color4 GLfloat)
pixelTransfer4f (PixelTransferStage -> (PName1F, PName1F, PName1F, PName1F)
stageToGetBiases PixelTransferStage
s) (PixelTransferStage
-> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)
stageToSetBiases PixelTransferStage
s)

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

pixelTransferb :: GetPName1I p => p -> PixelTransfer -> StateVar Capability
pixelTransferb :: p -> PixelTransfer -> StateVar Capability
pixelTransferb p
pn PixelTransfer
pt =
   IO Capability -> (Capability -> IO ()) -> StateVar Capability
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      ((GLboolean -> Capability) -> p -> IO Capability
forall p a. GetPName1I p => (GLboolean -> a) -> p -> IO a
getBoolean1 GLboolean -> Capability
unmarshalCapability p
pn)
      (GLenum -> GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLint -> m ()
glPixelTransferi (PixelTransfer -> GLenum
marshalPixelTransfer PixelTransfer
pt) (GLint -> IO ()) -> (Capability -> GLint) -> Capability -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       GLboolean -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLboolean -> GLint)
-> (Capability -> GLboolean) -> Capability -> GLint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capability -> GLboolean
marshalCapability)

pixelTransferi :: GetPName1I p => p -> PixelTransfer -> StateVar GLint
pixelTransferi :: p -> PixelTransfer -> StateVar GLint
pixelTransferi p
pn PixelTransfer
pt =
   IO GLint -> (GLint -> IO ()) -> StateVar GLint
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      ((GLint -> GLint) -> p -> IO GLint
forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
getInteger1 GLint -> GLint
forall a. a -> a
id p
pn)
      (GLenum -> GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLint -> m ()
glPixelTransferi (PixelTransfer -> GLenum
marshalPixelTransfer PixelTransfer
pt))

pixelTransferf :: GetPName1F p => p -> PixelTransfer -> StateVar GLfloat
pixelTransferf :: p -> PixelTransfer -> StateVar GLfloat
pixelTransferf p
pn PixelTransfer
pt =
   IO GLfloat -> (GLfloat -> IO ()) -> StateVar GLfloat
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      ((GLfloat -> GLfloat) -> p -> IO GLfloat
forall p a. GetPName1F p => (GLfloat -> a) -> p -> IO a
getFloat1 GLfloat -> GLfloat
forall a. a -> a
id p
pn)
      (GLenum -> GLfloat -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLfloat -> m ()
glPixelTransferf (PixelTransfer -> GLenum
marshalPixelTransfer PixelTransfer
pt))

pixelTransfer4f :: GetPName1F p =>
      (p, p, p, p)
   -> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)
   -> StateVar (Color4 GLfloat)
pixelTransfer4f :: (p, p, p, p)
-> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)
-> StateVar (Color4 GLfloat)
pixelTransfer4f (p
pr, p
pg, p
pb, p
pa) (PixelTransfer
tr, PixelTransfer
tg, PixelTransfer
tb, PixelTransfer
ta) = IO (Color4 GLfloat)
-> (Color4 GLfloat -> IO ()) -> StateVar (Color4 GLfloat)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO (Color4 GLfloat)
get4f Color4 GLfloat -> IO ()
forall (m :: * -> *). MonadIO m => Color4 GLfloat -> m ()
set4f
   where get4f :: IO (Color4 GLfloat)
get4f = do
            GLfloat
r <- (GLfloat -> GLfloat) -> p -> IO GLfloat
forall p a. GetPName1F p => (GLfloat -> a) -> p -> IO a
getFloat1 GLfloat -> GLfloat
forall a. a -> a
id p
pr
            GLfloat
g <- (GLfloat -> GLfloat) -> p -> IO GLfloat
forall p a. GetPName1F p => (GLfloat -> a) -> p -> IO a
getFloat1 GLfloat -> GLfloat
forall a. a -> a
id p
pg
            GLfloat
b <- (GLfloat -> GLfloat) -> p -> IO GLfloat
forall p a. GetPName1F p => (GLfloat -> a) -> p -> IO a
getFloat1 GLfloat -> GLfloat
forall a. a -> a
id p
pb
            GLfloat
a <- (GLfloat -> GLfloat) -> p -> IO GLfloat
forall p a. GetPName1F p => (GLfloat -> a) -> p -> IO a
getFloat1 GLfloat -> GLfloat
forall a. a -> a
id p
pa
            Color4 GLfloat -> IO (Color4 GLfloat)
forall (m :: * -> *) a. Monad m => a -> m a
return (Color4 GLfloat -> IO (Color4 GLfloat))
-> Color4 GLfloat -> IO (Color4 GLfloat)
forall a b. (a -> b) -> a -> b
$ GLfloat -> GLfloat -> GLfloat -> GLfloat -> Color4 GLfloat
forall a. a -> a -> a -> a -> Color4 a
Color4 GLfloat
r GLfloat
g GLfloat
b GLfloat
a
         set4f :: Color4 GLfloat -> m ()
set4f (Color4 GLfloat
r GLfloat
g GLfloat
b GLfloat
a) = do
            GLenum -> GLfloat -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> GLfloat -> m ()
glPixelTransferf (PixelTransfer -> GLenum
marshalPixelTransfer PixelTransfer
tr) GLfloat
r
            GLenum -> GLfloat -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> GLfloat -> m ()
glPixelTransferf (PixelTransfer -> GLenum
marshalPixelTransfer PixelTransfer
tg) GLfloat
g
            GLenum -> GLfloat -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> GLfloat -> m ()
glPixelTransferf (PixelTransfer -> GLenum
marshalPixelTransfer PixelTransfer
tb) GLfloat
b
            GLenum -> GLfloat -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> GLfloat -> m ()
glPixelTransferf (PixelTransfer -> GLenum
marshalPixelTransfer PixelTransfer
ta) GLfloat
a