{-# 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
$c== :: PixelMapTarget -> PixelMapTarget -> Bool
== :: PixelMapTarget -> PixelMapTarget -> Bool
$c/= :: PixelMapTarget -> PixelMapTarget -> Bool
/= :: 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
$ccompare :: PixelMapTarget -> PixelMapTarget -> Ordering
compare :: PixelMapTarget -> PixelMapTarget -> Ordering
$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
>= :: PixelMapTarget -> PixelMapTarget -> Bool
$cmax :: PixelMapTarget -> PixelMapTarget -> PixelMapTarget
max :: PixelMapTarget -> PixelMapTarget -> PixelMapTarget
$cmin :: PixelMapTarget -> PixelMapTarget -> PixelMapTarget
min :: PixelMapTarget -> PixelMapTarget -> 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
$cshowsPrec :: Int -> PixelMapTarget -> ShowS
showsPrec :: Int -> PixelMapTarget -> ShowS
$cshow :: PixelMapTarget -> String
show :: PixelMapTarget -> String
$cshowList :: [PixelMapTarget] -> ShowS
showList :: [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 GLint
maxPixelMapTable = 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
$ (GLint -> GLint) -> PName1I -> GettableStateVar GLint
forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
forall a. (GLint -> a) -> PName1I -> IO a
getSizei1 GLint -> GLint
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 -> GLint -> Ptr GLushort -> IO ()
pixelMapv = GLenum -> GLint -> Ptr GLushort -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> 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 -> GLint -> Ptr GLenum -> IO ()
pixelMapv = GLenum -> GLint -> Ptr GLenum -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> 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 -> GLint -> Ptr GLfloat -> IO ()
pixelMapv = GLenum -> GLint -> Ptr GLfloat -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> 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 c. PixelMapComponent c => [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 c. PixelMapComponent c => 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 c.
PixelMapComponent c =>
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 a. [a] -> 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 c a.
PixelMapComponent c =>
m 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 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
$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
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
$ccompare :: forall a. GLpixelmap a -> GLpixelmap a -> Ordering
compare :: GLpixelmap a -> GLpixelmap a -> Ordering
$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
>= :: GLpixelmap a -> GLpixelmap a -> Bool
$cmax :: forall a. GLpixelmap a -> GLpixelmap a -> GLpixelmap a
max :: GLpixelmap a -> GLpixelmap a -> GLpixelmap a
$cmin :: forall a. GLpixelmap a -> GLpixelmap a -> GLpixelmap a
min :: GLpixelmap a -> GLpixelmap a -> 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
$cshowsPrec :: forall a. Int -> GLpixelmap a -> ShowS
showsPrec :: Int -> GLpixelmap a -> ShowS
$cshow :: forall a. GLpixelmap a -> String
show :: GLpixelmap a -> String
$cshowList :: forall a. [GLpixelmap a] -> ShowS
showList :: [GLpixelmap a] -> ShowS
Show )
instance PixelMap GLpixelmap where
withNewPixelMap :: forall c.
PixelMapComponent c =>
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 a. a -> IO a
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 :: forall c a.
PixelMapComponent c =>
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 :: forall (m :: * -> *) c.
(PixelMap m, PixelMapComponent c) =>
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 c.
PixelMapComponent c =>
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 c a.
PixelMapComponent c =>
m 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 m c
theMap ((Int -> Ptr c -> IO ()) -> IO ())
-> (Int -> Ptr c -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLenum -> GLint -> Ptr c -> IO ()
forall c. PixelMapComponent c => GLenum -> GLint -> Ptr c -> IO ()
pixelMapv (PixelMapTarget -> GLenum
marshalPixelMapTarget PixelMapTarget
pm) (GLint -> Ptr c -> IO ())
-> (Int -> GLint) -> Int -> Ptr c -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
pixelMapSize :: PixelMapTarget -> IO Int
pixelMapSize :: PixelMapTarget -> IO Int
pixelMapSize = (GLint -> Int) -> PName1I -> IO Int
forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
forall a. (GLint -> a) -> PName1I -> IO a
getInteger1 GLint -> 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
pixelMapIToRGBA :: PixelMapComponent c => StateVar [Color4 c]
pixelMapIToRGBA :: forall c. PixelMapComponent c => 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)
pixelMapRGBAToRGBA :: PixelMapComponent c => StateVar [Color4 c]
pixelMapRGBAToRGBA :: forall c. PixelMapComponent c => 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 :: forall c.
PixelMapComponent c =>
(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 :: forall c.
PixelMapComponent c =>
(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 a. a -> IO a
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 :: forall c a.
PixelMapComponent c =>
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
forall (m :: * -> *).
MonadIO m =>
StateVar (GLpixelmap c) -> m (GLpixelmap c)
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 :: forall c a.
PixelMapComponent c =>
GLpixelmap c -> (Int -> Ptr c -> IO a) -> IO a
withGLpixelmap = GLpixelmap c -> (Int -> Ptr c -> IO a) -> IO a
forall c a.
PixelMapComponent c =>
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 :: forall a. Storable a => 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 a. 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 b. Integral b => GLfloat -> b
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 :: forall c.
PixelMapComponent c =>
(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 ()
forall (m :: * -> *).
MonadIO m =>
StateVar (GLpixelmap c) -> GLpixelmap c -> 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 ()
forall (m :: * -> *).
MonadIO m =>
StateVar (GLpixelmap c) -> GLpixelmap c -> 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 ()
forall (m :: * -> *).
MonadIO m =>
StateVar (GLpixelmap c) -> GLpixelmap c -> 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 ()
forall (m :: * -> *).
MonadIO m =>
StateVar (GLpixelmap c) -> GLpixelmap c -> 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 :: forall c. PixelMapComponent c => [c] -> IO (GLpixelmap c)
newGLpixelmap = [c] -> IO (GLpixelmap c)
forall c. PixelMapComponent c => [c] -> IO (GLpixelmap c)
forall (m :: * -> *) c.
(PixelMap m, PixelMapComponent c) =>
[c] -> IO (m c)
newPixelMap