--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram
-- 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.Histogram (
   Sink(..), histogram, Reset(..), getHistogram, resetHistogram,
   histogramRGBASizes, histogramLuminanceSize
) where

import Data.StateVar
import Foreign.Marshal.Utils
import Graphics.Rendering.OpenGL.GL.Capability
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.GL.PixelData
import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable
import Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset
import Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink
import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
import Graphics.Rendering.OpenGL.GL.VertexSpec
import Graphics.GL

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

data HistogramTarget =
     Histogram
   | ProxyHistogram

marshalHistogramTarget :: HistogramTarget -> GLenum
marshalHistogramTarget :: HistogramTarget -> GLenum
marshalHistogramTarget HistogramTarget
x = case HistogramTarget
x of
   HistogramTarget
Histogram -> GLenum
GL_HISTOGRAM
   HistogramTarget
ProxyHistogram -> GLenum
GL_PROXY_HISTOGRAM

proxyToHistogramTarget :: Proxy -> HistogramTarget
proxyToHistogramTarget :: Proxy -> HistogramTarget
proxyToHistogramTarget Proxy
x = case Proxy
x of
   Proxy
NoProxy -> HistogramTarget
Histogram
   Proxy
Proxy -> HistogramTarget
ProxyHistogram

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

histogram :: Proxy -> StateVar (Maybe (GLsizei, PixelInternalFormat, Sink))
histogram :: Proxy -> StateVar (Maybe (GLint, PixelInternalFormat, Sink))
histogram Proxy
proxy =
   IO EnableCap
-> IO (GLint, PixelInternalFormat, Sink)
-> ((GLint, PixelInternalFormat, Sink) -> IO ())
-> StateVar (Maybe (GLint, PixelInternalFormat, Sink))
forall a.
IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)
makeStateVarMaybe
      (EnableCap -> IO EnableCap
forall (m :: * -> *) a. Monad m => a -> m a
return EnableCap
CapHistogram) (Proxy -> IO (GLint, PixelInternalFormat, Sink)
getHistogram' Proxy
proxy) (Proxy -> (GLint, PixelInternalFormat, Sink) -> IO ()
setHistogram Proxy
proxy)

getHistogram' :: Proxy -> IO (GLsizei, PixelInternalFormat, Sink)
getHistogram' :: Proxy -> IO (GLint, PixelInternalFormat, Sink)
getHistogram' Proxy
proxy = do
   GLint
