--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap
-- 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.
--
--------------------------------------------------------------------------------

{-# LANGUAGE TypeSynonymInstances #-}

module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap (
   PixelMapTarget(..), PixelMapComponent, PixelMap(..), GLpixelmap,
   maxPixelMapTable, pixelMap, pixelMapIToRGBA, pixelMapRGBAToRGBA,
) where

import Data.List
import Data.StateVar
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.VertexSpec
import Graphics.GL

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

data PixelMapTarget =
     IToI
   | SToS
   | IToR
   | IToG
   | IToB
   | IToA
   | RToR
   | GToG
   | BToB
   | AToA
   deriving ( PixelMapTarget -> PixelMapTarget -> Bool
(PixelMapTarget -> PixelMapTarget -> Bool)
-> (PixelMapTarget -> PixelMapTarget -> Bool) -> Eq PixelMapTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PixelMapTarget -> PixelMapTarget -> Bool
$c/= :: PixelMapTarget -> PixelMapTarget -> Bool
== :: PixelMapTarget -> PixelMapTarget -> Bool
$c== :: PixelMapTarget -> PixelMapTarget -> Bool
Eq, Eq PixelMapTarget
Eq PixelMapTarget
-> (PixelMapTarget -> PixelMapTarget -> Ordering)
-> (PixelMapTarget -> PixelMapTarget -> Bool)
-> (PixelMapTarget -> PixelMapTarget -> Bool)
-> (PixelMapTarget -> PixelMapTarget -> Bool)
-> (PixelMapTarget -> PixelMapTarget -> Bool)
-> (PixelMapTarget -> PixelMapTarget -> PixelMapTarget)
-> (PixelMapTarget -> PixelMapTarget -> PixelMapTarget)
-> Ord PixelMapTarget
PixelMapTarget -> PixelMapTarget -> Bool
PixelMapTarget -> PixelMapTarget -> Ordering
PixelMapTarget -> PixelMapTarget -> PixelMapTarget
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 :: PixelMapTarget -> PixelMapTarget -> PixelMapTarget
$cmin :: PixelMapTarget -> PixelMapTarget -> PixelMapTarget
max :: PixelMapTarget -> PixelMapTarget -> PixelMapTarget
$cmax :: PixelMapTarget -> PixelMapTarget -> PixelMapTarget
>= :: PixelMapTarget -> PixelMapTarget -> Bool
$c>= :: PixelMapTarget -> PixelMapTarget -> Bool
> :: PixelMapTarget -> PixelMapTarget -> Bool
$c> :: PixelMapTarget -> PixelMapTarget -> Bool
<= :: PixelMapTarget -> PixelMapTarget -> Bool
$c<= :: PixelMapTarget -> PixelMapTarget -> Bool
< :: PixelMapTarget -> PixelMapTarget -> Bool
$c< :: PixelMapTarget -> PixelMapTarget -> Bool
compare :: PixelMapTarget -> PixelMapTarget -> Ordering
$ccompare :: PixelMapTarget -> PixelMapTarget -> Ordering
$cp1Ord :: Eq PixelMapTarget
Ord, Int -> PixelMapTarget -> ShowS
[PixelMapTarget] -> ShowS
PixelMapTarget -> String
(Int -> PixelMapTarget -> ShowS)
-> (PixelMapTarget -> String)
-> ([PixelMapTarget] -> ShowS)
-> Show PixelMapTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PixelMapTarget] -> ShowS
$cshowList :: [PixelMapTarget] -> ShowS
show :: PixelMapTarget -> String
$cshow :: PixelMapTarget -> String
showsPrec :: Int -> PixelMapTarget -> ShowS
$cshowsPrec :: Int -> PixelMapTarget -> ShowS
Show )

marshalPixelMapTarget :: PixelMapTarget -> GLenum
marshalPixelMapTarget :: PixelMapTarget -> GLenum
marshalPixelMapTarget PixelMapTarget
x = case PixelMapTarget
x of
   PixelMapTarget
IToI -> GLenum
GL_PIXEL_MAP_I_TO_I
   PixelMapTarget
SToS -> GLenum
GL_PIXEL_MAP_S_TO_S
   PixelMapTarget
IToR -> GLenum
GL_PIXEL_MAP_I_TO_R
   PixelMapTarget
