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

module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage (
   PixelStoreDirection(..), swapBytes, lsbFirst, rowLength, skipRows,
   skipPixels, rowAlignment, imageHeight, skipImages
) where

import Data.StateVar
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.GL

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

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

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

data PixelStore =
     UnpackSwapBytes
   | UnpackLSBFirst
   | UnpackRowLength
   | UnpackSkipRows
   | UnpackSkipPixels
   | UnpackAlignment
   | PackSwapBytes
   | PackLSBFirst
   | PackRowLength
   | PackSkipRows
   | PackSkipPixels
   | PackAlignment
   | PackSkipImages
   | PackImageHeight
   | UnpackSkipImages
   | UnpackImageHeight

marshalPixelStore :: PixelStore -> GLenum
marshalPixelStore :: PixelStore -> GLenum
marshalPixelStore PixelStore
x = case PixelStore
x of
   PixelStore
UnpackSwapBytes -> GLenum
GL_UNPACK_SWAP_BYTES
   PixelStore
UnpackLSBFirst -> GLenum
GL_UNPACK_LSB_FIRST
   PixelStore
UnpackRowLength -> GLenum
GL_UNPACK_ROW_LENGTH
   PixelStore
UnpackSkipRows -> GLenum
GL_UNPACK_SKIP_ROWS
   PixelStore
UnpackSkipPixels -> GLenum
GL_UNPACK_SKIP_PIXELS
   PixelStore
UnpackAlignment -> GLenum
GL_UNPACK_ALIGNMENT
   PixelStore
PackSwapBytes -> GLenum
GL_PACK_SWAP_BYTES
   PixelStore
PackLSBFirst -> GLenum
GL_PACK_LSB_FIRST
   PixelStore
PackRowLength -> GLenum
GL_PACK_ROW_LENGTH
   PixelStore
PackSkipRows -> GLenum
GL_PACK_SKIP_ROWS
   PixelStore
PackSkipPixels -> GLenum
GL_PACK_SKIP_PIXELS
   PixelStore
PackAlignment -> GLenum
GL_PACK_ALIGNMENT
   PixelStore
PackSkipImages -> GLenum
GL_PACK_SKIP_IMAGES
   PixelStore
PackImageHeight -> GLenum
GL_PACK_IMAGE_HEIGHT
   PixelStore
UnpackSkipImages -> GLenum
GL_UNPACK_SKIP_IMAGES
   PixelStore
UnpackImageHeight -> GLenum
GL_UNPACK_IMAGE_HEIGHT

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

swapBytes :: PixelStoreDirection -> StateVar Bool
swapBytes :: PixelStoreDirection -> StateVar Bool
swapBytes PixelStoreDirection
Pack   = PName1I -> PixelStore -> StateVar Bool
pixelStoreb PName1I
GetPackSwapBytes PixelStore
PackSwapBytes
swapBytes PixelStoreDirection
Unpack = PName1I -> PixelStore -> StateVar Bool
pixelStoreb PName1I
GetUnpackSwapBytes PixelStore
UnpackSwapBytes

lsbFirst :: PixelStoreDirection -> StateVar Bool
lsbFirst :: PixelStoreDirection -> StateVar Bool
lsbFirst PixelStoreDirection
Pack   = PName1I -> PixelStore -> StateVar Bool
pixelStoreb PName1I
GetPackLSBFirst PixelStore
PackLSBFirst
lsbFirst PixelStoreDirection
Unpack = PName1I -> PixelStore -> StateVar Bool
pixelStoreb PName1I
GetUnpackLSBFirst PixelStore
UnpackLSBFirst

rowLength :: PixelStoreDirection -> StateVar GLint
rowLength :: PixelStoreDirection -> StateVar GLint
rowLength PixelStoreDirection
Pack   = PName1I -> PixelStore -> StateVar GLint
pixelStorei PName1I
GetPackRowLength PixelStore
PackRowLength
rowLength PixelStoreDirection
Unpack = PName1I -> PixelStore -> StateVar GLint
pixelStorei PName1I
GetUnpackRowLength PixelStore
UnpackRowLength