w <- (GLint -> GLint) -> Proxy -> GetHistogramParameterPName -> IO GLint
forall a.
(GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a
getHistogramParameteri GLint -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Proxy
proxy GetHistogramParameterPName
HistogramWidth
   PixelInternalFormat
f <- (GLint -> PixelInternalFormat)
-> Proxy -> GetHistogramParameterPName -> IO PixelInternalFormat
forall a.
(GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a
getHistogramParameteri GLint -> PixelInternalFormat
unmarshalPixelInternalFormat Proxy
proxy GetHistogramParameterPName
HistogramFormat
   Sink
s <- (GLint -> Sink) -> Proxy -> GetHistogramParameterPName -> IO Sink
forall a.
(GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a
getHistogramParameteri GLint -> Sink
unmarshalSink Proxy
proxy GetHistogramParameterPName
HistogramSink
   (GLint, PixelInternalFormat, Sink)
-> IO (GLint, PixelInternalFormat, Sink)
forall (m :: * -> *) a. Monad m => a -> m a
return (GLint
w, PixelInternalFormat
f, Sink
s)

getHistogramParameteri ::
   (GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a
getHistogramParameteri :: forall a.
(GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a
getHistogramParameteri GLint -> a
f Proxy
proxy GetHistogramParameterPName
p =
   GLint -> (Ptr GLint -> IO a) -> IO a
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLint
0 ((Ptr GLint -> IO a) -> IO a) -> (Ptr GLint -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr GLint
buf -> do
      GLenum -> GLenum -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLint -> m ()
glGetHistogramParameteriv
         (HistogramTarget -> GLenum
marshalHistogramTarget (Proxy -> HistogramTarget
proxyToHistogramTarget Proxy
proxy))
         (GetHistogramParameterPName -> GLenum
marshalGetHistogramParameterPName GetHistogramParameterPName
p)
         Ptr GLint
buf
      (GLint -> a) -> Ptr GLint -> IO a
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 GLint -> a
f Ptr GLint
buf

setHistogram :: Proxy -> (GLsizei, PixelInternalFormat, Sink) -> IO ()
setHistogram :: Proxy -> (GLint, PixelInternalFormat, Sink) -> IO ()
setHistogram Proxy
proxy (GLint
w, PixelInternalFormat
int, Sink
sink) =
   GLenum -> GLint -> GLenum -> GLboolean -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> GLenum -> GLboolean -> m ()
glHistogram
      (HistogramTarget -> GLenum
marshalHistogramTarget (Proxy -> HistogramTarget
proxyToHistogramTarget Proxy
proxy))
      GLint
w
      (PixelInternalFormat -> GLenum
marshalPixelInternalFormat' PixelInternalFormat
int)
      (Sink -> GLboolean
marshalSink Sink
sink)

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

getHistogram :: Reset -> PixelData a -> IO ()
getHistogram :: forall a. Reset -> PixelData a -> IO ()
getHistogram Reset
reset PixelData a
pd =
   PixelData a -> (GLenum -> GLenum -> Ptr a -> IO ()) -> IO ()
forall a b. PixelData a -> (GLenum -> GLenum -> Ptr a -> b) -> b
withPixelData PixelData a
pd ((GLenum -> GLenum -> Ptr a -> IO ()) -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
      GLenum -> GLboolean -> GLenum -> GLenum -> Ptr a -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
GLenum -> GLboolean -> GLenum -> GLenum -> Ptr a -> m ()
glGetHistogram
         (HistogramTarget -> GLenum
marshalHistogramTarget HistogramTarget
Histogram)
         (Reset -> GLboolean
marshalReset Reset
reset)

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

resetHistogram :: IO ()
resetHistogram :: IO ()
resetHistogram = GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glResetHistogram (HistogramTarget -> GLenum
marshalHistogramTarget HistogramTarget
Histogram)

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

data GetHistogramParameterPName =
     HistogramWidth
   | HistogramFormat
   | HistogramRedSize
   | HistogramGreenSize
   | HistogramBlueSize
   | HistogramAlphaSize
   | HistogramLuminanceSize
   | HistogramSink

marshalGetHistogramParameterPName :: GetHistogramParameterPName -> GLenum
marshalGetHistogramParameterPName :: GetHistogramParameterPName -> GLenum
marshalGetHistogramParameterPName GetHistogramParameterPName
x = case GetHistogramParameterPName
x of
   GetHistogramParameterPName
HistogramWidth -> GLenum
GL_HISTOGRAM_WIDTH
   GetHistogramParameterPName
HistogramFormat -> GLenum
GL_HISTOGRAM_FORMAT
   GetHistogramParameterPName
HistogramRedSize -> GLenum
GL_HISTOGRAM_RED_SIZE
   GetHistogramParameterPName
HistogramGreenSize -> GLenum
GL_HISTOGRAM_GREEN_SIZE
   GetHistogramParameterPName
HistogramBlueSize -> GLenum
GL_HISTOGRAM_BLUE_SIZE
   GetHistogramParameterPName
HistogramAlphaSize -> GLenum
GL_HISTOGRAM_ALPHA_SIZE
   GetHistogramParameterPName
HistogramLuminanceSize -> GLenum
GL_HISTOGRAM_LUMINANCE_SIZE
   GetHistogramParameterPName
HistogramSink -> GLenum
GL_HISTOGRAM_SINK

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

histogramRGBASizes :: Proxy -> GettableStateVar (Color4 GLsizei)
histogramRGBASizes :: Proxy -> GettableStateVar (Color4 GLint)
histogramRGBASizes Proxy
proxy =
   GettableStateVar (Color4 GLint) -> GettableStateVar (Color4 GLint)
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar (Color4 GLint)
 -> GettableStateVar (Color4 GLint))
-> GettableStateVar (Color4 GLint)
-> GettableStateVar (Color4 GLint)
forall a b. (a -> b) -> a -> b
$ do
      GLint
r <- (GLint -> GLint) -> Proxy -> GetHistogramParameterPName -> IO GLint
forall a.
(GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a
getHistogramParameteri GLint -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Proxy
proxy GetHistogramParameterPName
HistogramRedSize
      GLint
g <- (GLint -> GLint) -> Proxy -> GetHistogramParameterPName -> IO GLint
forall a.
(GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a
getHistogramParameteri GLint -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Proxy
proxy GetHistogramParameterPName
HistogramGreenSize
      GLint
b <- (GLint -> GLint) -> Proxy -> GetHistogramParameterPName -> IO GLint
forall a.
(GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a
getHistogramParameteri GLint -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Proxy
proxy GetHistogramParameterPName
HistogramBlueSize
      GLint
a <- (GLint -> GLint) -> Proxy -> GetHistogramParameterPName -> IO GLint
forall a.
(GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a
getHistogramParameteri GLint -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Proxy
proxy GetHistogramParameterPName
HistogramAlphaSize
      Color4 GLint -> GettableStateVar (Color4 GLint)
forall (m :: * -> *) a. Monad m => a -> m a
return (Color4 GLint -> GettableStateVar (Color4 GLint))
-> Color4 GLint -> GettableStateVar (Color4 GLint)
forall a b. (a -> b) -> a -> b
$ GLint -> GLint -> GLint -> GLint -> Color4 GLint
forall a. a -> a -> a -> a -> Color4 a
Color4 GLint
r GLint
g GLint
b GLint
a

histogramLuminanceSize :: Proxy -> GettableStateVar GLsizei
histogramLuminanceSize :: Proxy -> IO GLint
histogramLuminanceSize Proxy
proxy =
   IO GLint -> IO GLint
forall a. IO a -> IO a
makeGettableStateVar (IO GLint -> IO GLint) -> IO GLint -> IO GLint
forall a b. (a -> b) -> a -> b
$
      (GLint -> GLint) -> Proxy -> GetHistogramParameterPName -> IO GLint
forall a.
(GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a
getHistogramParameteri GLint -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Proxy
proxy GetHistogramParameterPName
HistogramLuminanceSize