IToG -> GLenum
GL_PIXEL_MAP_I_TO_G
   PixelMapTarget
IToB -> GLenum
GL_PIXEL_MAP_I_TO_B
   PixelMapTarget
IToA -> GLenum
GL_PIXEL_MAP_I_TO_A
   PixelMapTarget
RToR -> GLenum
GL_PIXEL_MAP_R_TO_R
   PixelMapTarget
GToG -> GLenum
GL_PIXEL_MAP_G_TO_G
   PixelMapTarget
BToB -> GLenum
GL_PIXEL_MAP_B_TO_B
   PixelMapTarget
AToA -> GLenum
GL_PIXEL_MAP_A_TO_A

pixelMapTargetToGetPName :: PixelMapTarget -> PName1I
pixelMapTargetToGetPName :: PixelMapTarget -> PName1I
pixelMapTargetToGetPName PixelMapTarget
x = case PixelMapTarget
x of
   PixelMapTarget
IToI -> PName1I
GetPixelMapIToISize
   PixelMapTarget
SToS -> PName1I
GetPixelMapSToSSize
   PixelMapTarget
IToR -> PName1I
GetPixelMapIToRSize
   PixelMapTarget
IToG -> PName1I
GetPixelMapIToGSize
   PixelMapTarget
IToB -> PName1I
GetPixelMapIToBSize
   PixelMapTarget
IToA -> PName1I
GetPixelMapIToASize
   PixelMapTarget
RToR -> PName1I
GetPixelMapRToRSize
   PixelMapTarget
GToG -> PName1I
GetPixelMapGToGSize
   PixelMapTarget
BToB -> PName1I
GetPixelMapBToBSize
   PixelMapTarget
AToA -> PName1I
GetPixelMapAToASize

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

maxPixelMapTable :: GettableStateVar GLsizei
maxPixelMapTable :: GettableStateVar GLsizei
maxPixelMapTable = GettableStateVar GLsizei -> GettableStateVar GLsizei
forall a. IO a -> IO a
makeGettableStateVar (GettableStateVar GLsizei -> GettableStateVar GLsizei)
-> GettableStateVar GLsizei -> GettableStateVar GLsizei
forall a b. (a -> b) -> a -> b
$ (GLsizei -> GLsizei) -> PName1I -> GettableStateVar GLsizei
forall p a. GetPName1I p => (GLsizei -> a) -> p -> IO a
getSizei1 GLsizei -> GLsizei
forall a. a -> a
id PName1I
GetMaxPixelMapTable

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

class Storable c => PixelMapComponent c where
   getPixelMapv :: GLenum -> Ptr c -> IO ()
   pixelMapv :: GLenum -> GLsizei -> Ptr c -> IO ()

instance PixelMapComponent GLushort where
   getPixelMapv :: GLenum -> Ptr GLushort -> IO ()
getPixelMapv = GLenum -> Ptr GLushort -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> Ptr GLushort -> m ()
glGetPixelMapusv
   pixelMapv :: GLenum -> GLsizei -> Ptr GLushort -> IO ()
pixelMapv = GLenum -> GLsizei -> Ptr GLushort -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> Ptr GLushort -> m ()
glPixelMapusv

instance PixelMapComponent GLuint where
   getPixelMapv :: GLenum -> Ptr GLenum -> IO ()
getPixelMapv = GLenum -> Ptr GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> Ptr GLenum -> m ()
glGetPixelMapuiv
   pixelMapv :: GLenum -> GLsizei -> Ptr GLenum -> IO ()
pixelMapv = GLenum -> GLsizei -> Ptr GLenum -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> Ptr GLenum -> m ()
glPixelMapuiv

instance PixelMapComponent GLfloat where
   getPixelMapv :: GLenum -> Ptr GLfloat -> IO ()
getPixelMapv = GLenum -> Ptr GLfloat -> IO ()
forall (m :: * -> *). MonadIO m => GLenum -> Ptr GLfloat -> m ()
glGetPixelMapfv
   pixelMapv :: GLenum -> GLsizei -> Ptr GLfloat -> IO ()
pixelMapv = GLenum -> GLsizei -> Ptr GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLsizei -> Ptr GLfloat -> m ()
glPixelMapfv

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