skipRows :: PixelStoreDirection -> StateVar GLint
skipRows :: PixelStoreDirection -> StateVar GLint
skipRows PixelStoreDirection
Pack   = PName1I -> PixelStore -> StateVar GLint
pixelStorei PName1I
GetPackSkipRows PixelStore
PackSkipRows
skipRows PixelStoreDirection
Unpack = PName1I -> PixelStore -> StateVar GLint
pixelStorei PName1I
GetUnpackSkipRows PixelStore
UnpackSkipRows

skipPixels :: PixelStoreDirection -> StateVar GLint
skipPixels :: PixelStoreDirection -> StateVar GLint
skipPixels PixelStoreDirection
Pack   = PName1I -> PixelStore -> StateVar GLint
pixelStorei PName1I
GetPackSkipPixels PixelStore
PackSkipPixels
skipPixels PixelStoreDirection
Unpack = PName1I -> PixelStore -> StateVar GLint
pixelStorei PName1I
GetUnpackSkipPixels PixelStore
UnpackSkipPixels

rowAlignment :: PixelStoreDirection -> StateVar GLint
rowAlignment :: PixelStoreDirection -> StateVar GLint
rowAlignment PixelStoreDirection
Pack   = PName1I -> PixelStore -> StateVar GLint
pixelStorei PName1I
GetPackAlignment PixelStore
PackAlignment
rowAlignment PixelStoreDirection
Unpack = PName1I -> PixelStore -> StateVar GLint
pixelStorei PName1I
GetUnpackAlignment PixelStore
UnpackAlignment

imageHeight :: PixelStoreDirection -> StateVar GLint
imageHeight :: PixelStoreDirection -> StateVar GLint
imageHeight PixelStoreDirection
Pack   = PName1I -> PixelStore -> StateVar GLint
pixelStorei PName1I
GetPackImageHeight PixelStore
PackImageHeight
imageHeight PixelStoreDirection
Unpack = PName1I -> PixelStore -> StateVar GLint
pixelStorei PName1I
GetUnpackImageHeight PixelStore
UnpackImageHeight

skipImages :: PixelStoreDirection -> StateVar GLint
skipImages :: PixelStoreDirection -> StateVar GLint
skipImages PixelStoreDirection
Pack   = PName1I -> PixelStore -> StateVar GLint
pixelStorei PName1I
GetPackSkipImages PixelStore
PackSkipImages
skipImages PixelStoreDirection
Unpack = PName1I -> PixelStore -> StateVar GLint
pixelStorei PName1I
GetUnpackSkipImages PixelStore
UnpackSkipImages

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

pixelStoreb :: PName1I -> PixelStore -> StateVar Bool
pixelStoreb :: PName1I -> PixelStore -> StateVar Bool
pixelStoreb PName1I
pn PixelStore
ps =
   IO Bool -> (Bool -> IO ()) -> StateVar Bool
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      ((GLboolean -> Bool) -> PName1I -> IO Bool
forall p a. GetPName1I p => (GLboolean -> a) -> p -> IO a
getBoolean1 GLboolean -> Bool
forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean PName1I
pn)
      (GLenum -> GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLint -> m ()
glPixelStorei (PixelStore -> GLenum
marshalPixelStore PixelStore
ps) (GLint -> IO ()) -> (Bool -> GLint) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> GLint
forall a. Num a => Bool -> a
marshalGLboolean)

pixelStorei :: PName1I -> PixelStore -> StateVar GLint
pixelStorei :: PName1I -> PixelStore -> StateVar GLint
pixelStorei PName1I
pn PixelStore
ps =
   IO GLint -> (GLint -> IO ()) -> StateVar GLint
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      ((GLint -> GLint) -> PName1I -> IO GLint
forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
getInteger1 GLint -> GLint
forall a. a -> a
id PName1I
pn)
      (GLenum -> GLint -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> GLint -> m ()
glPixelStorei (PixelStore -> GLenum
marshalPixelStore PixelStore
ps))