class PixelMap m where
   withNewPixelMap ::
      PixelMapComponent c => Int -> (Ptr c -> IO ()) -> IO (m c)
   withPixelMap ::
      PixelMapComponent c => m c -> (Int -> Ptr c -> IO a) -> IO a
   newPixelMap :: PixelMapComponent c => [c] -> IO (m c)
   getPixelMapComponents :: PixelMapComponent c => m c -> IO [c]

   withNewPixelMap Int
size Ptr c -> IO ()
act =
      Int -> (Ptr c -> IO (m c)) -> IO (m c)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
size ((Ptr c -> IO (m c)) -> IO (m c))
-> (Ptr c -> IO (m c)) -> IO (m c)
forall a b. (a -> b) -> a -> b
$ \Ptr c
p -> do
         Ptr c -> IO ()
act Ptr c
p
         [c]
components <- Int -> Ptr c -> IO [c]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
size Ptr c
p
         [c] -> IO (m c)
forall (m :: * -> *) c.
(PixelMap m, PixelMapComponent c) =>
[c] -> IO (m c)
newPixelMap [c]
components

   withPixelMap m c
m Int -> Ptr c -> IO a
act = do
      [c]
components <- m c -> IO [c]
forall (m :: * -> *) c.
(PixelMap m, PixelMapComponent c) =>
m c -> IO [c]
getPixelMapComponents m c
m
      [c] -> (Int -> Ptr c -> IO a) -> IO a
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [c]
components Int -> Ptr c -> IO a
act

   newPixelMap [c]
elements =
      Int -> (Ptr c -> IO ()) -> IO (m c)
forall (m :: * -> *) c.
(PixelMap m, PixelMapComponent c) =>
Int -> (Ptr c -> IO ()) -> IO (m c)
withNewPixelMap ([c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [c]
elements) ((Ptr c -> IO ()) -> IO (m c)) -> (Ptr c -> IO ()) -> IO (m c)
forall a b. (a -> b) -> a -> b
$ (Ptr c -> [c] -> IO ()) -> [c] -> Ptr c -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr c -> [c] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray [c]
elements

   getPixelMapComponents m c
m =
      m c -> (Int -> Ptr c -> IO [c]) -> IO [c]
forall (m :: * -> *) c a.
(PixelMap m, PixelMapComponent c) =>
m c -> (Int -> Ptr c -> IO a) -> IO a
withPixelMap m c
m Int -> Ptr c -> IO [c]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray

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

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

instance PixelMap GLpixelmap where
   withNewPixelMap :: Int -> (Ptr c -> IO ()) -> IO (GLpixelmap c)
withNewPixelMap Int
size Ptr c -> IO ()
f = do
      ForeignPtr c
fp <- Int -> IO (ForeignPtr c)
forall a. Storable a => Int -> IO (ForeignPtr a)
mallocForeignPtrArray Int
size
      ForeignPtr c -> (Ptr c -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr c
fp Ptr c -> IO ()
f
      GLpixelmap c -> IO (GLpixelmap c)
forall (m :: * -> *) a. Monad m => a -> m a
return (GLpixelmap c -> IO (GLpixelmap c))
-> GLpixelmap c -> IO (GLpixelmap c)
forall a b. (a -> b) -> a -> b
$ Int -> ForeignPtr c -> GLpixelmap c
forall a. Int -> ForeignPtr a -> GLpixelmap a
GLpixelmap Int
size ForeignPtr c
fp

   withPixelMap :: GLpixelmap c -> (Int -> Ptr c -> IO a) -> IO a
withPixelMap (GLpixelmap Int
size ForeignPtr c
fp) Int -> Ptr c -> IO a
f = ForeignPtr c -> (Ptr c -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr c
fp (Int -> Ptr c -> IO a
f Int
size)

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

pixelMap :: (PixelMap m, PixelMapComponent c) => PixelMapTarget -> StateVar (m c)
pixelMap :: PixelMapTarget -> StateVar (m c)
pixelMap PixelMapTarget
pm =
   IO (m c) -> (m c -> IO ()) -> StateVar (m c)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (do Int
size <- PixelMapTarget -> IO Int
pixelMapSize PixelMapTarget
pm
          Int -> (Ptr c -> IO ()) -> IO (m c)
forall (m :: * -> *) c.
(PixelMap m, PixelMapComponent c) =>
Int -> (Ptr c -> IO ()) -> IO (m c)
withNewPixelMap Int
size ((Ptr c -> IO ()) -> IO (m c)) -> (Ptr c -> IO ()) -> IO (m c)
forall a b. (a -> b) -> a -> b
$ GLenum -> Ptr c -> IO ()
forall c. PixelMapComponent c => GLenum -> Ptr c -> IO ()
getPixelMapv (PixelMapTarget -> GLenum
marshalPixelMapTarget PixelMapTarget
pm))
      (\m c
theMap -> m c -> (Int -> Ptr c -> IO ()) -> IO ()
forall (m :: * -> *) c a.
(PixelMap m, PixelMapComponent c) =>
m c -> (Int -> Ptr c -> IO a) -> IO a
withPixelMap m c
theMap ((Int -> Ptr c -> IO ()) -> IO ())
-> (Int -> Ptr c -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLenum -> GLsizei -> Ptr c -> IO ()
forall c.
PixelMapComponent c =>
GLenum -> GLsizei -> Ptr c -> IO ()
pixelMapv (PixelMapTarget -> GLenum
marshalPixelMapTarget PixelMapTarget
pm) (GLsizei -> Ptr c -> IO ())
-> (Int -> GLsizei) -> Int -> Ptr c -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

pixelMapSize :: PixelMapTarget -> IO Int
pixelMapSize :: PixelMapTarget -> IO Int
pixelMapSize = (GLsizei -> Int) -> PName1I -> IO Int
forall p a. GetPName1I p => (GLsizei -> a) -> p -> IO a
getInteger1 GLsizei -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PName1I -> IO Int)
-> (PixelMapTarget -> PName1I) -> PixelMapTarget -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelMapTarget -> PName1I
pixelMapTargetToGetPName

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

-- | Convenience state variable

pixelMapIToRGBA :: PixelMapComponent c => StateVar [Color4 c]
pixelMapIToRGBA :: StateVar [Color4 c]
pixelMapIToRGBA = (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
-> StateVar [Color4 c]
forall c.
PixelMapComponent c =>
(PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
-> StateVar [Color4 c]
pixelMapXToY (PixelMapTarget
IToR, PixelMapTarget
IToG, PixelMapTarget
IToB, PixelMapTarget
IToA)

-- | Convenience state variable

pixelMapRGBAToRGBA :: PixelMapComponent c => StateVar [Color4 c]
pixelMapRGBAToRGBA :: StateVar [Color4 c]
pixelMapRGBAToRGBA = (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
-> StateVar [Color4 c]
forall c.
PixelMapComponent c =>
(PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
-> StateVar [Color4 c]
pixelMapXToY (PixelMapTarget
RToR, PixelMapTarget
GToG, PixelMapTarget
BToB, PixelMapTarget
AToA)

pixelMapXToY :: PixelMapComponent c =>
      (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
   -> StateVar [Color4 c]
pixelMapXToY :: (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
-> StateVar [Color4 c]
pixelMapXToY (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
targets =
   IO [Color4 c] -> ([Color4 c] -> IO ()) -> StateVar [Color4 c]
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar ((PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
-> IO [Color4 c]
forall c.
PixelMapComponent c =>
(PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
-> IO [Color4 c]
getPixelMapXToY (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
targets) ((PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
-> [Color4 c] -> IO ()
forall c.
PixelMapComponent c =>
(PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
-> [Color4 c] -> IO ()
setPixelMapXToY (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
targets)

getPixelMapXToY :: PixelMapComponent c
   => (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
   -> IO [Color4 c]
getPixelMapXToY :: (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
-> IO [Color4 c]
getPixelMapXToY (PixelMapTarget
toR, PixelMapTarget
toG, PixelMapTarget
toB, PixelMapTarget
toA) = do
   PixelMapTarget -> (Int -> Ptr c -> IO [Color4 c]) -> IO [Color4 c]
forall c a.
PixelMapComponent c =>
PixelMapTarget -> (Int -> Ptr c -> IO a) -> IO a
withPixelMapFor PixelMapTarget
toR ((Int -> Ptr c -> IO [Color4 c]) -> IO [Color4 c])
-> (Int -> Ptr c -> IO [Color4 c]) -> IO [Color4 c]
forall a b. (a -> b) -> a -> b
$ \Int
sizeR Ptr c
bufR ->
      PixelMapTarget -> (Int -> Ptr c -> IO [Color4 c]) -> IO [Color4 c]
forall c a.
PixelMapComponent c =>
PixelMapTarget -> (Int -> Ptr c -> IO a) -> IO a
withPixelMapFor PixelMapTarget
toG ((Int -> Ptr c -> IO [Color4 c]) -> IO [Color4 c])
-> (Int -> Ptr c -> IO [Color4 c]) -> IO [Color4 c]
forall a b. (a -> b) -> a -> b
$ \Int
sizeG Ptr c
bufG ->
         PixelMapTarget -> (Int -> Ptr c -> IO [Color4 c]) -> IO [Color4 c]
forall c a.
PixelMapComponent c =>
PixelMapTarget -> (Int -> Ptr c -> IO a) -> IO a
withPixelMapFor PixelMapTarget
toB ((Int -> Ptr c -> IO [Color4 c]) -> IO [Color4 c])
-> (Int -> Ptr c -> IO [Color4 c]) -> IO [Color4 c]
forall a b. (a -> b) -> a -> b
$ \Int
sizeB Ptr c
bufB ->
            PixelMapTarget -> (Int -> Ptr c -> IO [Color4 c]) -> IO [Color4 c]
forall c a.
PixelMapComponent c =>
PixelMapTarget -> (Int -> Ptr c -> IO a) -> IO a
withPixelMapFor PixelMapTarget
toA ((Int -> Ptr c -> IO [Color4 c]) -> IO [Color4 c])
-> (Int -> Ptr c -> IO [Color4 c]) -> IO [Color4 c]
forall a b. (a -> b) -> a -> b
$ \Int
sizeA Ptr c
bufA -> do
               let maxSize :: Int
maxSize = Int
sizeR Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
sizeG Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
sizeB Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
sizeA
               [c]
r <- Int -> Ptr c -> Int -> IO [c]
forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
sample Int
sizeR Ptr c
bufR Int
maxSize
               [c]
g <- Int -> Ptr c -> Int -> IO [c]
forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
sample Int
sizeR Ptr c
bufG Int
maxSize
               [c]
b <- Int -> Ptr c -> Int -> IO [c]
forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
sample Int
sizeR Ptr c
bufB Int
maxSize
               [c]
a <- Int -> Ptr c -> Int -> IO [c]
forall a. Storable a => Int -> Ptr a -> Int -> IO [a]
sample Int
sizeR Ptr c
bufA Int
maxSize
               [Color4 c] -> IO [Color4 c]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Color4 c] -> IO [Color4 c]) -> [Color4 c] -> IO [Color4 c]
forall a b. (a -> b) -> a -> b
$ (c -> c -> c -> c -> Color4 c)
-> [c] -> [c] -> [c] -> [c] -> [Color4 c]
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 c -> c -> c -> c -> Color4 c
forall a. a -> a -> a -> a -> Color4 a
Color4 [c]
r [c]
g [c]
b [c]
a

withPixelMapFor ::
    PixelMapComponent c => PixelMapTarget -> (Int -> Ptr c -> IO a) -> IO a
withPixelMapFor :: PixelMapTarget -> (Int -> Ptr c -> IO a) -> IO a
withPixelMapFor PixelMapTarget
target Int -> Ptr c -> IO a
f = do
    GLpixelmap c
theMap <- StateVar (GLpixelmap c) -> IO (GLpixelmap c)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get (PixelMapTarget -> StateVar (GLpixelmap c)
forall (m :: * -> *) c.
(PixelMap m, PixelMapComponent c) =>
PixelMapTarget -> StateVar (m c)
pixelMap PixelMapTarget
target)
    GLpixelmap c -> (Int -> Ptr c -> IO a) -> IO a
forall c a.
PixelMapComponent c =>
GLpixelmap c -> (Int -> Ptr c -> IO a) -> IO a
withGLpixelmap GLpixelmap c
theMap Int -> Ptr c -> IO a
f

withGLpixelmap :: PixelMapComponent c
               => GLpixelmap c -> (Int -> Ptr c -> IO a) -> IO a
withGLpixelmap :: GLpixelmap c -> (Int -> Ptr c -> IO a) -> IO a
withGLpixelmap = GLpixelmap c -> (Int -> Ptr c -> IO a) -> IO a
forall (m :: * -> *) c a.
(PixelMap m, PixelMapComponent c) =>
m c -> (Int -> Ptr c -> IO a) -> IO a
withPixelMap

sample :: Storable a => Int -> Ptr a -> Int -> IO [a]
sample :: Int -> Ptr a -> Int -> IO [a]
sample Int
len Ptr a
ptr Int
newLen = GLfloat -> [a] -> IO [a]
f (Int -> GLfloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
newLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) []
   where scale :: Float
         scale :: GLfloat
scale = Int -> GLfloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/ Int -> GLfloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
newLen
         f :: GLfloat -> [a] -> IO [a]
f GLfloat
l [a]
acc | GLfloat
l GLfloat -> GLfloat -> Bool
forall a. Ord a => a -> a -> Bool
< GLfloat
0     = [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
acc
                 | Bool
otherwise = do a
e <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
ptr (GLfloat -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (GLfloat
l GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat
scale))
                                  GLfloat -> [a] -> IO [a]
f (GLfloat
l GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
1) (a
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)

setPixelMapXToY :: PixelMapComponent c
   => (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
   -> [Color4 c] -> IO ()
setPixelMapXToY :: (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)
-> [Color4 c] -> IO ()
setPixelMapXToY (PixelMapTarget
toR, PixelMapTarget
toG, PixelMapTarget
toB, PixelMapTarget
toA) [Color4 c]
colors = do
   (PixelMapTarget -> StateVar (GLpixelmap c)
forall (m :: * -> *) c.
(PixelMap m, PixelMapComponent c) =>
PixelMapTarget -> StateVar (m c)
pixelMap PixelMapTarget
toR StateVar (GLpixelmap c) -> GLpixelmap c -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=) (GLpixelmap c -> IO ()) -> IO (GLpixelmap c) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [c] -> IO (GLpixelmap c)
forall c. PixelMapComponent c => [c] -> IO (GLpixelmap c)
newGLpixelmap [ c
r | Color4 c
r c
_ c
_ c
_ <- [Color4 c]
colors ]
   (PixelMapTarget -> StateVar (GLpixelmap c)
forall (m :: * -> *) c.
(PixelMap m, PixelMapComponent c) =>
PixelMapTarget -> StateVar (m c)
pixelMap PixelMapTarget
toG StateVar (GLpixelmap c) -> GLpixelmap c -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=) (GLpixelmap c -> IO ()) -> IO (GLpixelmap c) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [c] -> IO (GLpixelmap c)
forall c. PixelMapComponent c => [c] -> IO (GLpixelmap c)
newGLpixelmap [ c
g | Color4 c
_ c
g c
_ c
_ <- [Color4 c]
colors ]
   (PixelMapTarget -> StateVar (GLpixelmap c)
forall (m :: * -> *) c.
(PixelMap m, PixelMapComponent c) =>
PixelMapTarget -> StateVar (m c)
pixelMap PixelMapTarget
toB StateVar (GLpixelmap c) -> GLpixelmap c -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=) (GLpixelmap c -> IO ()) -> IO (GLpixelmap c) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [c] -> IO (GLpixelmap c)
forall c. PixelMapComponent c => [c] -> IO (GLpixelmap c)
newGLpixelmap [ c
b | Color4 c
_ c
_ c
b c
_ <- [Color4 c]
colors ]
   (PixelMapTarget -> StateVar (GLpixelmap c)
forall (m :: * -> *) c.
(PixelMap m, PixelMapComponent c) =>
PixelMapTarget -> StateVar (m c)
pixelMap PixelMapTarget
toA StateVar (GLpixelmap c) -> GLpixelmap c -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=) (GLpixelmap c -> IO ()) -> IO (GLpixelmap c) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [c] -> IO (GLpixelmap c)
forall c. PixelMapComponent c => [c] -> IO (GLpixelmap c)
newGLpixelmap [ c
a | Color4 c
_ c
_ c
_ c
a <- [Color4 c]
colors ]

newGLpixelmap :: PixelMapComponent c => [c] -> IO (GLpixelmap c)
newGLpixelmap :: [c] -> IO (GLpixelmap c)
newGLpixelmap = [c] -> IO (GLpixelmap c)
forall (m :: * -> *) c.
(PixelMap m, PixelMapComponent c) =>
[c] -> IO (m c)
newPixelMap