{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BlockArguments, LambdaCase #-}
{-# LANGUAGE TypeApplications, PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Data.CairoImage.Internal (
	-- * Class Image and ImageMut
	Image(..), ImageMut(..),
	-- * Type CairoImage and CairoImageMut
	CairoImage(..), CairoImageMut(..), cairoImageFreeze, cairoImageThaw,
	-- * Image Format
	-- ** ARGB 32
	PixelArgb32(..),
	pattern PixelArgb32Premultiplied, pixelArgb32Premultiplied,
	pattern PixelArgb32Straight,
	pattern CairoImageArgb32, Argb32,
	pattern CairoImageMutArgb32, Argb32Mut,
	-- ** RGB 24
	PixelRgb24(..), pattern PixelRgb24,
	pattern CairoImageRgb24, Rgb24,
	pattern CairoImageMutRgb24, Rgb24Mut,
	-- ** A 8
	PixelA8(..),
	pattern CairoImageA8, A8,
	pattern CairoImageMutA8, A8Mut,
	-- ** A 1
	PixelA1(..), Bit(..), bit,
	pattern CairoImageA1, A1,
	pattern CairoImageMutA1, A1Mut,
	-- ** RGB 16 565
	PixelRgb16_565(..), pattern PixelRgb16_565,
	pattern CairoImageRgb16_565, Rgb16_565,
	pattern CairoImageMutRgb16_565, Rgb16_565Mut,
	-- ** RGB 30
	PixelRgb30(..), pattern PixelRgb30,
	pattern CairoImageRgb30, Rgb30,
	pattern CairoImageMutRgb30, Rgb30Mut,

	-- * CairoFormatT
	CairoFormatT(..),
	pattern CairoFormatArgb32, pattern CairoFormatRgb24,
	pattern CairoFormatA8, pattern CairoFormatA1,
	pattern CairoFormatRgb16_565, pattern CairoFormatRgb30 ) where

import Foreign.Ptr (Ptr, castPtr, plusPtr)
import Foreign.ForeignPtr (ForeignPtr, castForeignPtr)
import Foreign.Concurrent (newForeignPtr)
import Foreign.Marshal (mallocBytes, free, copyBytes)
import Foreign.Storable (Storable, peek, poke)
import Foreign.C.Types (CInt(..), CUChar)
import Control.Monad.Primitive (
	PrimMonad(..), PrimBase, unsafeIOToPrim, unsafePrimToIO )
import Control.Monad.ST (runST)
import Data.Foldable (for_)
import Data.List (foldl1')
import Data.Bool (bool)
import Data.Bits ((.|.), testBit, clearBit, setBit, shiftL, shiftR)
import Data.Word (Word8, Word16, Word32)
import Data.CairoImage.Parts
import System.IO.Unsafe (unsafePerformIO)
import System.TargetEndian (endian)

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

-- * CLASS IMAGE AND IMAGE MUTABLE
-- * TYPE CAIRO IMAGE AND CAIRO IMAGE MUTABLE
-- * ARGB 32
--	+ PIXEL
--	+ IMAGE
--	+ IMAGE MUTABLE
-- * RGB 24
--	+ PIXEL
--	+ IMAGE
--	+ IMAGE MUTABLE
-- * A 8
--	+ PIXEL
--	+ IMAGE
--	+ IMAGE MUTABLE
-- * A 1
--	+ PIXEL
--	+ IMAGE
--	+ IMAGE MUTABLE
-- * RGB 16 565
--	+ PIXEL
--	+ IMAGE
--	+ IMAGE MUTABLE
-- * RGB 30
--	+ PIXEL
--	+ IMAGE
--	+ IMAGE MUTABLE
-- * COMMON

---------------------------------------------------------------------------
-- CLASS IMAGE AND IMAGE MUTABLE
---------------------------------------------------------------------------

class Image i where
	type Pixel i
	imageSize :: i -> (CInt, CInt)
	pixelAt :: i -> CInt -> CInt -> Maybe (Pixel i)
	generateImage :: CInt -> CInt -> (CInt -> CInt -> Pixel i) -> i
	generateImagePrimM :: PrimBase m =>
		CInt -> CInt -> (CInt -> CInt -> m (Pixel i)) -> m i

	generateImage CInt
w CInt
h CInt -> CInt -> Pixel i
f =
		(forall s. ST s i) -> i
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s i) -> i) -> (forall s. ST s i) -> i
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> (CInt -> CInt -> ST s (Pixel i)) -> ST s i
forall i (m :: * -> *).
(Image i, PrimBase m) =>
CInt -> CInt -> (CInt -> CInt -> m (Pixel i)) -> m i
forall (m :: * -> *).
PrimBase m =>
CInt -> CInt -> (CInt -> CInt -> m (Pixel i)) -> m i
generateImagePrimM CInt
w CInt
h \CInt
x CInt
y -> Pixel i -> ST s (Pixel i)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pixel i -> ST s (Pixel i)) -> Pixel i -> ST s (Pixel i)
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> Pixel i
f CInt
x CInt
y

class ImageMut im where
	type PixelMut im
	imageMutSize :: im s -> (CInt, CInt)
	getPixel :: PrimMonad m =>
		im (PrimState m) -> CInt -> CInt -> m (Maybe (PixelMut im))
	putPixel :: PrimMonad m =>
		im (PrimState m) -> CInt -> CInt -> PixelMut im -> m ()
	newImageMut :: PrimMonad m => CInt -> CInt -> m (im (PrimState m))

---------------------------------------------------------------------------
-- TYPE CAIRO IMAGE AND CAIRO IMAGE MUTABLE
---------------------------------------------------------------------------

data CairoImage = CairoImage {
	CairoImage -> CairoFormatT
cairoImageFormat :: CairoFormatT,
	CairoImage -> CInt
cairoImageWidth :: CInt, CairoImage -> CInt
cairoImageHeight :: CInt,
	CairoImage -> CInt
cairoImageStride :: CInt, CairoImage -> ForeignPtr CUChar
cairoImageData :: ForeignPtr CUChar }
	deriving Int -> CairoImage -> ShowS
[CairoImage] -> ShowS
CairoImage -> String
(Int -> CairoImage -> ShowS)
-> (CairoImage -> String)
-> ([CairoImage] -> ShowS)
-> Show CairoImage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CairoImage -> ShowS
showsPrec :: Int -> CairoImage -> ShowS
$cshow :: CairoImage -> String
show :: CairoImage -> String
$cshowList :: [CairoImage] -> ShowS
showList :: [CairoImage] -> ShowS
Show

instance Eq CairoImage where
	CairoImage
ci1 == :: CairoImage -> CairoImage -> Bool
== CairoImage
ci2 = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [
		CairoFormatT
fmt1 CairoFormatT -> CairoFormatT -> Bool
forall a. Eq a => a -> a -> Bool
== CairoFormatT
fmt2, CInt
w1 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
w2, CInt
h1 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
h2, CInt
str1 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
str2,
		IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> (Ptr CUChar -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr CUChar
fd1 \Ptr CUChar
d1 -> ForeignPtr CUChar -> (Ptr CUChar -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr CUChar
fd2 \Ptr CUChar
d2 ->
			(Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==) (Ordering -> Bool) -> IO Ordering -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CUChar -> Ptr CUChar -> CInt -> IO Ordering
forall n a. (Ord n, Num n) => Ptr a -> Ptr a -> n -> IO Ordering
compareBytes Ptr CUChar
d1 Ptr CUChar
d2 (CInt
str1 CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* CInt
h1) ]
		where
		[CairoFormatT
fmt1, CairoFormatT
fmt2] = CairoImage -> CairoFormatT
cairoImageFormat (CairoImage -> CairoFormatT) -> [CairoImage] -> [CairoFormatT]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CairoImage
ci1, CairoImage
ci2]
		[CInt
w1, CInt
w2] = CairoImage -> CInt
cairoImageWidth (CairoImage -> CInt) -> [CairoImage] -> [CInt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CairoImage
ci1, CairoImage
ci2]
		[CInt
h1, CInt
h2] = CairoImage -> CInt
cairoImageHeight (CairoImage -> CInt) -> [CairoImage] -> [CInt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CairoImage
ci1, CairoImage
ci2]
		[CInt
str1, CInt
str2] = CairoImage -> CInt
cairoImageStride (CairoImage -> CInt) -> [CairoImage] -> [CInt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CairoImage
ci1, CairoImage
ci2]
		[ForeignPtr CUChar
fd1, ForeignPtr CUChar
fd2] = CairoImage -> ForeignPtr CUChar
cairoImageData (CairoImage -> ForeignPtr CUChar)
-> [CairoImage] -> [ForeignPtr CUChar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CairoImage
ci1, CairoImage
ci2]

compareBytes :: (Ord n, Num n) => Ptr a -> Ptr a -> n -> IO Ordering
compareBytes :: forall n a. (Ord n, Num n) => Ptr a -> Ptr a -> n -> IO Ordering
compareBytes Ptr a
_ Ptr a
_ n
n | n
n n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
1 = Ordering -> IO Ordering
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
EQ
compareBytes Ptr a
p1 Ptr a
p2 n
_ | Ptr a
p1 Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
p2 = Ordering -> IO Ordering
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
EQ
compareBytes Ptr a
p1 Ptr a
p2 n
n = Word8 -> Word8 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word8 -> Word8 -> Ordering) -> IO Word8 -> IO (Word8 -> Ordering)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
pb1 IO (Word8 -> Ordering) -> IO Word8 -> IO Ordering
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
pb2 IO Ordering -> (Ordering -> IO Ordering) -> IO Ordering
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
	Ordering
EQ -> Ptr a -> Ptr a -> n -> IO Ordering
forall n a. (Ord n, Num n) => Ptr a -> Ptr a -> n -> IO Ordering
compareBytes Ptr a
p1 Ptr a
p2 (n
n n -> n -> n
forall a. Num a => a -> a -> a
- n
1); Ordering
o -> Ordering -> IO Ordering
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
o
	where [Ptr Word8
pb1, Ptr Word8
pb2] = Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr (Ptr a -> Ptr Word8) -> [Ptr a] -> [Ptr Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ptr a
p1, Ptr a
p2] :: [Ptr Word8]

data CairoImageMut s = CairoImageMut {
	forall s. CairoImageMut s -> CairoFormatT
cairoImageMutFormat :: CairoFormatT,
	forall s. CairoImageMut s -> CInt
cairoImageMutWidth :: CInt, forall s. CairoImageMut s -> CInt
cairoImageMutHeight :: CInt,
	forall s. CairoImageMut s -> CInt
cairoImageMutStride :: CInt, forall s. CairoImageMut s -> ForeignPtr CUChar
cairoImageMutData :: ForeignPtr CUChar }
	deriving Int -> CairoImageMut s -> ShowS
[CairoImageMut s] -> ShowS
CairoImageMut s -> String
(Int -> CairoImageMut s -> ShowS)
-> (CairoImageMut s -> String)
-> ([CairoImageMut s] -> ShowS)
-> Show (CairoImageMut s)
forall s. Int -> CairoImageMut s -> ShowS
forall s. [CairoImageMut s] -> ShowS
forall s. CairoImageMut s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Int -> CairoImageMut s -> ShowS
showsPrec :: Int -> CairoImageMut s -> ShowS
$cshow :: forall s. CairoImageMut s -> String
show :: CairoImageMut s -> String
$cshowList :: forall s. [CairoImageMut s] -> ShowS
showList :: [CairoImageMut s] -> ShowS
Show

cairoImageFreeze :: PrimMonad m => CairoImageMut (PrimState m) -> m CairoImage
cairoImageFreeze :: forall (m :: * -> *).
PrimMonad m =>
CairoImageMut (PrimState m) -> m CairoImage
cairoImageFreeze CairoImageMut (PrimState m)
im = IO CairoImage -> m CairoImage
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO CairoImage -> m CairoImage) -> IO CairoImage -> m CairoImage
forall a b. (a -> b) -> a -> b
$ CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImage
CairoImage CairoFormatT
f CInt
w CInt
h CInt
st (ForeignPtr CUChar -> CairoImage)
-> IO (ForeignPtr CUChar) -> IO CairoImage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> ForeignPtr CUChar -> IO (ForeignPtr CUChar)
cidClone CInt
st CInt
h ForeignPtr CUChar
dt
	where
	f :: CairoFormatT
f = CairoImageMut (PrimState m) -> CairoFormatT
forall s. CairoImageMut s -> CairoFormatT
cairoImageMutFormat CairoImageMut (PrimState m)
im
	w :: CInt
w = CairoImageMut (PrimState m) -> CInt
forall s. CairoImageMut s -> CInt
cairoImageMutWidth CairoImageMut (PrimState m)
im; h :: CInt
h = CairoImageMut (PrimState m) -> CInt
forall s. CairoImageMut s -> CInt
cairoImageMutHeight CairoImageMut (PrimState m)
im
	st :: CInt
st = CairoImageMut (PrimState m) -> CInt
forall s. CairoImageMut s -> CInt
cairoImageMutStride CairoImageMut (PrimState m)
im; dt :: ForeignPtr CUChar
dt = CairoImageMut (PrimState m) -> ForeignPtr CUChar
forall s. CairoImageMut s -> ForeignPtr CUChar
cairoImageMutData CairoImageMut (PrimState m)
im

cairoImageThaw :: PrimMonad m => CairoImage -> m (CairoImageMut (PrimState m))
cairoImageThaw :: forall (m :: * -> *).
PrimMonad m =>
CairoImage -> m (CairoImageMut (PrimState m))
cairoImageThaw CairoImage
i = IO (CairoImageMut (PrimState m)) -> m (CairoImageMut (PrimState m))
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO (CairoImageMut (PrimState m))
 -> m (CairoImageMut (PrimState m)))
-> IO (CairoImageMut (PrimState m))
-> m (CairoImageMut (PrimState m))
forall a b. (a -> b) -> a -> b
$ CairoFormatT
-> CInt
-> CInt
-> CInt
-> ForeignPtr CUChar
-> CairoImageMut (PrimState m)
forall s.
CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImageMut s
CairoImageMut CairoFormatT
f CInt
w CInt
h CInt
st (ForeignPtr CUChar -> CairoImageMut (PrimState m))
-> IO (ForeignPtr CUChar) -> IO (CairoImageMut (PrimState m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> ForeignPtr CUChar -> IO (ForeignPtr CUChar)
cidClone CInt
st CInt
h ForeignPtr CUChar
dt
	where
	f :: CairoFormatT
f = CairoImage -> CairoFormatT
cairoImageFormat CairoImage
i
	w :: CInt
w = CairoImage -> CInt
cairoImageWidth CairoImage
i; h :: CInt
h = CairoImage -> CInt
cairoImageHeight CairoImage
i
	st :: CInt
st = CairoImage -> CInt
cairoImageStride CairoImage
i; dt :: ForeignPtr CUChar
dt = CairoImage -> ForeignPtr CUChar
cairoImageData CairoImage
i

cidClone :: CInt -> CInt -> ForeignPtr CUChar -> IO (ForeignPtr CUChar)
cidClone :: CInt -> CInt -> ForeignPtr CUChar -> IO (ForeignPtr CUChar)
cidClone CInt
st CInt
h ForeignPtr CUChar
fd = ForeignPtr CUChar
-> (Ptr CUChar -> IO (ForeignPtr CUChar)) -> IO (ForeignPtr CUChar)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr CUChar
fd \Ptr CUChar
d -> Int -> IO (Ptr CUChar)
forall a. Int -> IO (Ptr a)
mallocBytes Int
n IO (Ptr CUChar)
-> (Ptr CUChar -> IO (ForeignPtr CUChar)) -> IO (ForeignPtr CUChar)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr CUChar
d' ->
	Ptr CUChar -> Ptr CUChar -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr CUChar
d' Ptr CUChar
d Int
n IO () -> IO (ForeignPtr CUChar) -> IO (ForeignPtr CUChar)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr CUChar -> IO () -> IO (ForeignPtr CUChar)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr Ptr CUChar
d' (Ptr CUChar -> IO ()
forall a. Ptr a -> IO ()
free Ptr CUChar
d')
	where n :: Int
n = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ CInt
st CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* CInt
h

---------------------------------------------------------------------------
-- ARGB 32
---------------------------------------------------------------------------

-- PIXEL

newtype PixelArgb32 = PixelArgb32Word32 Word32 deriving (Int -> PixelArgb32 -> ShowS
[PixelArgb32] -> ShowS
PixelArgb32 -> String
(Int -> PixelArgb32 -> ShowS)
-> (PixelArgb32 -> String)
-> ([PixelArgb32] -> ShowS)
-> Show PixelArgb32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PixelArgb32 -> ShowS
showsPrec :: Int -> PixelArgb32 -> ShowS
$cshow :: PixelArgb32 -> String
show :: PixelArgb32 -> String
$cshowList :: [PixelArgb32] -> ShowS
showList :: [PixelArgb32] -> ShowS
Show, Ptr PixelArgb32 -> IO PixelArgb32
Ptr PixelArgb32 -> Int -> IO PixelArgb32
Ptr PixelArgb32 -> Int -> PixelArgb32 -> IO ()
Ptr PixelArgb32 -> PixelArgb32 -> IO ()
PixelArgb32 -> Int
(PixelArgb32 -> Int)
-> (PixelArgb32 -> Int)
-> (Ptr PixelArgb32 -> Int -> IO PixelArgb32)
-> (Ptr PixelArgb32 -> Int -> PixelArgb32 -> IO ())
-> (forall b. Ptr b -> Int -> IO PixelArgb32)
-> (forall b. Ptr b -> Int -> PixelArgb32 -> IO ())
-> (Ptr PixelArgb32 -> IO PixelArgb32)
-> (Ptr PixelArgb32 -> PixelArgb32 -> IO ())
-> Storable PixelArgb32
forall b. Ptr b -> Int -> IO PixelArgb32
forall b. Ptr b -> Int -> PixelArgb32 -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: PixelArgb32 -> Int
sizeOf :: PixelArgb32 -> Int
$calignment :: PixelArgb32 -> Int
alignment :: PixelArgb32 -> Int
$cpeekElemOff :: Ptr PixelArgb32 -> Int -> IO PixelArgb32
peekElemOff :: Ptr PixelArgb32 -> Int -> IO PixelArgb32
$cpokeElemOff :: Ptr PixelArgb32 -> Int -> PixelArgb32 -> IO ()
pokeElemOff :: Ptr PixelArgb32 -> Int -> PixelArgb32 -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO PixelArgb32
peekByteOff :: forall b. Ptr b -> Int -> IO PixelArgb32
$cpokeByteOff :: forall b. Ptr b -> Int -> PixelArgb32 -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> PixelArgb32 -> IO ()
$cpeek :: Ptr PixelArgb32 -> IO PixelArgb32
peek :: Ptr PixelArgb32 -> IO PixelArgb32
$cpoke :: Ptr PixelArgb32 -> PixelArgb32 -> IO ()
poke :: Ptr PixelArgb32 -> PixelArgb32 -> IO ()
Storable)

{-# COMPLETE PixelArgb32Premultiplied #-}

pattern PixelArgb32Premultiplied ::
	Word8 -> Word8 -> Word8 -> Word8 -> PixelArgb32
pattern $mPixelArgb32Premultiplied :: forall {r}.
PixelArgb32
-> (Word8 -> Word8 -> Word8 -> Word8 -> r) -> ((# #) -> r) -> r
PixelArgb32Premultiplied a r g b <- (pixelArgb32ToArgb -> (a, r, g, b))

pixelArgb32Premultiplied ::
	Word8 -> Word8 -> Word8 -> Word8 -> Maybe PixelArgb32
pixelArgb32Premultiplied :: Word8 -> Word8 -> Word8 -> Word8 -> Maybe PixelArgb32
pixelArgb32Premultiplied Word8
a Word8
r Word8
g Word8
b
	| Word8
r Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
a, Word8
g Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
a, Word8
b Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
a = PixelArgb32 -> Maybe PixelArgb32
forall a. a -> Maybe a
Just (PixelArgb32 -> Maybe PixelArgb32)
-> PixelArgb32 -> Maybe PixelArgb32
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Word8 -> PixelArgb32
pixelArgb32FromArgb Word8
a Word8
r Word8
g Word8
b
	| Bool
otherwise = Maybe PixelArgb32
forall a. Maybe a
Nothing

pixelArgb32FromArgb :: Word8 -> Word8 -> Word8 -> Word8 -> PixelArgb32
pixelArgb32FromArgb :: Word8 -> Word8 -> Word8 -> Word8 -> PixelArgb32
pixelArgb32FromArgb
	(Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word32
a) (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word32
r)
	(Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word32
g) (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word32
b) = Word32 -> PixelArgb32
PixelArgb32Word32
	(Word32 -> PixelArgb32)
-> ([Word32] -> Word32) -> [Word32] -> PixelArgb32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32 -> Word32) -> [Word32] -> Word32
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
(.|.) ([Word32] -> PixelArgb32) -> [Word32] -> PixelArgb32
forall a b. (a -> b) -> a -> b
$ (Word32 -> Int -> Word32) -> [Word32] -> [Int] -> [Word32]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL [Word32
a, Word32
r, Word32
g, Word32
b] [Int
24, Int
16, Int
8, Int
0]

pixelArgb32ToArgb :: PixelArgb32 -> (Word8, Word8, Word8, Word8)
pixelArgb32ToArgb :: PixelArgb32 -> (Word8, Word8, Word8, Word8)
pixelArgb32ToArgb (PixelArgb32Word32 Word32
w) = (
	Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24, Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16,
	Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8, Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w )

{-# COMPLETE PixelArgb32Straight #-}

pattern PixelArgb32Straight :: Word8 -> Word8 -> Word8 -> Word8 -> PixelArgb32
pattern $bPixelArgb32Straight :: Word8 -> Word8 -> Word8 -> Word8 -> PixelArgb32
$mPixelArgb32Straight :: forall {r}.
PixelArgb32
-> (Word8 -> Word8 -> Word8 -> Word8 -> r) -> ((# #) -> r) -> r
PixelArgb32Straight a r g b <- (pixelArgb32ToArgbSt -> (a, r, g, b))
	where PixelArgb32Straight Word8
a Word8
r Word8
g Word8
b = Word8 -> Word8 -> Word8 -> Word8 -> PixelArgb32
pixelArgb32FromArgb
		Word8
a (Word8
r `unit` (Word8
a, Word8
0xff)) (Word8
g `unit` (Word8
a, Word8
0xff)) (Word8
b `unit` (Word8
a, Word8
0xff))

pixelArgb32ToArgbSt :: PixelArgb32 -> (Word8, Word8, Word8, Word8)
pixelArgb32ToArgbSt :: PixelArgb32 -> (Word8, Word8, Word8, Word8)
pixelArgb32ToArgbSt PixelArgb32
p = let (Word8
a, Word8
r, Word8
g, Word8
b) = PixelArgb32 -> (Word8, Word8, Word8, Word8)
pixelArgb32ToArgb PixelArgb32
p in
	(Word8
a, Word8
r `unit` (Word8
0xff, Word8
a), Word8
g `unit` (Word8
0xff, Word8
a), Word8
b `unit` (Word8
0xff, Word8
a))

unit :: Word8 -> (Word8, Word8) -> Word8
(Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word16
n) `unit` ((Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word16
m), (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word16
d)) =
	forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ Word16
n Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
m Word16 -> Word16 -> Word16
forall n. Integral n => n -> n -> n
`div'` Word16
d

infixl 7 `div'`

div' :: Integral n => n -> n -> n
div' :: forall n. Integral n => n -> n -> n
div' n
n = \case n
0 -> n
0; n
m -> n
n n -> n -> n
forall n. Integral n => n -> n -> n
`div` n
m

-- IMAGE

data Argb32 = Argb32 {
	Argb32 -> CInt
argb32Width :: CInt, Argb32 -> CInt
argb32Height :: CInt,
	Argb32 -> CInt
argb32Stride :: CInt, Argb32 -> ForeignPtr PixelArgb32
argb32Data :: ForeignPtr PixelArgb32 }
	deriving Int -> Argb32 -> ShowS
[Argb32] -> ShowS
Argb32 -> String
(Int -> Argb32 -> ShowS)
-> (Argb32 -> String) -> ([Argb32] -> ShowS) -> Show Argb32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Argb32 -> ShowS
showsPrec :: Int -> Argb32 -> ShowS
$cshow :: Argb32 -> String
show :: Argb32 -> String
$cshowList :: [Argb32] -> ShowS
showList :: [Argb32] -> ShowS
Show

pattern CairoImageArgb32 :: Argb32 -> CairoImage
pattern $bCairoImageArgb32 :: Argb32 -> CairoImage
$mCairoImageArgb32 :: forall {r}. CairoImage -> (Argb32 -> r) -> ((# #) -> r) -> r
CairoImageArgb32 a <- (cairoImageToArgb32 -> Just a) where
	CairoImageArgb32 (Argb32 CInt
w CInt
h CInt
s ForeignPtr PixelArgb32
d) =
		CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImage
CairoImage CairoFormatT
CairoFormatArgb32 CInt
w CInt
h CInt
s (ForeignPtr CUChar -> CairoImage)
-> ForeignPtr CUChar -> CairoImage
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelArgb32 -> ForeignPtr CUChar
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr PixelArgb32
d

cairoImageToArgb32 :: CairoImage -> Maybe Argb32
cairoImageToArgb32 :: CairoImage -> Maybe Argb32
cairoImageToArgb32 = \case
	CairoImage CairoFormatT
CairoFormatArgb32 CInt
w CInt
h CInt
s ForeignPtr CUChar
d ->
		Argb32 -> Maybe Argb32
forall a. a -> Maybe a
Just (Argb32 -> Maybe Argb32)
-> (ForeignPtr PixelArgb32 -> Argb32)
-> ForeignPtr PixelArgb32
-> Maybe Argb32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> ForeignPtr PixelArgb32 -> Argb32
Argb32 CInt
w CInt
h CInt
s (ForeignPtr PixelArgb32 -> Maybe Argb32)
-> ForeignPtr PixelArgb32 -> Maybe Argb32
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> ForeignPtr PixelArgb32
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CUChar
d
	CairoImage
_ -> Maybe Argb32
forall a. Maybe a
Nothing

instance Image Argb32 where
	type Pixel Argb32 = PixelArgb32
	imageSize :: Argb32 -> (CInt, CInt)
imageSize (Argb32 CInt
w CInt
h CInt
_ ForeignPtr PixelArgb32
_) = (CInt
w, CInt
h)
	pixelAt :: Argb32 -> CInt -> CInt -> Maybe (Pixel Argb32)
pixelAt (Argb32 CInt
w CInt
h CInt
s ForeignPtr PixelArgb32
d) CInt
x CInt
y = IO (Maybe (Pixel Argb32)) -> Maybe (Pixel Argb32)
forall a. IO a -> a
unsafePerformIO (IO (Maybe (Pixel Argb32)) -> Maybe (Pixel Argb32))
-> IO (Maybe (Pixel Argb32)) -> Maybe (Pixel Argb32)
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelArgb32
-> (Ptr PixelArgb32 -> IO (Maybe (Pixel Argb32)))
-> IO (Maybe (Pixel Argb32))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelArgb32
d \Ptr PixelArgb32
p ->
		IO (Maybe (Pixel Argb32))
-> (Ptr PixelArgb32 -> IO (Maybe (Pixel Argb32)))
-> Maybe (Ptr PixelArgb32)
-> IO (Maybe (Pixel Argb32))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe PixelArgb32 -> IO (Maybe PixelArgb32)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PixelArgb32
forall a. Maybe a
Nothing) ((PixelArgb32 -> Maybe PixelArgb32
forall a. a -> Maybe a
Just (PixelArgb32 -> Maybe PixelArgb32)
-> IO PixelArgb32 -> IO (Maybe PixelArgb32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO PixelArgb32 -> IO (Maybe PixelArgb32))
-> (Ptr PixelArgb32 -> IO PixelArgb32)
-> Ptr PixelArgb32
-> IO (Maybe PixelArgb32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PixelArgb32 -> IO PixelArgb32
forall a. Storable a => Ptr a -> IO a
peek) (Maybe (Ptr PixelArgb32) -> IO (Maybe (Pixel Argb32)))
-> Maybe (Ptr PixelArgb32) -> IO (Maybe (Pixel Argb32))
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr PixelArgb32
-> CInt
-> CInt
-> Maybe (Ptr PixelArgb32)
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr PixelArgb32
p CInt
x CInt
y
	generateImagePrimM :: forall (m :: * -> *).
PrimBase m =>
CInt -> CInt -> (CInt -> CInt -> m (Pixel Argb32)) -> m Argb32
generateImagePrimM CInt
w CInt
h CInt -> CInt -> m (Pixel Argb32)
f = CairoFormatT -> CInt -> m CInt
forall (m :: * -> *). PrimMonad m => CairoFormatT -> CInt -> m CInt
stride CairoFormatT
CairoFormatArgb32 CInt
w m CInt -> (CInt -> m Argb32) -> m Argb32
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
s ->
		CInt -> CInt -> CInt -> ForeignPtr PixelArgb32 -> Argb32
Argb32 CInt
w CInt
h CInt
s (ForeignPtr PixelArgb32 -> Argb32)
-> m (ForeignPtr PixelArgb32) -> m Argb32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt
-> CInt
-> CInt
-> (CInt -> CInt -> m PixelArgb32)
-> m (ForeignPtr PixelArgb32)
forall (m :: * -> *) a.
(PrimBase m, Storable a) =>
CInt -> CInt -> CInt -> (CInt -> CInt -> m a) -> m (ForeignPtr a)
gen CInt
w CInt
h CInt
s CInt -> CInt -> m (Pixel Argb32)
CInt -> CInt -> m PixelArgb32
f

-- IMAGE MUTABLE

data Argb32Mut s = Argb32Mut {
	forall s. Argb32Mut s -> CInt
argb32MutWidth :: CInt, forall s. Argb32Mut s -> CInt
argb32MutHeight :: CInt,
	forall s. Argb32Mut s -> CInt
argb32MutStride :: CInt, forall s. Argb32Mut s -> ForeignPtr PixelArgb32
argb32MutData :: ForeignPtr PixelArgb32 }
	deriving Int -> Argb32Mut s -> ShowS
[Argb32Mut s] -> ShowS
Argb32Mut s -> String
(Int -> Argb32Mut s -> ShowS)
-> (Argb32Mut s -> String)
-> ([Argb32Mut s] -> ShowS)
-> Show (Argb32Mut s)
forall s. Int -> Argb32Mut s -> ShowS
forall s. [Argb32Mut s] -> ShowS
forall s. Argb32Mut s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Int -> Argb32Mut s -> ShowS
showsPrec :: Int -> Argb32Mut s -> ShowS
$cshow :: forall s. Argb32Mut s -> String
show :: Argb32Mut s -> String
$cshowList :: forall s. [Argb32Mut s] -> ShowS
showList :: [Argb32Mut s] -> ShowS
Show

pattern CairoImageMutArgb32 :: Argb32Mut s -> CairoImageMut s
pattern $bCairoImageMutArgb32 :: forall s. Argb32Mut s -> CairoImageMut s
$mCairoImageMutArgb32 :: forall {r} {s}.
CairoImageMut s -> (Argb32Mut s -> r) -> ((# #) -> r) -> r
CairoImageMutArgb32 a <- (cairoImageMutToArgb32 -> Just a) where
	CairoImageMutArgb32 (Argb32Mut CInt
w CInt
h CInt
s ForeignPtr PixelArgb32
d) =
		CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImageMut s
forall s.
CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImageMut s
CairoImageMut CairoFormatT
CairoFormatArgb32 CInt
w CInt
h CInt
s (ForeignPtr CUChar -> CairoImageMut s)
-> ForeignPtr CUChar -> CairoImageMut s
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelArgb32 -> ForeignPtr CUChar
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr PixelArgb32
d

cairoImageMutToArgb32 :: CairoImageMut s -> Maybe (Argb32Mut s)
cairoImageMutToArgb32 :: forall s. CairoImageMut s -> Maybe (Argb32Mut s)
cairoImageMutToArgb32 = \case
	CairoImageMut CairoFormatT
CairoFormatArgb32 CInt
w CInt
h CInt
s ForeignPtr CUChar
d ->
		Argb32Mut s -> Maybe (Argb32Mut s)
forall a. a -> Maybe a
Just (Argb32Mut s -> Maybe (Argb32Mut s))
-> (ForeignPtr PixelArgb32 -> Argb32Mut s)
-> ForeignPtr PixelArgb32
-> Maybe (Argb32Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> ForeignPtr PixelArgb32 -> Argb32Mut s
forall s.
CInt -> CInt -> CInt -> ForeignPtr PixelArgb32 -> Argb32Mut s
Argb32Mut CInt
w CInt
h CInt
s (ForeignPtr PixelArgb32 -> Maybe (Argb32Mut s))
-> ForeignPtr PixelArgb32 -> Maybe (Argb32Mut s)
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> ForeignPtr PixelArgb32
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CUChar
d
	CairoImageMut s
_ -> Maybe (Argb32Mut s)
forall a. Maybe a
Nothing

instance ImageMut Argb32Mut where
	type PixelMut Argb32Mut = PixelArgb32
	imageMutSize :: forall s. Argb32Mut s -> (CInt, CInt)
imageMutSize (Argb32Mut CInt
w CInt
h CInt
_ ForeignPtr PixelArgb32
_) = (CInt
w, CInt
h)
	getPixel :: forall (m :: * -> *).
PrimMonad m =>
Argb32Mut (PrimState m)
-> CInt -> CInt -> m (Maybe (PixelMut Argb32Mut))
getPixel (Argb32Mut CInt
w CInt
h CInt
s ForeignPtr PixelArgb32
d) CInt
x CInt
y = IO (Maybe (PixelMut Argb32Mut)) -> m (Maybe (PixelMut Argb32Mut))
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO (Maybe (PixelMut Argb32Mut)) -> m (Maybe (PixelMut Argb32Mut)))
-> IO (Maybe (PixelMut Argb32Mut))
-> m (Maybe (PixelMut Argb32Mut))
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelArgb32
-> (Ptr PixelArgb32 -> IO (Maybe (PixelMut Argb32Mut)))
-> IO (Maybe (PixelMut Argb32Mut))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelArgb32
d \Ptr PixelArgb32
p ->
		IO (Maybe (PixelMut Argb32Mut))
-> (Ptr PixelArgb32 -> IO (Maybe (PixelMut Argb32Mut)))
-> Maybe (Ptr PixelArgb32)
-> IO (Maybe (PixelMut Argb32Mut))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe PixelArgb32 -> IO (Maybe PixelArgb32)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PixelArgb32
forall a. Maybe a
Nothing) ((PixelArgb32 -> Maybe PixelArgb32
forall a. a -> Maybe a
Just (PixelArgb32 -> Maybe PixelArgb32)
-> IO PixelArgb32 -> IO (Maybe PixelArgb32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO PixelArgb32 -> IO (Maybe PixelArgb32))
-> (Ptr PixelArgb32 -> IO PixelArgb32)
-> Ptr PixelArgb32
-> IO (Maybe PixelArgb32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PixelArgb32 -> IO PixelArgb32
forall a. Storable a => Ptr a -> IO a
peek) (Maybe (Ptr PixelArgb32) -> IO (Maybe (PixelMut Argb32Mut)))
-> Maybe (Ptr PixelArgb32) -> IO (Maybe (PixelMut Argb32Mut))
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr PixelArgb32
-> CInt
-> CInt
-> Maybe (Ptr PixelArgb32)
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr PixelArgb32
p CInt
x CInt
y
	putPixel :: forall (m :: * -> *).
PrimMonad m =>
Argb32Mut (PrimState m)
-> CInt -> CInt -> PixelMut Argb32Mut -> m ()
putPixel (Argb32Mut CInt
w CInt
h CInt
s ForeignPtr PixelArgb32
d) CInt
x CInt
y PixelMut Argb32Mut
px = IO () -> m ()
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelArgb32 -> (Ptr PixelArgb32 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelArgb32
d \Ptr PixelArgb32
p ->
		IO ()
-> (Ptr (PixelMut Argb32Mut) -> IO ())
-> Maybe (Ptr (PixelMut Argb32Mut))
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Ptr (PixelMut Argb32Mut) -> PixelMut Argb32Mut -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
`poke` PixelMut Argb32Mut
px) (Maybe (Ptr (PixelMut Argb32Mut)) -> IO ())
-> Maybe (Ptr (PixelMut Argb32Mut)) -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr (PixelMut Argb32Mut)
-> CInt
-> CInt
-> Maybe (Ptr (PixelMut Argb32Mut))
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr (PixelMut Argb32Mut)
Ptr PixelArgb32
p CInt
x CInt
y
	newImageMut :: forall (m :: * -> *).
PrimMonad m =>
CInt -> CInt -> m (Argb32Mut (PrimState m))
newImageMut CInt
w CInt
h =
		CairoFormatT -> CInt -> m CInt
forall (m :: * -> *). PrimMonad m => CairoFormatT -> CInt -> m CInt
stride CairoFormatT
CairoFormatArgb32 CInt
w m CInt
-> (CInt -> m (Argb32Mut (PrimState m)))
-> m (Argb32Mut (PrimState m))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
s -> CInt
-> CInt
-> CInt
-> ForeignPtr PixelArgb32
-> Argb32Mut (PrimState m)
forall s.
CInt -> CInt -> CInt -> ForeignPtr PixelArgb32 -> Argb32Mut s
Argb32Mut CInt
w CInt
h CInt
s (ForeignPtr PixelArgb32 -> Argb32Mut (PrimState m))
-> m (ForeignPtr PixelArgb32) -> m (Argb32Mut (PrimState m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> m (ForeignPtr PixelArgb32)
forall (m :: * -> *) a.
PrimMonad m =>
CInt -> CInt -> m (ForeignPtr a)
new CInt
s CInt
h

---------------------------------------------------------------------------
-- RGB 24
---------------------------------------------------------------------------

-- PIXEL

newtype PixelRgb24 = PixelRgb24Word32 Word32 deriving (Int -> PixelRgb24 -> ShowS
[PixelRgb24] -> ShowS
PixelRgb24 -> String
(Int -> PixelRgb24 -> ShowS)
-> (PixelRgb24 -> String)
-> ([PixelRgb24] -> ShowS)
-> Show PixelRgb24
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PixelRgb24 -> ShowS
showsPrec :: Int -> PixelRgb24 -> ShowS
$cshow :: PixelRgb24 -> String
show :: PixelRgb24 -> String
$cshowList :: [PixelRgb24] -> ShowS
showList :: [PixelRgb24] -> ShowS
Show, Ptr PixelRgb24 -> IO PixelRgb24
Ptr PixelRgb24 -> Int -> IO PixelRgb24
Ptr PixelRgb24 -> Int -> PixelRgb24 -> IO ()
Ptr PixelRgb24 -> PixelRgb24 -> IO ()
PixelRgb24 -> Int
(PixelRgb24 -> Int)
-> (PixelRgb24 -> Int)
-> (Ptr PixelRgb24 -> Int -> IO PixelRgb24)
-> (Ptr PixelRgb24 -> Int -> PixelRgb24 -> IO ())
-> (forall b. Ptr b -> Int -> IO PixelRgb24)
-> (forall b. Ptr b -> Int -> PixelRgb24 -> IO ())
-> (Ptr PixelRgb24 -> IO PixelRgb24)
-> (Ptr PixelRgb24 -> PixelRgb24 -> IO ())
-> Storable PixelRgb24
forall b. Ptr b -> Int -> IO PixelRgb24
forall b. Ptr b -> Int -> PixelRgb24 -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: PixelRgb24 -> Int
sizeOf :: PixelRgb24 -> Int
$calignment :: PixelRgb24 -> Int
alignment :: PixelRgb24 -> Int
$cpeekElemOff :: Ptr PixelRgb24 -> Int -> IO PixelRgb24
peekElemOff :: Ptr PixelRgb24 -> Int -> IO PixelRgb24
$cpokeElemOff :: Ptr PixelRgb24 -> Int -> PixelRgb24 -> IO ()
pokeElemOff :: Ptr PixelRgb24 -> Int -> PixelRgb24 -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO PixelRgb24
peekByteOff :: forall b. Ptr b -> Int -> IO PixelRgb24
$cpokeByteOff :: forall b. Ptr b -> Int -> PixelRgb24 -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> PixelRgb24 -> IO ()
$cpeek :: Ptr PixelRgb24 -> IO PixelRgb24
peek :: Ptr PixelRgb24 -> IO PixelRgb24
$cpoke :: Ptr PixelRgb24 -> PixelRgb24 -> IO ()
poke :: Ptr PixelRgb24 -> PixelRgb24 -> IO ()
Storable)

{-# COMPLETE PixelRgb24 #-}

pattern PixelRgb24 :: Word8 -> Word8 -> Word8 -> PixelRgb24
pattern $bPixelRgb24 :: Word8 -> Word8 -> Word8 -> PixelRgb24
$mPixelRgb24 :: forall {r}.
PixelRgb24 -> (Word8 -> Word8 -> Word8 -> r) -> ((# #) -> r) -> r
PixelRgb24 r g b <- (pixelRgb24ToRgb -> (r, g, b)) where
	PixelRgb24 (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word32
r) (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word32
g) (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word32
b) =
		Word32 -> PixelRgb24
PixelRgb24Word32
			(Word32 -> PixelRgb24)
-> ([Word32] -> Word32) -> [Word32] -> PixelRgb24
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32 -> Word32) -> [Word32] -> Word32
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
(.|.) ([Word32] -> PixelRgb24) -> [Word32] -> PixelRgb24
forall a b. (a -> b) -> a -> b
$ (Word32 -> Int -> Word32) -> [Word32] -> [Int] -> [Word32]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL [Word32
r, Word32
g, Word32
b] [Int
16, Int
8, Int
0]

pixelRgb24ToRgb :: PixelRgb24 -> (Word8, Word8, Word8)
pixelRgb24ToRgb :: PixelRgb24 -> (Word8, Word8, Word8)
pixelRgb24ToRgb (PixelRgb24Word32 Word32
w) = (
	Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16,
	Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8, Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w )

-- IMAGE

data Rgb24 = Rgb24 {
	Rgb24 -> CInt
rgb24Width :: CInt, Rgb24 -> CInt
rgb24Height :: CInt,
	Rgb24 -> CInt
rgb24Stride :: CInt, Rgb24 -> ForeignPtr PixelRgb24
rgb24Data :: ForeignPtr PixelRgb24 }
	deriving Int -> Rgb24 -> ShowS
[Rgb24] -> ShowS
Rgb24 -> String
(Int -> Rgb24 -> ShowS)
-> (Rgb24 -> String) -> ([Rgb24] -> ShowS) -> Show Rgb24
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rgb24 -> ShowS
showsPrec :: Int -> Rgb24 -> ShowS
$cshow :: Rgb24 -> String
show :: Rgb24 -> String
$cshowList :: [Rgb24] -> ShowS
showList :: [Rgb24] -> ShowS
Show

pattern CairoImageRgb24 :: Rgb24 -> CairoImage
pattern $bCairoImageRgb24 :: Rgb24 -> CairoImage
$mCairoImageRgb24 :: forall {r}. CairoImage -> (Rgb24 -> r) -> ((# #) -> r) -> r
CairoImageRgb24 r <- (cairoImageToRgb24 -> Just r) where
	CairoImageRgb24 (Rgb24 CInt
w CInt
h CInt
s ForeignPtr PixelRgb24
d) =
		CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImage
CairoImage CairoFormatT
CairoFormatRgb24 CInt
w CInt
h CInt
s (ForeignPtr CUChar -> CairoImage)
-> ForeignPtr CUChar -> CairoImage
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelRgb24 -> ForeignPtr CUChar
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr PixelRgb24
d

cairoImageToRgb24 :: CairoImage -> Maybe Rgb24
cairoImageToRgb24 :: CairoImage -> Maybe Rgb24
cairoImageToRgb24 = \case
	CairoImage CairoFormatT
CairoFormatRgb24 CInt
w CInt
h CInt
s ForeignPtr CUChar
d ->
		Rgb24 -> Maybe Rgb24
forall a. a -> Maybe a
Just (Rgb24 -> Maybe Rgb24)
-> (ForeignPtr PixelRgb24 -> Rgb24)
-> ForeignPtr PixelRgb24
-> Maybe Rgb24
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> ForeignPtr PixelRgb24 -> Rgb24
Rgb24 CInt
w CInt
h CInt
s (ForeignPtr PixelRgb24 -> Maybe Rgb24)
-> ForeignPtr PixelRgb24 -> Maybe Rgb24
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> ForeignPtr PixelRgb24
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CUChar
d
	CairoImage
_ -> Maybe Rgb24
forall a. Maybe a
Nothing

instance Image Rgb24 where
	type Pixel Rgb24 = PixelRgb24
	imageSize :: Rgb24 -> (CInt, CInt)
imageSize (Rgb24 CInt
w CInt
h CInt
_ ForeignPtr PixelRgb24
_) = (CInt
w, CInt
h)
	pixelAt :: Rgb24 -> CInt -> CInt -> Maybe (Pixel Rgb24)
pixelAt (Rgb24 CInt
w CInt
h CInt
s ForeignPtr PixelRgb24
d) CInt
x CInt
y = IO (Maybe (Pixel Rgb24)) -> Maybe (Pixel Rgb24)
forall a. IO a -> a
unsafePerformIO (IO (Maybe (Pixel Rgb24)) -> Maybe (Pixel Rgb24))
-> IO (Maybe (Pixel Rgb24)) -> Maybe (Pixel Rgb24)
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelRgb24
-> (Ptr PixelRgb24 -> IO (Maybe (Pixel Rgb24)))
-> IO (Maybe (Pixel Rgb24))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelRgb24
d \Ptr PixelRgb24
p ->
		IO (Maybe (Pixel Rgb24))
-> (Ptr PixelRgb24 -> IO (Maybe (Pixel Rgb24)))
-> Maybe (Ptr PixelRgb24)
-> IO (Maybe (Pixel Rgb24))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe PixelRgb24 -> IO (Maybe PixelRgb24)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PixelRgb24
forall a. Maybe a
Nothing) ((PixelRgb24 -> Maybe PixelRgb24
forall a. a -> Maybe a
Just (PixelRgb24 -> Maybe PixelRgb24)
-> IO PixelRgb24 -> IO (Maybe PixelRgb24)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO PixelRgb24 -> IO (Maybe PixelRgb24))
-> (Ptr PixelRgb24 -> IO PixelRgb24)
-> Ptr PixelRgb24
-> IO (Maybe PixelRgb24)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PixelRgb24 -> IO PixelRgb24
forall a. Storable a => Ptr a -> IO a
peek) (Maybe (Ptr PixelRgb24) -> IO (Maybe (Pixel Rgb24)))
-> Maybe (Ptr PixelRgb24) -> IO (Maybe (Pixel Rgb24))
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr PixelRgb24
-> CInt
-> CInt
-> Maybe (Ptr PixelRgb24)
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr PixelRgb24
p CInt
x CInt
y
	generateImagePrimM :: forall (m :: * -> *).
PrimBase m =>
CInt -> CInt -> (CInt -> CInt -> m (Pixel Rgb24)) -> m Rgb24
generateImagePrimM CInt
w CInt
h CInt -> CInt -> m (Pixel Rgb24)
f =
		CairoFormatT -> CInt -> m CInt
forall (m :: * -> *). PrimMonad m => CairoFormatT -> CInt -> m CInt
stride CairoFormatT
CairoFormatRgb24 CInt
w m CInt -> (CInt -> m Rgb24) -> m Rgb24
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
s -> CInt -> CInt -> CInt -> ForeignPtr PixelRgb24 -> Rgb24
Rgb24 CInt
w CInt
h CInt
s (ForeignPtr PixelRgb24 -> Rgb24)
-> m (ForeignPtr PixelRgb24) -> m Rgb24
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt
-> CInt
-> CInt
-> (CInt -> CInt -> m PixelRgb24)
-> m (ForeignPtr PixelRgb24)
forall (m :: * -> *) a.
(PrimBase m, Storable a) =>
CInt -> CInt -> CInt -> (CInt -> CInt -> m a) -> m (ForeignPtr a)
gen CInt
w CInt
h CInt
s CInt -> CInt -> m (Pixel Rgb24)
CInt -> CInt -> m PixelRgb24
f

-- IMAGE MUTABLE

data Rgb24Mut s = Rgb24Mut {
	forall s. Rgb24Mut s -> CInt
rgb24MutWidth :: CInt, forall s. Rgb24Mut s -> CInt
rgb24MutHeight :: CInt,
	forall s. Rgb24Mut s -> CInt
rgb24MutStride :: CInt, forall s. Rgb24Mut s -> ForeignPtr PixelRgb24
rgb24MutData :: ForeignPtr PixelRgb24 }
	deriving Int -> Rgb24Mut s -> ShowS
[Rgb24Mut s] -> ShowS
Rgb24Mut s -> String
(Int -> Rgb24Mut s -> ShowS)
-> (Rgb24Mut s -> String)
-> ([Rgb24Mut s] -> ShowS)
-> Show (Rgb24Mut s)
forall s. Int -> Rgb24Mut s -> ShowS
forall s. [Rgb24Mut s] -> ShowS
forall s. Rgb24Mut s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Int -> Rgb24Mut s -> ShowS
showsPrec :: Int -> Rgb24Mut s -> ShowS
$cshow :: forall s. Rgb24Mut s -> String
show :: Rgb24Mut s -> String
$cshowList :: forall s. [Rgb24Mut s] -> ShowS
showList :: [Rgb24Mut s] -> ShowS
Show

pattern CairoImageMutRgb24 :: Rgb24Mut s -> CairoImageMut s
pattern $bCairoImageMutRgb24 :: forall s. Rgb24Mut s -> CairoImageMut s
$mCairoImageMutRgb24 :: forall {r} {s}.
CairoImageMut s -> (Rgb24Mut s -> r) -> ((# #) -> r) -> r
CairoImageMutRgb24 r <- (cairoImageMutToRgb24 -> Just r) where
	CairoImageMutRgb24 (Rgb24Mut CInt
w CInt
h CInt
s ForeignPtr PixelRgb24
d) =
		CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImageMut s
forall s.
CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImageMut s
CairoImageMut CairoFormatT
CairoFormatRgb24 CInt
w CInt
h CInt
s (ForeignPtr CUChar -> CairoImageMut s)
-> ForeignPtr CUChar -> CairoImageMut s
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelRgb24 -> ForeignPtr CUChar
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr PixelRgb24
d

cairoImageMutToRgb24 :: CairoImageMut s -> Maybe (Rgb24Mut s)
cairoImageMutToRgb24 :: forall s. CairoImageMut s -> Maybe (Rgb24Mut s)
cairoImageMutToRgb24 = \case
	CairoImageMut CairoFormatT
CairoFormatRgb24 CInt
w CInt
h CInt
s ForeignPtr CUChar
d ->
		Rgb24Mut s -> Maybe (Rgb24Mut s)
forall a. a -> Maybe a
Just (Rgb24Mut s -> Maybe (Rgb24Mut s))
-> (ForeignPtr PixelRgb24 -> Rgb24Mut s)
-> ForeignPtr PixelRgb24
-> Maybe (Rgb24Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> ForeignPtr PixelRgb24 -> Rgb24Mut s
forall s.
CInt -> CInt -> CInt -> ForeignPtr PixelRgb24 -> Rgb24Mut s
Rgb24Mut CInt
w CInt
h CInt
s (ForeignPtr PixelRgb24 -> Maybe (Rgb24Mut s))
-> ForeignPtr PixelRgb24 -> Maybe (Rgb24Mut s)
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> ForeignPtr PixelRgb24
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CUChar
d
	CairoImageMut s
_ -> Maybe (Rgb24Mut s)
forall a. Maybe a
Nothing

instance ImageMut Rgb24Mut where
	type PixelMut Rgb24Mut = PixelRgb24
	imageMutSize :: forall s. Rgb24Mut s -> (CInt, CInt)
imageMutSize (Rgb24Mut CInt
w CInt
h CInt
_ ForeignPtr PixelRgb24
_) = (CInt
w, CInt
h)
	getPixel :: forall (m :: * -> *).
PrimMonad m =>
Rgb24Mut (PrimState m)
-> CInt -> CInt -> m (Maybe (PixelMut Rgb24Mut))
getPixel (Rgb24Mut CInt
w CInt
h CInt
s ForeignPtr PixelRgb24
d) CInt
x CInt
y = IO (Maybe (PixelMut Rgb24Mut)) -> m (Maybe (PixelMut Rgb24Mut))
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO (Maybe (PixelMut Rgb24Mut)) -> m (Maybe (PixelMut Rgb24Mut)))
-> IO (Maybe (PixelMut Rgb24Mut)) -> m (Maybe (PixelMut Rgb24Mut))
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelRgb24
-> (Ptr PixelRgb24 -> IO (Maybe (PixelMut Rgb24Mut)))
-> IO (Maybe (PixelMut Rgb24Mut))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelRgb24
d \Ptr PixelRgb24
p ->
		IO (Maybe (PixelMut Rgb24Mut))
-> (Ptr PixelRgb24 -> IO (Maybe (PixelMut Rgb24Mut)))
-> Maybe (Ptr PixelRgb24)
-> IO (Maybe (PixelMut Rgb24Mut))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe PixelRgb24 -> IO (Maybe PixelRgb24)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PixelRgb24
forall a. Maybe a
Nothing) ((PixelRgb24 -> Maybe PixelRgb24
forall a. a -> Maybe a
Just (PixelRgb24 -> Maybe PixelRgb24)
-> IO PixelRgb24 -> IO (Maybe PixelRgb24)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO PixelRgb24 -> IO (Maybe PixelRgb24))
-> (Ptr PixelRgb24 -> IO PixelRgb24)
-> Ptr PixelRgb24
-> IO (Maybe PixelRgb24)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PixelRgb24 -> IO PixelRgb24
forall a. Storable a => Ptr a -> IO a
peek) (Maybe (Ptr PixelRgb24) -> IO (Maybe (PixelMut Rgb24Mut)))
-> Maybe (Ptr PixelRgb24) -> IO (Maybe (PixelMut Rgb24Mut))
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr PixelRgb24
-> CInt
-> CInt
-> Maybe (Ptr PixelRgb24)
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr PixelRgb24
p CInt
x CInt
y
	putPixel :: forall (m :: * -> *).
PrimMonad m =>
Rgb24Mut (PrimState m) -> CInt -> CInt -> PixelMut Rgb24Mut -> m ()
putPixel (Rgb24Mut CInt
w CInt
h CInt
s ForeignPtr PixelRgb24
d) CInt
x CInt
y PixelMut Rgb24Mut
px = IO () -> m ()
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelRgb24 -> (Ptr PixelRgb24 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelRgb24
d \Ptr PixelRgb24
p ->
		IO ()
-> (Ptr (PixelMut Rgb24Mut) -> IO ())
-> Maybe (Ptr (PixelMut Rgb24Mut))
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Ptr (PixelMut Rgb24Mut) -> PixelMut Rgb24Mut -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
`poke` PixelMut Rgb24Mut
px) (Maybe (Ptr (PixelMut Rgb24Mut)) -> IO ())
-> Maybe (Ptr (PixelMut Rgb24Mut)) -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr (PixelMut Rgb24Mut)
-> CInt
-> CInt
-> Maybe (Ptr (PixelMut Rgb24Mut))
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr (PixelMut Rgb24Mut)
Ptr PixelRgb24
p CInt
x CInt
y
	newImageMut :: forall (m :: * -> *).
PrimMonad m =>
CInt -> CInt -> m (Rgb24Mut (PrimState m))
newImageMut CInt
w CInt
h =
		CairoFormatT -> CInt -> m CInt
forall (m :: * -> *). PrimMonad m => CairoFormatT -> CInt -> m CInt
stride CairoFormatT
CairoFormatRgb24 CInt
w m CInt
-> (CInt -> m (Rgb24Mut (PrimState m)))
-> m (Rgb24Mut (PrimState m))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
s -> CInt
-> CInt -> CInt -> ForeignPtr PixelRgb24 -> Rgb24Mut (PrimState m)
forall s.
CInt -> CInt -> CInt -> ForeignPtr PixelRgb24 -> Rgb24Mut s
Rgb24Mut CInt
w CInt
h CInt
s (ForeignPtr PixelRgb24 -> Rgb24Mut (PrimState m))
-> m (ForeignPtr PixelRgb24) -> m (Rgb24Mut (PrimState m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> m (ForeignPtr PixelRgb24)
forall (m :: * -> *) a.
PrimMonad m =>
CInt -> CInt -> m (ForeignPtr a)
new CInt
s CInt
h

---------------------------------------------------------------------------
-- A 8
---------------------------------------------------------------------------

-- PIXEL

newtype PixelA8 = PixelA8 Word8 deriving (Int -> PixelA8 -> ShowS
[PixelA8] -> ShowS
PixelA8 -> String
(Int -> PixelA8 -> ShowS)
-> (PixelA8 -> String) -> ([PixelA8] -> ShowS) -> Show PixelA8
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PixelA8 -> ShowS
showsPrec :: Int -> PixelA8 -> ShowS
$cshow :: PixelA8 -> String
show :: PixelA8 -> String
$cshowList :: [PixelA8] -> ShowS
showList :: [PixelA8] -> ShowS
Show, Ptr PixelA8 -> IO PixelA8
Ptr PixelA8 -> Int -> IO PixelA8
Ptr PixelA8 -> Int -> PixelA8 -> IO ()
Ptr PixelA8 -> PixelA8 -> IO ()
PixelA8 -> Int
(PixelA8 -> Int)
-> (PixelA8 -> Int)
-> (Ptr PixelA8 -> Int -> IO PixelA8)
-> (Ptr PixelA8 -> Int -> PixelA8 -> IO ())
-> (forall b. Ptr b -> Int -> IO PixelA8)
-> (forall b. Ptr b -> Int -> PixelA8 -> IO ())
-> (Ptr PixelA8 -> IO PixelA8)
-> (Ptr PixelA8 -> PixelA8 -> IO ())
-> Storable PixelA8
forall b. Ptr b -> Int -> IO PixelA8
forall b. Ptr b -> Int -> PixelA8 -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: PixelA8 -> Int
sizeOf :: PixelA8 -> Int
$calignment :: PixelA8 -> Int
alignment :: PixelA8 -> Int
$cpeekElemOff :: Ptr PixelA8 -> Int -> IO PixelA8
peekElemOff :: Ptr PixelA8 -> Int -> IO PixelA8
$cpokeElemOff :: Ptr PixelA8 -> Int -> PixelA8 -> IO ()
pokeElemOff :: Ptr PixelA8 -> Int -> PixelA8 -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO PixelA8
peekByteOff :: forall b. Ptr b -> Int -> IO PixelA8
$cpokeByteOff :: forall b. Ptr b -> Int -> PixelA8 -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> PixelA8 -> IO ()
$cpeek :: Ptr PixelA8 -> IO PixelA8
peek :: Ptr PixelA8 -> IO PixelA8
$cpoke :: Ptr PixelA8 -> PixelA8 -> IO ()
poke :: Ptr PixelA8 -> PixelA8 -> IO ()
Storable)

-- IMAGE

data A8 = A8 {
	A8 -> CInt
a8Width :: CInt, A8 -> CInt
a8Height :: CInt,
	A8 -> CInt
a8Stride :: CInt, A8 -> ForeignPtr PixelA8
a8Data :: ForeignPtr PixelA8 }
	deriving Int -> A8 -> ShowS
[A8] -> ShowS
A8 -> String
(Int -> A8 -> ShowS)
-> (A8 -> String) -> ([A8] -> ShowS) -> Show A8
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> A8 -> ShowS
showsPrec :: Int -> A8 -> ShowS
$cshow :: A8 -> String
show :: A8 -> String
$cshowList :: [A8] -> ShowS
showList :: [A8] -> ShowS
Show

pattern CairoImageA8 :: A8 -> CairoImage
pattern $bCairoImageA8 :: A8 -> CairoImage
$mCairoImageA8 :: forall {r}. CairoImage -> (A8 -> r) -> ((# #) -> r) -> r
CairoImageA8 a <- (cairoImageToA8 -> Just a)
	where CairoImageA8 (A8 CInt
w CInt
h CInt
s ForeignPtr PixelA8
d) =
		CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImage
CairoImage CairoFormatT
CairoFormatA8 CInt
w CInt
h CInt
s (ForeignPtr CUChar -> CairoImage)
-> ForeignPtr CUChar -> CairoImage
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelA8 -> ForeignPtr CUChar
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr PixelA8
d

cairoImageToA8 :: CairoImage -> Maybe A8
cairoImageToA8 :: CairoImage -> Maybe A8
cairoImageToA8 = \case
	CairoImage CairoFormatT
CairoFormatA8 CInt
w CInt
h CInt
s ForeignPtr CUChar
d -> A8 -> Maybe A8
forall a. a -> Maybe a
Just (A8 -> Maybe A8)
-> (ForeignPtr PixelA8 -> A8) -> ForeignPtr PixelA8 -> Maybe A8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> ForeignPtr PixelA8 -> A8
A8 CInt
w CInt
h CInt
s (ForeignPtr PixelA8 -> Maybe A8) -> ForeignPtr PixelA8 -> Maybe A8
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> ForeignPtr PixelA8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CUChar
d
	CairoImage
_ -> Maybe A8
forall a. Maybe a
Nothing

instance Image A8 where
	type Pixel A8 = PixelA8
	imageSize :: A8 -> (CInt, CInt)
imageSize (A8 CInt
w CInt
h CInt
_ ForeignPtr PixelA8
_) = (CInt
w, CInt
h)
	pixelAt :: A8 -> CInt -> CInt -> Maybe (Pixel A8)
pixelAt (A8 CInt
w CInt
h CInt
s ForeignPtr PixelA8
d) CInt
x CInt
y = IO (Maybe (Pixel A8)) -> Maybe (Pixel A8)
forall a. IO a -> a
unsafePerformIO (IO (Maybe (Pixel A8)) -> Maybe (Pixel A8))
-> IO (Maybe (Pixel A8)) -> Maybe (Pixel A8)
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelA8
-> (Ptr PixelA8 -> IO (Maybe (Pixel A8))) -> IO (Maybe (Pixel A8))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelA8
d \Ptr PixelA8
p ->
		IO (Maybe (Pixel A8))
-> (Ptr PixelA8 -> IO (Maybe (Pixel A8)))
-> Maybe (Ptr PixelA8)
-> IO (Maybe (Pixel A8))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe PixelA8 -> IO (Maybe PixelA8)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PixelA8
forall a. Maybe a
Nothing) ((PixelA8 -> Maybe PixelA8
forall a. a -> Maybe a
Just (PixelA8 -> Maybe PixelA8) -> IO PixelA8 -> IO (Maybe PixelA8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO PixelA8 -> IO (Maybe PixelA8))
-> (Ptr PixelA8 -> IO PixelA8) -> Ptr PixelA8 -> IO (Maybe PixelA8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PixelA8 -> IO PixelA8
forall a. Storable a => Ptr a -> IO a
peek) (Maybe (Ptr PixelA8) -> IO (Maybe (Pixel A8)))
-> Maybe (Ptr PixelA8) -> IO (Maybe (Pixel A8))
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr PixelA8
-> CInt
-> CInt
-> Maybe (Ptr PixelA8)
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr PixelA8
p CInt
x CInt
y
	generateImagePrimM :: forall (m :: * -> *).
PrimBase m =>
CInt -> CInt -> (CInt -> CInt -> m (Pixel A8)) -> m A8
generateImagePrimM CInt
w CInt
h CInt -> CInt -> m (Pixel A8)
f =
		CairoFormatT -> CInt -> m CInt
forall (m :: * -> *). PrimMonad m => CairoFormatT -> CInt -> m CInt
stride CairoFormatT
CairoFormatA8 CInt
w m CInt -> (CInt -> m A8) -> m A8
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
s -> CInt -> CInt -> CInt -> ForeignPtr PixelA8 -> A8
A8 CInt
w CInt
h CInt
s (ForeignPtr PixelA8 -> A8) -> m (ForeignPtr PixelA8) -> m A8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt
-> CInt
-> CInt
-> (CInt -> CInt -> m PixelA8)
-> m (ForeignPtr PixelA8)
forall (m :: * -> *) a.
(PrimBase m, Storable a) =>
CInt -> CInt -> CInt -> (CInt -> CInt -> m a) -> m (ForeignPtr a)
gen CInt
w CInt
h CInt
s CInt -> CInt -> m (Pixel A8)
CInt -> CInt -> m PixelA8
f

-- IMAGE MUTABLE

data A8Mut s = A8Mut {
	forall s. A8Mut s -> CInt
a8MutWidth :: CInt, forall s. A8Mut s -> CInt
a8MutHeight :: CInt,
	forall s. A8Mut s -> CInt
a8MutStride :: CInt, forall s. A8Mut s -> ForeignPtr PixelA8
a8MutData :: ForeignPtr PixelA8 }
	deriving Int -> A8Mut s -> ShowS
[A8Mut s] -> ShowS
A8Mut s -> String
(Int -> A8Mut s -> ShowS)
-> (A8Mut s -> String) -> ([A8Mut s] -> ShowS) -> Show (A8Mut s)
forall s. Int -> A8Mut s -> ShowS
forall s. [A8Mut s] -> ShowS
forall s. A8Mut s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Int -> A8Mut s -> ShowS
showsPrec :: Int -> A8Mut s -> ShowS
$cshow :: forall s. A8Mut s -> String
show :: A8Mut s -> String
$cshowList :: forall s. [A8Mut s] -> ShowS
showList :: [A8Mut s] -> ShowS
Show

pattern CairoImageMutA8 :: A8Mut s -> CairoImageMut s
pattern $bCairoImageMutA8 :: forall s. A8Mut s -> CairoImageMut s
$mCairoImageMutA8 :: forall {r} {s}.
CairoImageMut s -> (A8Mut s -> r) -> ((# #) -> r) -> r
CairoImageMutA8 a <- (cairoImageMutToA8 -> Just a)
	where CairoImageMutA8 (A8Mut CInt
w CInt
h CInt
s ForeignPtr PixelA8
d) =
		CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImageMut s
forall s.
CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImageMut s
CairoImageMut CairoFormatT
CairoFormatA8 CInt
w CInt
h CInt
s (ForeignPtr CUChar -> CairoImageMut s)
-> ForeignPtr CUChar -> CairoImageMut s
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelA8 -> ForeignPtr CUChar
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr PixelA8
d

cairoImageMutToA8 :: CairoImageMut s -> Maybe (A8Mut s)
cairoImageMutToA8 :: forall s. CairoImageMut s -> Maybe (A8Mut s)
cairoImageMutToA8 = \case
	CairoImageMut CairoFormatT
CairoFormatA8 CInt
w CInt
h CInt
s ForeignPtr CUChar
d ->
		A8Mut s -> Maybe (A8Mut s)
forall a. a -> Maybe a
Just (A8Mut s -> Maybe (A8Mut s))
-> (ForeignPtr PixelA8 -> A8Mut s)
-> ForeignPtr PixelA8
-> Maybe (A8Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> ForeignPtr PixelA8 -> A8Mut s
forall s. CInt -> CInt -> CInt -> ForeignPtr PixelA8 -> A8Mut s
A8Mut CInt
w CInt
h CInt
s (ForeignPtr PixelA8 -> Maybe (A8Mut s))
-> ForeignPtr PixelA8 -> Maybe (A8Mut s)
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> ForeignPtr PixelA8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CUChar
d
	CairoImageMut s
_ -> Maybe (A8Mut s)
forall a. Maybe a
Nothing

instance ImageMut A8Mut where
	type PixelMut A8Mut = PixelA8
	imageMutSize :: forall s. A8Mut s -> (CInt, CInt)
imageMutSize (A8Mut CInt
w CInt
h CInt
_ ForeignPtr PixelA8
_) = (CInt
w, CInt
h)
	getPixel :: forall (m :: * -> *).
PrimMonad m =>
A8Mut (PrimState m) -> CInt -> CInt -> m (Maybe (PixelMut A8Mut))
getPixel (A8Mut CInt
w CInt
h CInt
s ForeignPtr PixelA8
d) CInt
x CInt
y = IO (Maybe (PixelMut A8Mut)) -> m (Maybe (PixelMut A8Mut))
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO (Maybe (PixelMut A8Mut)) -> m (Maybe (PixelMut A8Mut)))
-> IO (Maybe (PixelMut A8Mut)) -> m (Maybe (PixelMut A8Mut))
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelA8
-> (Ptr PixelA8 -> IO (Maybe (PixelMut A8Mut)))
-> IO (Maybe (PixelMut A8Mut))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelA8
d \Ptr PixelA8
p ->
		IO (Maybe (PixelMut A8Mut))
-> (Ptr PixelA8 -> IO (Maybe (PixelMut A8Mut)))
-> Maybe (Ptr PixelA8)
-> IO (Maybe (PixelMut A8Mut))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe PixelA8 -> IO (Maybe PixelA8)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PixelA8
forall a. Maybe a
Nothing) ((PixelA8 -> Maybe PixelA8
forall a. a -> Maybe a
Just (PixelA8 -> Maybe PixelA8) -> IO PixelA8 -> IO (Maybe PixelA8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO PixelA8 -> IO (Maybe PixelA8))
-> (Ptr PixelA8 -> IO PixelA8) -> Ptr PixelA8 -> IO (Maybe PixelA8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PixelA8 -> IO PixelA8
forall a. Storable a => Ptr a -> IO a
peek) (Maybe (Ptr PixelA8) -> IO (Maybe (PixelMut A8Mut)))
-> Maybe (Ptr PixelA8) -> IO (Maybe (PixelMut A8Mut))
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr PixelA8
-> CInt
-> CInt
-> Maybe (Ptr PixelA8)
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr PixelA8
p CInt
x CInt
y
	putPixel :: forall (m :: * -> *).
PrimMonad m =>
A8Mut (PrimState m) -> CInt -> CInt -> PixelMut A8Mut -> m ()
putPixel (A8Mut CInt
w CInt
h CInt
s ForeignPtr PixelA8
d) CInt
x CInt
y PixelMut A8Mut
px = IO () -> m ()
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelA8 -> (Ptr PixelA8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelA8
d \Ptr PixelA8
p ->
		IO ()
-> (Ptr (PixelMut A8Mut) -> IO ())
-> Maybe (Ptr (PixelMut A8Mut))
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Ptr (PixelMut A8Mut) -> PixelMut A8Mut -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
`poke` PixelMut A8Mut
px) (Maybe (Ptr (PixelMut A8Mut)) -> IO ())
-> Maybe (Ptr (PixelMut A8Mut)) -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr (PixelMut A8Mut)
-> CInt
-> CInt
-> Maybe (Ptr (PixelMut A8Mut))
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr (PixelMut A8Mut)
Ptr PixelA8
p CInt
x CInt
y
	newImageMut :: forall (m :: * -> *).
PrimMonad m =>
CInt -> CInt -> m (A8Mut (PrimState m))
newImageMut CInt
w CInt
h =
		CairoFormatT -> CInt -> m CInt
forall (m :: * -> *). PrimMonad m => CairoFormatT -> CInt -> m CInt
stride CairoFormatT
CairoFormatA8 CInt
w m CInt
-> (CInt -> m (A8Mut (PrimState m))) -> m (A8Mut (PrimState m))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
s -> CInt -> CInt -> CInt -> ForeignPtr PixelA8 -> A8Mut (PrimState m)
forall s. CInt -> CInt -> CInt -> ForeignPtr PixelA8 -> A8Mut s
A8Mut CInt
w CInt
h CInt
s (ForeignPtr PixelA8 -> A8Mut (PrimState m))
-> m (ForeignPtr PixelA8) -> m (A8Mut (PrimState m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> m (ForeignPtr PixelA8)
forall (m :: * -> *) a.
PrimMonad m =>
CInt -> CInt -> m (ForeignPtr a)
new CInt
s CInt
h

---------------------------------------------------------------------------
-- A 1
---------------------------------------------------------------------------

-- PIXEL

newtype PixelA1 = PixelA1 Bit deriving Int -> PixelA1 -> ShowS
[PixelA1] -> ShowS
PixelA1 -> String
(Int -> PixelA1 -> ShowS)
-> (PixelA1 -> String) -> ([PixelA1] -> ShowS) -> Show PixelA1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PixelA1 -> ShowS
showsPrec :: Int -> PixelA1 -> ShowS
$cshow :: PixelA1 -> String
show :: PixelA1 -> String
$cshowList :: [PixelA1] -> ShowS
showList :: [PixelA1] -> ShowS
Show

data Bit = O | I deriving (Int -> Bit -> ShowS
[Bit] -> ShowS
Bit -> String
(Int -> Bit -> ShowS)
-> (Bit -> String) -> ([Bit] -> ShowS) -> Show Bit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bit -> ShowS
showsPrec :: Int -> Bit -> ShowS
$cshow :: Bit -> String
show :: Bit -> String
$cshowList :: [Bit] -> ShowS
showList :: [Bit] -> ShowS
Show, Int -> Bit
Bit -> Int
Bit -> [Bit]
Bit -> Bit
Bit -> Bit -> [Bit]
Bit -> Bit -> Bit -> [Bit]
(Bit -> Bit)
-> (Bit -> Bit)
-> (Int -> Bit)
-> (Bit -> Int)
-> (Bit -> [Bit])
-> (Bit -> Bit -> [Bit])
-> (Bit -> Bit -> [Bit])
-> (Bit -> Bit -> Bit -> [Bit])
-> Enum Bit
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Bit -> Bit
succ :: Bit -> Bit
$cpred :: Bit -> Bit
pred :: Bit -> Bit
$ctoEnum :: Int -> Bit
toEnum :: Int -> Bit
$cfromEnum :: Bit -> Int
fromEnum :: Bit -> Int
$cenumFrom :: Bit -> [Bit]
enumFrom :: Bit -> [Bit]
$cenumFromThen :: Bit -> Bit -> [Bit]
enumFromThen :: Bit -> Bit -> [Bit]
$cenumFromTo :: Bit -> Bit -> [Bit]
enumFromTo :: Bit -> Bit -> [Bit]
$cenumFromThenTo :: Bit -> Bit -> Bit -> [Bit]
enumFromThenTo :: Bit -> Bit -> Bit -> [Bit]
Enum)

bit :: a -> a -> Bit -> a
bit :: forall a. a -> a -> Bit -> a
bit a
x a
y = \case Bit
O -> a
x; Bit
I -> a
y

ptrA1 :: CInt -> CInt -> CInt ->
	Ptr PixelA1 -> CInt -> CInt -> Maybe (Ptr PixelA1, CInt)
ptrA1 :: CInt
-> CInt
-> CInt
-> Ptr PixelA1
-> CInt
-> CInt
-> Maybe (Ptr PixelA1, CInt)
ptrA1 CInt
w CInt
h CInt
s Ptr PixelA1
p CInt
x CInt
y
	| CInt
0 CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<= CInt
x Bool -> Bool -> Bool
&& CInt
x CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
w Bool -> Bool -> Bool
&& CInt
0 CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<= CInt
y Bool -> Bool -> Bool
&& CInt
y CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
h = (Ptr PixelA1, CInt) -> Maybe (Ptr PixelA1, CInt)
forall a. a -> Maybe a
Just
		(Ptr PixelA1
p Ptr PixelA1 -> Int -> Ptr PixelA1
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt
y CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* CInt
s CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
x CInt -> CInt -> CInt
forall n. Integral n => n -> n -> n
`div` CInt
32 CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* CInt
4), CInt
x CInt -> CInt -> CInt
forall n. Integral n => n -> n -> n
`mod` CInt
32)
	| Bool
otherwise = Maybe (Ptr PixelA1, CInt)
forall a. Maybe a
Nothing

peA1 :: (Ptr PixelA1, CInt) -> IO PixelA1
peA1 :: (Ptr PixelA1, CInt) -> IO PixelA1
peA1 ((Ptr PixelA1 -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr -> Ptr Word32
p), (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> (CInt -> CInt) -> CInt -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. $(endian [e| id |] [e| (31 -) |]) -> Int
i)) =
	Bit -> PixelA1
PixelA1 (Bit -> PixelA1) -> (Word32 -> Bit) -> Word32 -> PixelA1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bit -> Bit -> Bool -> Bit
forall a. a -> a -> Bool -> a
bool Bit
O Bit
I (Bool -> Bit) -> (Word32 -> Bool) -> Word32 -> Bit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
i) (Word32 -> PixelA1) -> IO Word32 -> IO PixelA1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek @Word32 Ptr Word32
p

poA1 :: (Ptr PixelA1, CInt) -> PixelA1 -> IO ()
poA1 :: (Ptr PixelA1, CInt) -> PixelA1 -> IO ()
poA1 ((Ptr PixelA1 -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr -> Ptr Word32
p), (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> (CInt -> CInt) -> CInt -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. $(endian [e| id |] [e| (31 -) |]) -> Int
i))
	(PixelA1 Bit
b) = Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word32
p (Word32 -> IO ()) -> (Word32 -> Word32) -> Word32 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Int -> Word32) -> Int -> Word32 -> Word32
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Word32 -> Int -> Word32)
-> (Word32 -> Int -> Word32) -> Bit -> Word32 -> Int -> Word32
forall a. a -> a -> Bit -> a
bit Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
clearBit Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
setBit Bit
b) Int
i (Word32 -> IO ()) -> IO Word32 -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek @Word32 Ptr Word32
p

-- IMAGE

data A1 = A1 {
	A1 -> CInt
a1Width :: CInt, A1 -> CInt
a1Height :: CInt,
	A1 -> CInt
a1Stride :: CInt, A1 -> ForeignPtr PixelA1
a1Data :: ForeignPtr PixelA1 }
	deriving Int -> A1 -> ShowS
[A1] -> ShowS
A1 -> String
(Int -> A1 -> ShowS)
-> (A1 -> String) -> ([A1] -> ShowS) -> Show A1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> A1 -> ShowS
showsPrec :: Int -> A1 -> ShowS
$cshow :: A1 -> String
show :: A1 -> String
$cshowList :: [A1] -> ShowS
showList :: [A1] -> ShowS
Show

pattern CairoImageA1 :: A1 -> CairoImage
pattern $bCairoImageA1 :: A1 -> CairoImage
$mCairoImageA1 :: forall {r}. CairoImage -> (A1 -> r) -> ((# #) -> r) -> r
CairoImageA1 a <- (cairoImageToA1 -> Just a)
	where CairoImageA1 (A1 CInt
w CInt
h CInt
s ForeignPtr PixelA1
d) =
		CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImage
CairoImage CairoFormatT
CairoFormatA1 CInt
w CInt
h CInt
s (ForeignPtr CUChar -> CairoImage)
-> ForeignPtr CUChar -> CairoImage
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelA1 -> ForeignPtr CUChar
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr PixelA1
d

cairoImageToA1 :: CairoImage -> Maybe A1
cairoImageToA1 :: CairoImage -> Maybe A1
cairoImageToA1 = \case
	CairoImage CairoFormatT
CairoFormatA1 CInt
w CInt
h CInt
s ForeignPtr CUChar
d -> A1 -> Maybe A1
forall a. a -> Maybe a
Just (A1 -> Maybe A1)
-> (ForeignPtr PixelA1 -> A1) -> ForeignPtr PixelA1 -> Maybe A1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> ForeignPtr PixelA1 -> A1
A1 CInt
w CInt
h CInt
s (ForeignPtr PixelA1 -> Maybe A1) -> ForeignPtr PixelA1 -> Maybe A1
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> ForeignPtr PixelA1
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CUChar
d
	CairoImage
_ -> Maybe A1
forall a. Maybe a
Nothing

instance Image A1 where
	type Pixel A1 = PixelA1
	imageSize :: A1 -> (CInt, CInt)
imageSize (A1 CInt
w CInt
h CInt
_ ForeignPtr PixelA1
_) = (CInt
w, CInt
h)
	pixelAt :: A1 -> CInt -> CInt -> Maybe (Pixel A1)
pixelAt (A1 CInt
w CInt
h CInt
s ForeignPtr PixelA1
d) CInt
x CInt
y = IO (Maybe (Pixel A1)) -> Maybe (Pixel A1)
forall a. IO a -> a
unsafePerformIO (IO (Maybe (Pixel A1)) -> Maybe (Pixel A1))
-> IO (Maybe (Pixel A1)) -> Maybe (Pixel A1)
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelA1
-> (Ptr PixelA1 -> IO (Maybe (Pixel A1))) -> IO (Maybe (Pixel A1))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelA1
d \Ptr PixelA1
p ->
		IO (Maybe (Pixel A1))
-> ((Ptr PixelA1, CInt) -> IO (Maybe (Pixel A1)))
-> Maybe (Ptr PixelA1, CInt)
-> IO (Maybe (Pixel A1))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe PixelA1 -> IO (Maybe PixelA1)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PixelA1
forall a. Maybe a
Nothing) ((PixelA1 -> Maybe PixelA1
forall a. a -> Maybe a
Just (PixelA1 -> Maybe PixelA1) -> IO PixelA1 -> IO (Maybe PixelA1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO PixelA1 -> IO (Maybe PixelA1))
-> ((Ptr PixelA1, CInt) -> IO PixelA1)
-> (Ptr PixelA1, CInt)
-> IO (Maybe PixelA1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr PixelA1, CInt) -> IO PixelA1
peA1) (Maybe (Ptr PixelA1, CInt) -> IO (Maybe (Pixel A1)))
-> Maybe (Ptr PixelA1, CInt) -> IO (Maybe (Pixel A1))
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr PixelA1
-> CInt
-> CInt
-> Maybe (Ptr PixelA1, CInt)
ptrA1 CInt
w CInt
h CInt
s Ptr PixelA1
p CInt
x CInt
y
	generateImagePrimM :: forall (m :: * -> *).
PrimBase m =>
CInt -> CInt -> (CInt -> CInt -> m (Pixel A1)) -> m A1
generateImagePrimM = CInt -> CInt -> (CInt -> CInt -> m (Pixel A1)) -> m A1
CInt -> CInt -> (CInt -> CInt -> m PixelA1) -> m A1
forall (m :: * -> *).
PrimBase m =>
CInt -> CInt -> (CInt -> CInt -> m PixelA1) -> m A1
genA1

genA1 :: PrimBase m => CInt -> CInt -> (CInt -> CInt -> m PixelA1) -> m A1
genA1 :: forall (m :: * -> *).
PrimBase m =>
CInt -> CInt -> (CInt -> CInt -> m PixelA1) -> m A1
genA1 CInt
w CInt
h CInt -> CInt -> m PixelA1
f = IO A1 -> m A1
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO A1 -> m A1) -> IO A1 -> m A1
forall a b. (a -> b) -> a -> b
$ CairoFormatT -> CInt -> IO CInt
forall (m :: * -> *). PrimMonad m => CairoFormatT -> CInt -> m CInt
stride CairoFormatT
CairoFormatA1 CInt
w IO CInt -> (CInt -> IO A1) -> IO A1
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
s -> do
	d <- Int -> IO (Ptr PixelA1)
forall a. Int -> IO (Ptr a)
mallocBytes (Int -> IO (Ptr PixelA1))
-> (CInt -> Int) -> CInt -> IO (Ptr PixelA1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> IO (Ptr PixelA1)) -> CInt -> IO (Ptr PixelA1)
forall a b. (a -> b) -> a -> b
$ CInt
s CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* CInt
h
	for_ [0 .. h - 1] \CInt
y -> [CInt] -> (CInt -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [CInt
0 .. CInt
w CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1] \CInt
x ->
		m PixelA1 -> IO PixelA1
forall (m :: * -> *) a. PrimBase m => m a -> IO a
unsafePrimToIO (CInt -> CInt -> m PixelA1
f CInt
x CInt
y) IO PixelA1 -> (PixelA1 -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PixelA1
px ->
			IO ()
-> ((Ptr PixelA1, CInt) -> IO ())
-> Maybe (Ptr PixelA1, CInt)
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ((Ptr PixelA1, CInt) -> PixelA1 -> IO ()
`poA1` PixelA1
px) (Maybe (Ptr PixelA1, CInt) -> IO ())
-> Maybe (Ptr PixelA1, CInt) -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr PixelA1
-> CInt
-> CInt
-> Maybe (Ptr PixelA1, CInt)
ptrA1 CInt
w CInt
h CInt
s Ptr PixelA1
d CInt
x CInt
y
	A1 w h s <$> newForeignPtr d (free d)

-- IMAGE MUTABLE

data A1Mut s = A1Mut {
	forall s. A1Mut s -> CInt
a1MutWidth :: CInt, forall s. A1Mut s -> CInt
a1MutHeight :: CInt,
	forall s. A1Mut s -> CInt
a1MutStride :: CInt, forall s. A1Mut s -> ForeignPtr PixelA1
a1MutData :: ForeignPtr PixelA1 }
	deriving Int -> A1Mut s -> ShowS
[A1Mut s] -> ShowS
A1Mut s -> String
(Int -> A1Mut s -> ShowS)
-> (A1Mut s -> String) -> ([A1Mut s] -> ShowS) -> Show (A1Mut s)
forall s. Int -> A1Mut s -> ShowS
forall s. [A1Mut s] -> ShowS
forall s. A1Mut s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Int -> A1Mut s -> ShowS
showsPrec :: Int -> A1Mut s -> ShowS
$cshow :: forall s. A1Mut s -> String
show :: A1Mut s -> String
$cshowList :: forall s. [A1Mut s] -> ShowS
showList :: [A1Mut s] -> ShowS
Show

pattern CairoImageMutA1 :: A1Mut s -> CairoImageMut s
pattern $bCairoImageMutA1 :: forall s. A1Mut s -> CairoImageMut s
$mCairoImageMutA1 :: forall {r} {s}.
CairoImageMut s -> (A1Mut s -> r) -> ((# #) -> r) -> r
CairoImageMutA1 a <- (cairoImageMutToA1 -> Just a)
	where CairoImageMutA1 (A1Mut CInt
w CInt
h CInt
s ForeignPtr PixelA1
d) =
		CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImageMut s
forall s.
CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImageMut s
CairoImageMut CairoFormatT
CairoFormatA1 CInt
w CInt
h CInt
s (ForeignPtr CUChar -> CairoImageMut s)
-> ForeignPtr CUChar -> CairoImageMut s
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelA1 -> ForeignPtr CUChar
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr PixelA1
d

cairoImageMutToA1 :: CairoImageMut s -> Maybe (A1Mut s)
cairoImageMutToA1 :: forall s. CairoImageMut s -> Maybe (A1Mut s)
cairoImageMutToA1 = \case
	CairoImageMut CairoFormatT
CairoFormatA1 CInt
w CInt
h CInt
s ForeignPtr CUChar
d ->
		A1Mut s -> Maybe (A1Mut s)
forall a. a -> Maybe a
Just (A1Mut s -> Maybe (A1Mut s))
-> (ForeignPtr PixelA1 -> A1Mut s)
-> ForeignPtr PixelA1
-> Maybe (A1Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> ForeignPtr PixelA1 -> A1Mut s
forall s. CInt -> CInt -> CInt -> ForeignPtr PixelA1 -> A1Mut s
A1Mut CInt
w CInt
h CInt
s (ForeignPtr PixelA1 -> Maybe (A1Mut s))
-> ForeignPtr PixelA1 -> Maybe (A1Mut s)
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> ForeignPtr PixelA1
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CUChar
d
	CairoImageMut s
_ -> Maybe (A1Mut s)
forall a. Maybe a
Nothing

instance ImageMut A1Mut where
	type PixelMut A1Mut = PixelA1
	imageMutSize :: forall s. A1Mut s -> (CInt, CInt)
imageMutSize (A1Mut CInt
w CInt
h CInt
_ ForeignPtr PixelA1
_) = (CInt
w, CInt
h)
	getPixel :: forall (m :: * -> *).
PrimMonad m =>
A1Mut (PrimState m) -> CInt -> CInt -> m (Maybe (PixelMut A1Mut))
getPixel (A1Mut CInt
w CInt
h CInt
s ForeignPtr PixelA1
d) CInt
x CInt
y = IO (Maybe (PixelMut A1Mut)) -> m (Maybe (PixelMut A1Mut))
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO (Maybe (PixelMut A1Mut)) -> m (Maybe (PixelMut A1Mut)))
-> IO (Maybe (PixelMut A1Mut)) -> m (Maybe (PixelMut A1Mut))
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelA1
-> (Ptr PixelA1 -> IO (Maybe (PixelMut A1Mut)))
-> IO (Maybe (PixelMut A1Mut))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelA1
d \Ptr PixelA1
p ->
		IO (Maybe (PixelMut A1Mut))
-> ((Ptr PixelA1, CInt) -> IO (Maybe (PixelMut A1Mut)))
-> Maybe (Ptr PixelA1, CInt)
-> IO (Maybe (PixelMut A1Mut))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe PixelA1 -> IO (Maybe PixelA1)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PixelA1
forall a. Maybe a
Nothing) ((PixelA1 -> Maybe PixelA1
forall a. a -> Maybe a
Just (PixelA1 -> Maybe PixelA1) -> IO PixelA1 -> IO (Maybe PixelA1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO PixelA1 -> IO (Maybe PixelA1))
-> ((Ptr PixelA1, CInt) -> IO PixelA1)
-> (Ptr PixelA1, CInt)
-> IO (Maybe PixelA1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr PixelA1, CInt) -> IO PixelA1
peA1) (Maybe (Ptr PixelA1, CInt) -> IO (Maybe (PixelMut A1Mut)))
-> Maybe (Ptr PixelA1, CInt) -> IO (Maybe (PixelMut A1Mut))
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr PixelA1
-> CInt
-> CInt
-> Maybe (Ptr PixelA1, CInt)
ptrA1 CInt
w CInt
h CInt
s Ptr PixelA1
p CInt
x CInt
y
	putPixel :: forall (m :: * -> *).
PrimMonad m =>
A1Mut (PrimState m) -> CInt -> CInt -> PixelMut A1Mut -> m ()
putPixel (A1Mut CInt
w CInt
h CInt
s ForeignPtr PixelA1
d) CInt
x CInt
y PixelMut A1Mut
px = IO () -> m ()
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelA1 -> (Ptr PixelA1 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelA1
d \Ptr PixelA1
p ->
		IO ()
-> ((Ptr PixelA1, CInt) -> IO ())
-> Maybe (Ptr PixelA1, CInt)
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ((Ptr PixelA1, CInt) -> PixelA1 -> IO ()
`poA1` PixelMut A1Mut
PixelA1
px) (Maybe (Ptr PixelA1, CInt) -> IO ())
-> Maybe (Ptr PixelA1, CInt) -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr PixelA1
-> CInt
-> CInt
-> Maybe (Ptr PixelA1, CInt)
ptrA1 CInt
w CInt
h CInt
s Ptr PixelA1
p CInt
x CInt
y
	newImageMut :: forall (m :: * -> *).
PrimMonad m =>
CInt -> CInt -> m (A1Mut (PrimState m))
newImageMut CInt
w CInt
h =
		CairoFormatT -> CInt -> m CInt
forall (m :: * -> *). PrimMonad m => CairoFormatT -> CInt -> m CInt
stride CairoFormatT
CairoFormatA1 CInt
w m CInt
-> (CInt -> m (A1Mut (PrimState m))) -> m (A1Mut (PrimState m))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
s -> CInt -> CInt -> CInt -> ForeignPtr PixelA1 -> A1Mut (PrimState m)
forall s. CInt -> CInt -> CInt -> ForeignPtr PixelA1 -> A1Mut s
A1Mut CInt
w CInt
h CInt
s (ForeignPtr PixelA1 -> A1Mut (PrimState m))
-> m (ForeignPtr PixelA1) -> m (A1Mut (PrimState m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> m (ForeignPtr PixelA1)
forall (m :: * -> *) a.
PrimMonad m =>
CInt -> CInt -> m (ForeignPtr a)
new CInt
s CInt
h

---------------------------------------------------------------------------
-- RGB 16 565
---------------------------------------------------------------------------

-- PIXEL

newtype PixelRgb16_565 = PixelRgb16_565Word16 Word16 deriving (Int -> PixelRgb16_565 -> ShowS
[PixelRgb16_565] -> ShowS
PixelRgb16_565 -> String
(Int -> PixelRgb16_565 -> ShowS)
-> (PixelRgb16_565 -> String)
-> ([PixelRgb16_565] -> ShowS)
-> Show PixelRgb16_565
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PixelRgb16_565 -> ShowS
showsPrec :: Int -> PixelRgb16_565 -> ShowS
$cshow :: PixelRgb16_565 -> String
show :: PixelRgb16_565 -> String
$cshowList :: [PixelRgb16_565] -> ShowS
showList :: [PixelRgb16_565] -> ShowS
Show, Ptr PixelRgb16_565 -> IO PixelRgb16_565
Ptr PixelRgb16_565 -> Int -> IO PixelRgb16_565
Ptr PixelRgb16_565 -> Int -> PixelRgb16_565 -> IO ()
Ptr PixelRgb16_565 -> PixelRgb16_565 -> IO ()
PixelRgb16_565 -> Int
(PixelRgb16_565 -> Int)
-> (PixelRgb16_565 -> Int)
-> (Ptr PixelRgb16_565 -> Int -> IO PixelRgb16_565)
-> (Ptr PixelRgb16_565 -> Int -> PixelRgb16_565 -> IO ())
-> (forall b. Ptr b -> Int -> IO PixelRgb16_565)
-> (forall b. Ptr b -> Int -> PixelRgb16_565 -> IO ())
-> (Ptr PixelRgb16_565 -> IO PixelRgb16_565)
-> (Ptr PixelRgb16_565 -> PixelRgb16_565 -> IO ())
-> Storable PixelRgb16_565
forall b. Ptr b -> Int -> IO PixelRgb16_565
forall b. Ptr b -> Int -> PixelRgb16_565 -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: PixelRgb16_565 -> Int
sizeOf :: PixelRgb16_565 -> Int
$calignment :: PixelRgb16_565 -> Int
alignment :: PixelRgb16_565 -> Int
$cpeekElemOff :: Ptr PixelRgb16_565 -> Int -> IO PixelRgb16_565
peekElemOff :: Ptr PixelRgb16_565 -> Int -> IO PixelRgb16_565
$cpokeElemOff :: Ptr PixelRgb16_565 -> Int -> PixelRgb16_565 -> IO ()
pokeElemOff :: Ptr PixelRgb16_565 -> Int -> PixelRgb16_565 -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO PixelRgb16_565
peekByteOff :: forall b. Ptr b -> Int -> IO PixelRgb16_565
$cpokeByteOff :: forall b. Ptr b -> Int -> PixelRgb16_565 -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> PixelRgb16_565 -> IO ()
$cpeek :: Ptr PixelRgb16_565 -> IO PixelRgb16_565
peek :: Ptr PixelRgb16_565 -> IO PixelRgb16_565
$cpoke :: Ptr PixelRgb16_565 -> PixelRgb16_565 -> IO ()
poke :: Ptr PixelRgb16_565 -> PixelRgb16_565 -> IO ()
Storable)

{-# COMPLETE PixelRgb16_565 #-}

pattern PixelRgb16_565 :: Word8 -> Word8 -> Word8 -> PixelRgb16_565
pattern $bPixelRgb16_565 :: Word8 -> Word8 -> Word8 -> PixelRgb16_565
$mPixelRgb16_565 :: forall {r}.
PixelRgb16_565
-> (Word8 -> Word8 -> Word8 -> r) -> ((# #) -> r) -> r
PixelRgb16_565 r g b <- (pixelRgb16_565ToRgb -> (r, g, b))
	where PixelRgb16_565
		(Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word16
r) (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word16
g) (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word16
b) =
		Word16 -> PixelRgb16_565
PixelRgb16_565Word16 (Word16 -> PixelRgb16_565) -> Word16 -> PixelRgb16_565
forall a b. (a -> b) -> a -> b
$ Word16
r' Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
g' Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
b'
		where
		r' :: Word16
r' = Word16
r Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
3 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
11
		g' :: Word16
g' = Word16
g Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
2 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
5
		b' :: Word16
b' = Word16
b Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
3

pixelRgb16_565ToRgb :: PixelRgb16_565 -> (Word8, Word8, Word8)
pixelRgb16_565ToRgb :: PixelRgb16_565 -> (Word8, Word8, Word8)
pixelRgb16_565ToRgb (PixelRgb16_565Word16 Word16
rgb) =
	(Word8
r Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
r Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
5, Word8
g Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
g Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
6, Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
b Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
5)
	where
	r :: Word8
r = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ Word16
rgb Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
11 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
3
	g :: Word8
g = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ Word16
rgb Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
5 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
2
	b :: Word8
b = Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ Word16
rgb Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
3

-- IMAGE

data Rgb16_565 = Rgb16_565 {
	Rgb16_565 -> CInt
rgb16_565Width :: CInt, Rgb16_565 -> CInt
rgb16_565Height :: CInt,
	Rgb16_565 -> CInt
rgb16_565Stride :: CInt, Rgb16_565 -> ForeignPtr PixelRgb16_565
rgb16_565Data :: ForeignPtr PixelRgb16_565 }
	deriving Int -> Rgb16_565 -> ShowS
[Rgb16_565] -> ShowS
Rgb16_565 -> String
(Int -> Rgb16_565 -> ShowS)
-> (Rgb16_565 -> String)
-> ([Rgb16_565] -> ShowS)
-> Show Rgb16_565
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rgb16_565 -> ShowS
showsPrec :: Int -> Rgb16_565 -> ShowS
$cshow :: Rgb16_565 -> String
show :: Rgb16_565 -> String
$cshowList :: [Rgb16_565] -> ShowS
showList :: [Rgb16_565] -> ShowS
Show

pattern CairoImageRgb16_565 :: Rgb16_565 -> CairoImage
pattern $bCairoImageRgb16_565 :: Rgb16_565 -> CairoImage
$mCairoImageRgb16_565 :: forall {r}. CairoImage -> (Rgb16_565 -> r) -> ((# #) -> r) -> r
CairoImageRgb16_565 r <- (cairoImageToRgb16_565 -> Just r)
	where CairoImageRgb16_565 (Rgb16_565 CInt
w CInt
h CInt
s ForeignPtr PixelRgb16_565
d) =
		CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImage
CairoImage CairoFormatT
CairoFormatRgb16_565 CInt
w CInt
h CInt
s (ForeignPtr CUChar -> CairoImage)
-> ForeignPtr CUChar -> CairoImage
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelRgb16_565 -> ForeignPtr CUChar
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr PixelRgb16_565
d

cairoImageToRgb16_565 :: CairoImage -> Maybe Rgb16_565
cairoImageToRgb16_565 :: CairoImage -> Maybe Rgb16_565
cairoImageToRgb16_565 = \case
	CairoImage CairoFormatT
CairoFormatRgb16_565 CInt
w CInt
h CInt
s ForeignPtr CUChar
d ->
		Rgb16_565 -> Maybe Rgb16_565
forall a. a -> Maybe a
Just (Rgb16_565 -> Maybe Rgb16_565)
-> (ForeignPtr PixelRgb16_565 -> Rgb16_565)
-> ForeignPtr PixelRgb16_565
-> Maybe Rgb16_565
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> ForeignPtr PixelRgb16_565 -> Rgb16_565
Rgb16_565 CInt
w CInt
h CInt
s (ForeignPtr PixelRgb16_565 -> Maybe Rgb16_565)
-> ForeignPtr PixelRgb16_565 -> Maybe Rgb16_565
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> ForeignPtr PixelRgb16_565
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CUChar
d
	CairoImage
_ -> Maybe Rgb16_565
forall a. Maybe a
Nothing

instance Image Rgb16_565 where
	type Pixel Rgb16_565 = PixelRgb16_565
	imageSize :: Rgb16_565 -> (CInt, CInt)
imageSize (Rgb16_565 CInt
w CInt
h CInt
_ ForeignPtr PixelRgb16_565
_) = (CInt
w, CInt
h)
	pixelAt :: Rgb16_565 -> CInt -> CInt -> Maybe (Pixel Rgb16_565)
pixelAt (Rgb16_565 CInt
w CInt
h CInt
s ForeignPtr PixelRgb16_565
d) CInt
x CInt
y = IO (Maybe (Pixel Rgb16_565)) -> Maybe (Pixel Rgb16_565)
forall a. IO a -> a
unsafePerformIO (IO (Maybe (Pixel Rgb16_565)) -> Maybe (Pixel Rgb16_565))
-> IO (Maybe (Pixel Rgb16_565)) -> Maybe (Pixel Rgb16_565)
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelRgb16_565
-> (Ptr PixelRgb16_565 -> IO (Maybe (Pixel Rgb16_565)))
-> IO (Maybe (Pixel Rgb16_565))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelRgb16_565
d \Ptr PixelRgb16_565
p ->
		IO (Maybe (Pixel Rgb16_565))
-> (Ptr PixelRgb16_565 -> IO (Maybe (Pixel Rgb16_565)))
-> Maybe (Ptr PixelRgb16_565)
-> IO (Maybe (Pixel Rgb16_565))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe PixelRgb16_565 -> IO (Maybe PixelRgb16_565)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PixelRgb16_565
forall a. Maybe a
Nothing) ((PixelRgb16_565 -> Maybe PixelRgb16_565
forall a. a -> Maybe a
Just (PixelRgb16_565 -> Maybe PixelRgb16_565)
-> IO PixelRgb16_565 -> IO (Maybe PixelRgb16_565)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO PixelRgb16_565 -> IO (Maybe PixelRgb16_565))
-> (Ptr PixelRgb16_565 -> IO PixelRgb16_565)
-> Ptr PixelRgb16_565
-> IO (Maybe PixelRgb16_565)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PixelRgb16_565 -> IO PixelRgb16_565
forall a. Storable a => Ptr a -> IO a
peek) (Maybe (Ptr PixelRgb16_565) -> IO (Maybe (Pixel Rgb16_565)))
-> Maybe (Ptr PixelRgb16_565) -> IO (Maybe (Pixel Rgb16_565))
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr PixelRgb16_565
-> CInt
-> CInt
-> Maybe (Ptr PixelRgb16_565)
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr PixelRgb16_565
p CInt
x CInt
y
	generateImagePrimM :: forall (m :: * -> *).
PrimBase m =>
CInt
-> CInt -> (CInt -> CInt -> m (Pixel Rgb16_565)) -> m Rgb16_565
generateImagePrimM CInt
w CInt
h CInt -> CInt -> m (Pixel Rgb16_565)
f = CairoFormatT -> CInt -> m CInt
forall (m :: * -> *). PrimMonad m => CairoFormatT -> CInt -> m CInt
stride CairoFormatT
CairoFormatRgb16_565 CInt
w m CInt -> (CInt -> m Rgb16_565) -> m Rgb16_565
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
s ->
		CInt -> CInt -> CInt -> ForeignPtr PixelRgb16_565 -> Rgb16_565
Rgb16_565 CInt
w CInt
h CInt
s (ForeignPtr PixelRgb16_565 -> Rgb16_565)
-> m (ForeignPtr PixelRgb16_565) -> m Rgb16_565
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt
-> CInt
-> CInt
-> (CInt -> CInt -> m PixelRgb16_565)
-> m (ForeignPtr PixelRgb16_565)
forall (m :: * -> *) a.
(PrimBase m, Storable a) =>
CInt -> CInt -> CInt -> (CInt -> CInt -> m a) -> m (ForeignPtr a)
gen CInt
w CInt
h CInt
s CInt -> CInt -> m (Pixel Rgb16_565)
CInt -> CInt -> m PixelRgb16_565
f

-- IMAGE MUTABLE

data Rgb16_565Mut s = Rgb16_565Mut {
	forall s. Rgb16_565Mut s -> CInt
rgb16_565MutWidth :: CInt, forall s. Rgb16_565Mut s -> CInt
rgb16_565MutHeight :: CInt,
	forall s. Rgb16_565Mut s -> CInt
rgb16_565MutStride :: CInt,
	forall s. Rgb16_565Mut s -> ForeignPtr PixelRgb16_565
rgb16_565MutData :: ForeignPtr PixelRgb16_565 }
	deriving Int -> Rgb16_565Mut s -> ShowS
[Rgb16_565Mut s] -> ShowS
Rgb16_565Mut s -> String
(Int -> Rgb16_565Mut s -> ShowS)
-> (Rgb16_565Mut s -> String)
-> ([Rgb16_565Mut s] -> ShowS)
-> Show (Rgb16_565Mut s)
forall s. Int -> Rgb16_565Mut s -> ShowS
forall s. [Rgb16_565Mut s] -> ShowS
forall s. Rgb16_565Mut s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Int -> Rgb16_565Mut s -> ShowS
showsPrec :: Int -> Rgb16_565Mut s -> ShowS
$cshow :: forall s. Rgb16_565Mut s -> String
show :: Rgb16_565Mut s -> String
$cshowList :: forall s. [Rgb16_565Mut s] -> ShowS
showList :: [Rgb16_565Mut s] -> ShowS
Show

pattern CairoImageMutRgb16_565 :: Rgb16_565Mut s -> CairoImageMut s
pattern $bCairoImageMutRgb16_565 :: forall s. Rgb16_565Mut s -> CairoImageMut s
$mCairoImageMutRgb16_565 :: forall {r} {s}.
CairoImageMut s -> (Rgb16_565Mut s -> r) -> ((# #) -> r) -> r
CairoImageMutRgb16_565 r <- (cairoImageMutToRgb16_565 -> Just r)
	where CairoImageMutRgb16_565 (Rgb16_565Mut CInt
w CInt
h CInt
s ForeignPtr PixelRgb16_565
d) =
		CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImageMut s
forall s.
CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImageMut s
CairoImageMut CairoFormatT
CairoFormatRgb16_565 CInt
w CInt
h CInt
s (ForeignPtr CUChar -> CairoImageMut s)
-> ForeignPtr CUChar -> CairoImageMut s
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelRgb16_565 -> ForeignPtr CUChar
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr PixelRgb16_565
d

cairoImageMutToRgb16_565 :: CairoImageMut s -> Maybe (Rgb16_565Mut s)
cairoImageMutToRgb16_565 :: forall s. CairoImageMut s -> Maybe (Rgb16_565Mut s)
cairoImageMutToRgb16_565 = \case
	CairoImageMut CairoFormatT
CairoFormatRgb16_565 CInt
w CInt
h CInt
s ForeignPtr CUChar
d ->
		Rgb16_565Mut s -> Maybe (Rgb16_565Mut s)
forall a. a -> Maybe a
Just (Rgb16_565Mut s -> Maybe (Rgb16_565Mut s))
-> (ForeignPtr PixelRgb16_565 -> Rgb16_565Mut s)
-> ForeignPtr PixelRgb16_565
-> Maybe (Rgb16_565Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> ForeignPtr PixelRgb16_565 -> Rgb16_565Mut s
forall s.
CInt -> CInt -> CInt -> ForeignPtr PixelRgb16_565 -> Rgb16_565Mut s
Rgb16_565Mut CInt
w CInt
h CInt
s (ForeignPtr PixelRgb16_565 -> Maybe (Rgb16_565Mut s))
-> ForeignPtr PixelRgb16_565 -> Maybe (Rgb16_565Mut s)
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> ForeignPtr PixelRgb16_565
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CUChar
d
	CairoImageMut s
_ -> Maybe (Rgb16_565Mut s)
forall a. Maybe a
Nothing

instance ImageMut Rgb16_565Mut where
	type PixelMut Rgb16_565Mut = PixelRgb16_565
	imageMutSize :: forall s. Rgb16_565Mut s -> (CInt, CInt)
imageMutSize (Rgb16_565Mut CInt
w CInt
h CInt
_ ForeignPtr PixelRgb16_565
_) = (CInt
w, CInt
h)
	getPixel :: forall (m :: * -> *).
PrimMonad m =>
Rgb16_565Mut (PrimState m)
-> CInt -> CInt -> m (Maybe (PixelMut Rgb16_565Mut))
getPixel (Rgb16_565Mut CInt
w CInt
h CInt
s ForeignPtr PixelRgb16_565
d) CInt
x CInt
y = IO (Maybe (PixelMut Rgb16_565Mut))
-> m (Maybe (PixelMut Rgb16_565Mut))
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO (Maybe (PixelMut Rgb16_565Mut))
 -> m (Maybe (PixelMut Rgb16_565Mut)))
-> IO (Maybe (PixelMut Rgb16_565Mut))
-> m (Maybe (PixelMut Rgb16_565Mut))
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelRgb16_565
-> (Ptr PixelRgb16_565 -> IO (Maybe (PixelMut Rgb16_565Mut)))
-> IO (Maybe (PixelMut Rgb16_565Mut))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelRgb16_565
d \Ptr PixelRgb16_565
p ->
		IO (Maybe (PixelMut Rgb16_565Mut))
-> (Ptr PixelRgb16_565 -> IO (Maybe (PixelMut Rgb16_565Mut)))
-> Maybe (Ptr PixelRgb16_565)
-> IO (Maybe (PixelMut Rgb16_565Mut))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe PixelRgb16_565 -> IO (Maybe PixelRgb16_565)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PixelRgb16_565
forall a. Maybe a
Nothing) ((PixelRgb16_565 -> Maybe PixelRgb16_565
forall a. a -> Maybe a
Just (PixelRgb16_565 -> Maybe PixelRgb16_565)
-> IO PixelRgb16_565 -> IO (Maybe PixelRgb16_565)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO PixelRgb16_565 -> IO (Maybe PixelRgb16_565))
-> (Ptr PixelRgb16_565 -> IO PixelRgb16_565)
-> Ptr PixelRgb16_565
-> IO (Maybe PixelRgb16_565)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PixelRgb16_565 -> IO PixelRgb16_565
forall a. Storable a => Ptr a -> IO a
peek) (Maybe (Ptr PixelRgb16_565) -> IO (Maybe (PixelMut Rgb16_565Mut)))
-> Maybe (Ptr PixelRgb16_565) -> IO (Maybe (PixelMut Rgb16_565Mut))
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr PixelRgb16_565
-> CInt
-> CInt
-> Maybe (Ptr PixelRgb16_565)
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr PixelRgb16_565
p CInt
x CInt
y
	putPixel :: forall (m :: * -> *).
PrimMonad m =>
Rgb16_565Mut (PrimState m)
-> CInt -> CInt -> PixelMut Rgb16_565Mut -> m ()
putPixel (Rgb16_565Mut CInt
w CInt
h CInt
s ForeignPtr PixelRgb16_565
d) CInt
x CInt
y PixelMut Rgb16_565Mut
px = IO () -> m ()
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelRgb16_565 -> (Ptr PixelRgb16_565 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelRgb16_565
d \Ptr PixelRgb16_565
p ->
		IO ()
-> (Ptr (PixelMut Rgb16_565Mut) -> IO ())
-> Maybe (Ptr (PixelMut Rgb16_565Mut))
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Ptr (PixelMut Rgb16_565Mut) -> PixelMut Rgb16_565Mut -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
`poke` PixelMut Rgb16_565Mut
px) (Maybe (Ptr (PixelMut Rgb16_565Mut)) -> IO ())
-> Maybe (Ptr (PixelMut Rgb16_565Mut)) -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr (PixelMut Rgb16_565Mut)
-> CInt
-> CInt
-> Maybe (Ptr (PixelMut Rgb16_565Mut))
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr (PixelMut Rgb16_565Mut)
Ptr PixelRgb16_565
p CInt
x CInt
y
	newImageMut :: forall (m :: * -> *).
PrimMonad m =>
CInt -> CInt -> m (Rgb16_565Mut (PrimState m))
newImageMut CInt
w CInt
h = CairoFormatT -> CInt -> m CInt
forall (m :: * -> *). PrimMonad m => CairoFormatT -> CInt -> m CInt
stride CairoFormatT
CairoFormatRgb16_565 CInt
w m CInt
-> (CInt -> m (Rgb16_565Mut (PrimState m)))
-> m (Rgb16_565Mut (PrimState m))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
s ->
		CInt
-> CInt
-> CInt
-> ForeignPtr PixelRgb16_565
-> Rgb16_565Mut (PrimState m)
forall s.
CInt -> CInt -> CInt -> ForeignPtr PixelRgb16_565 -> Rgb16_565Mut s
Rgb16_565Mut CInt
w CInt
h CInt
s (ForeignPtr PixelRgb16_565 -> Rgb16_565Mut (PrimState m))
-> m (ForeignPtr PixelRgb16_565) -> m (Rgb16_565Mut (PrimState m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> m (ForeignPtr PixelRgb16_565)
forall (m :: * -> *) a.
PrimMonad m =>
CInt -> CInt -> m (ForeignPtr a)
new CInt
s CInt
h

---------------------------------------------------------------------------
-- RGB 30
---------------------------------------------------------------------------

-- PIXEL

newtype PixelRgb30 = PixelRgb30Word32 Word32 deriving (Int -> PixelRgb30 -> ShowS
[PixelRgb30] -> ShowS
PixelRgb30 -> String
(Int -> PixelRgb30 -> ShowS)
-> (PixelRgb30 -> String)
-> ([PixelRgb30] -> ShowS)
-> Show PixelRgb30
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PixelRgb30 -> ShowS
showsPrec :: Int -> PixelRgb30 -> ShowS
$cshow :: PixelRgb30 -> String
show :: PixelRgb30 -> String
$cshowList :: [PixelRgb30] -> ShowS
showList :: [PixelRgb30] -> ShowS
Show, Ptr PixelRgb30 -> IO PixelRgb30
Ptr PixelRgb30 -> Int -> IO PixelRgb30
Ptr PixelRgb30 -> Int -> PixelRgb30 -> IO ()
Ptr PixelRgb30 -> PixelRgb30 -> IO ()
PixelRgb30 -> Int
(PixelRgb30 -> Int)
-> (PixelRgb30 -> Int)
-> (Ptr PixelRgb30 -> Int -> IO PixelRgb30)
-> (Ptr PixelRgb30 -> Int -> PixelRgb30 -> IO ())
-> (forall b. Ptr b -> Int -> IO PixelRgb30)
-> (forall b. Ptr b -> Int -> PixelRgb30 -> IO ())
-> (Ptr PixelRgb30 -> IO PixelRgb30)
-> (Ptr PixelRgb30 -> PixelRgb30 -> IO ())
-> Storable PixelRgb30
forall b. Ptr b -> Int -> IO PixelRgb30
forall b. Ptr b -> Int -> PixelRgb30 -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: PixelRgb30 -> Int
sizeOf :: PixelRgb30 -> Int
$calignment :: PixelRgb30 -> Int
alignment :: PixelRgb30 -> Int
$cpeekElemOff :: Ptr PixelRgb30 -> Int -> IO PixelRgb30
peekElemOff :: Ptr PixelRgb30 -> Int -> IO PixelRgb30
$cpokeElemOff :: Ptr PixelRgb30 -> Int -> PixelRgb30 -> IO ()
pokeElemOff :: Ptr PixelRgb30 -> Int -> PixelRgb30 -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO PixelRgb30
peekByteOff :: forall b. Ptr b -> Int -> IO PixelRgb30
$cpokeByteOff :: forall b. Ptr b -> Int -> PixelRgb30 -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> PixelRgb30 -> IO ()
$cpeek :: Ptr PixelRgb30 -> IO PixelRgb30
peek :: Ptr PixelRgb30 -> IO PixelRgb30
$cpoke :: Ptr PixelRgb30 -> PixelRgb30 -> IO ()
poke :: Ptr PixelRgb30 -> PixelRgb30 -> IO ()
Storable)

{-# COMPLETE PixelRgb30 #-}

pattern PixelRgb30 :: Word16 -> Word16 -> Word16 -> PixelRgb30
pattern $bPixelRgb30 :: Word16 -> Word16 -> Word16 -> PixelRgb30
$mPixelRgb30 :: forall {r}.
PixelRgb30
-> (Word16 -> Word16 -> Word16 -> r) -> ((# #) -> r) -> r
PixelRgb30 r g b <- (pixelRgb30ToRgb -> (r, g, b)) where
	PixelRgb30 (Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word32
r) (Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word32
g) (Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word32
b) =
		Word32 -> PixelRgb30
PixelRgb30Word32 (Word32 -> PixelRgb30) -> Word32 -> PixelRgb30
forall a b. (a -> b) -> a -> b
$ Word32
r' Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
g' Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
b'
		where
		r' :: Word32
r' = Word32
r Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
6 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
20
		g' :: Word32
g' = Word32
g Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
6 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
10
		b' :: Word32
b' = Word32
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
6

pixelRgb30ToRgb :: PixelRgb30 -> (Word16, Word16, Word16)
pixelRgb30ToRgb :: PixelRgb30 -> (Word16, Word16, Word16)
pixelRgb30ToRgb (PixelRgb30Word32 Word32
rgb) =
	(Word16
r Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
r Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
10, Word16
g Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
g Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
10, Word16
b Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
b Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
10)
	where
	r :: Word16
r = Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word16) -> Word32 -> Word16
forall a b. (a -> b) -> a -> b
$ Word32
rgb Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
20 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
6
	g :: Word16
g = Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word16) -> Word32 -> Word16
forall a b. (a -> b) -> a -> b
$ Word32
rgb Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
10 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
6
	b :: Word16
b = Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word16) -> Word32 -> Word16
forall a b. (a -> b) -> a -> b
$ Word32
rgb Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
6

-- IMAGE

data Rgb30 = Rgb30 {
	Rgb30 -> CInt
rgb30Width :: CInt, Rgb30 -> CInt
rgb30Height :: CInt,
	Rgb30 -> CInt
rgb30Stride :: CInt, Rgb30 -> ForeignPtr PixelRgb30
rgb30Data :: ForeignPtr PixelRgb30 }
	deriving Int -> Rgb30 -> ShowS
[Rgb30] -> ShowS
Rgb30 -> String
(Int -> Rgb30 -> ShowS)
-> (Rgb30 -> String) -> ([Rgb30] -> ShowS) -> Show Rgb30
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rgb30 -> ShowS
showsPrec :: Int -> Rgb30 -> ShowS
$cshow :: Rgb30 -> String
show :: Rgb30 -> String
$cshowList :: [Rgb30] -> ShowS
showList :: [Rgb30] -> ShowS
Show

pattern CairoImageRgb30 :: Rgb30 -> CairoImage
pattern $bCairoImageRgb30 :: Rgb30 -> CairoImage
$mCairoImageRgb30 :: forall {r}. CairoImage -> (Rgb30 -> r) -> ((# #) -> r) -> r
CairoImageRgb30 r <- (cairoImageToRgb30 -> Just r)
	where CairoImageRgb30 (Rgb30 CInt
w CInt
h CInt
s ForeignPtr PixelRgb30
d) =
		CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImage
CairoImage CairoFormatT
CairoFormatRgb30 CInt
w CInt
h CInt
s (ForeignPtr CUChar -> CairoImage)
-> ForeignPtr CUChar -> CairoImage
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelRgb30 -> ForeignPtr CUChar
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr PixelRgb30
d

cairoImageToRgb30 :: CairoImage -> Maybe Rgb30
cairoImageToRgb30 :: CairoImage -> Maybe Rgb30
cairoImageToRgb30 = \case
	CairoImage CairoFormatT
CairoFormatRgb30 CInt
w CInt
h CInt
s ForeignPtr CUChar
d ->
		Rgb30 -> Maybe Rgb30
forall a. a -> Maybe a
Just (Rgb30 -> Maybe Rgb30)
-> (ForeignPtr PixelRgb30 -> Rgb30)
-> ForeignPtr PixelRgb30
-> Maybe Rgb30
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> ForeignPtr PixelRgb30 -> Rgb30
Rgb30 CInt
w CInt
h CInt
s (ForeignPtr PixelRgb30 -> Maybe Rgb30)
-> ForeignPtr PixelRgb30 -> Maybe Rgb30
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> ForeignPtr PixelRgb30
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CUChar
d
	CairoImage
_ -> Maybe Rgb30
forall a. Maybe a
Nothing

instance Image Rgb30 where
	type Pixel Rgb30 = PixelRgb30
	imageSize :: Rgb30 -> (CInt, CInt)
imageSize (Rgb30 CInt
w CInt
h CInt
_ ForeignPtr PixelRgb30
_) = (CInt
w, CInt
h)
	pixelAt :: Rgb30 -> CInt -> CInt -> Maybe (Pixel Rgb30)
pixelAt (Rgb30 CInt
w CInt
h CInt
s ForeignPtr PixelRgb30
d) CInt
x CInt
y = IO (Maybe (Pixel Rgb30)) -> Maybe (Pixel Rgb30)
forall a. IO a -> a
unsafePerformIO (IO (Maybe (Pixel Rgb30)) -> Maybe (Pixel Rgb30))
-> IO (Maybe (Pixel Rgb30)) -> Maybe (Pixel Rgb30)
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelRgb30
-> (Ptr PixelRgb30 -> IO (Maybe (Pixel Rgb30)))
-> IO (Maybe (Pixel Rgb30))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelRgb30
d \Ptr PixelRgb30
p ->
		IO (Maybe (Pixel Rgb30))
-> (Ptr PixelRgb30 -> IO (Maybe (Pixel Rgb30)))
-> Maybe (Ptr PixelRgb30)
-> IO (Maybe (Pixel Rgb30))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe PixelRgb30 -> IO (Maybe PixelRgb30)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PixelRgb30
forall a. Maybe a
Nothing) ((PixelRgb30 -> Maybe PixelRgb30
forall a. a -> Maybe a
Just (PixelRgb30 -> Maybe PixelRgb30)
-> IO PixelRgb30 -> IO (Maybe PixelRgb30)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO PixelRgb30 -> IO (Maybe PixelRgb30))
-> (Ptr PixelRgb30 -> IO PixelRgb30)
-> Ptr PixelRgb30
-> IO (Maybe PixelRgb30)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PixelRgb30 -> IO PixelRgb30
forall a. Storable a => Ptr a -> IO a
peek) (Maybe (Ptr PixelRgb30) -> IO (Maybe (Pixel Rgb30)))
-> Maybe (Ptr PixelRgb30) -> IO (Maybe (Pixel Rgb30))
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr PixelRgb30
-> CInt
-> CInt
-> Maybe (Ptr PixelRgb30)
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr PixelRgb30
p CInt
x CInt
y
	generateImagePrimM :: forall (m :: * -> *).
PrimBase m =>
CInt -> CInt -> (CInt -> CInt -> m (Pixel Rgb30)) -> m Rgb30
generateImagePrimM CInt
w CInt
h CInt -> CInt -> m (Pixel Rgb30)
f =
		CairoFormatT -> CInt -> m CInt
forall (m :: * -> *). PrimMonad m => CairoFormatT -> CInt -> m CInt
stride CairoFormatT
CairoFormatRgb30 CInt
w m CInt -> (CInt -> m Rgb30) -> m Rgb30
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
s -> CInt -> CInt -> CInt -> ForeignPtr PixelRgb30 -> Rgb30
Rgb30 CInt
w CInt
h CInt
s (ForeignPtr PixelRgb30 -> Rgb30)
-> m (ForeignPtr PixelRgb30) -> m Rgb30
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt
-> CInt
-> CInt
-> (CInt -> CInt -> m PixelRgb30)
-> m (ForeignPtr PixelRgb30)
forall (m :: * -> *) a.
(PrimBase m, Storable a) =>
CInt -> CInt -> CInt -> (CInt -> CInt -> m a) -> m (ForeignPtr a)
gen CInt
w CInt
h CInt
s CInt -> CInt -> m (Pixel Rgb30)
CInt -> CInt -> m PixelRgb30
f

-- IMAGE MUTABLE

data Rgb30Mut s = Rgb30Mut {
	forall s. Rgb30Mut s -> CInt
rgb30MutWidth :: CInt, forall s. Rgb30Mut s -> CInt
rgb30MutHeight :: CInt,
	forall s. Rgb30Mut s -> CInt
rgb30MutStride :: CInt, forall s. Rgb30Mut s -> ForeignPtr PixelRgb30
rgb30MutData :: ForeignPtr PixelRgb30 }
	deriving Int -> Rgb30Mut s -> ShowS
[Rgb30Mut s] -> ShowS
Rgb30Mut s -> String
(Int -> Rgb30Mut s -> ShowS)
-> (Rgb30Mut s -> String)
-> ([Rgb30Mut s] -> ShowS)
-> Show (Rgb30Mut s)
forall s. Int -> Rgb30Mut s -> ShowS
forall s. [Rgb30Mut s] -> ShowS
forall s. Rgb30Mut s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Int -> Rgb30Mut s -> ShowS
showsPrec :: Int -> Rgb30Mut s -> ShowS
$cshow :: forall s. Rgb30Mut s -> String
show :: Rgb30Mut s -> String
$cshowList :: forall s. [Rgb30Mut s] -> ShowS
showList :: [Rgb30Mut s] -> ShowS
Show

pattern CairoImageMutRgb30 :: Rgb30Mut s -> CairoImageMut s
pattern $bCairoImageMutRgb30 :: forall s. Rgb30Mut s -> CairoImageMut s
$mCairoImageMutRgb30 :: forall {r} {s}.
CairoImageMut s -> (Rgb30Mut s -> r) -> ((# #) -> r) -> r
CairoImageMutRgb30 r <- (cairoImageMutToRgb30 -> Just r)
	where CairoImageMutRgb30 (Rgb30Mut CInt
w CInt
h CInt
s ForeignPtr PixelRgb30
d) =
		CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImageMut s
forall s.
CairoFormatT
-> CInt -> CInt -> CInt -> ForeignPtr CUChar -> CairoImageMut s
CairoImageMut CairoFormatT
CairoFormatRgb30 CInt
w CInt
h CInt
s (ForeignPtr CUChar -> CairoImageMut s)
-> ForeignPtr CUChar -> CairoImageMut s
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelRgb30 -> ForeignPtr CUChar
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr PixelRgb30
d

cairoImageMutToRgb30 :: CairoImageMut s -> Maybe (Rgb30Mut s)
cairoImageMutToRgb30 :: forall s. CairoImageMut s -> Maybe (Rgb30Mut s)
cairoImageMutToRgb30 = \case
	CairoImageMut CairoFormatT
CairoFormatRgb30 CInt
w CInt
h CInt
s ForeignPtr CUChar
d ->
		Rgb30Mut s -> Maybe (Rgb30Mut s)
forall a. a -> Maybe a
Just (Rgb30Mut s -> Maybe (Rgb30Mut s))
-> (ForeignPtr PixelRgb30 -> Rgb30Mut s)
-> ForeignPtr PixelRgb30
-> Maybe (Rgb30Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> ForeignPtr PixelRgb30 -> Rgb30Mut s
forall s.
CInt -> CInt -> CInt -> ForeignPtr PixelRgb30 -> Rgb30Mut s
Rgb30Mut CInt
w CInt
h CInt
s (ForeignPtr PixelRgb30 -> Maybe (Rgb30Mut s))
-> ForeignPtr PixelRgb30 -> Maybe (Rgb30Mut s)
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> ForeignPtr PixelRgb30
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CUChar
d
	CairoImageMut s
_ -> Maybe (Rgb30Mut s)
forall a. Maybe a
Nothing

instance ImageMut Rgb30Mut where
	type PixelMut Rgb30Mut = PixelRgb30
	imageMutSize :: forall s. Rgb30Mut s -> (CInt, CInt)
imageMutSize (Rgb30Mut CInt
w CInt
h CInt
_ ForeignPtr PixelRgb30
_) = (CInt
w, CInt
h)
	getPixel :: forall (m :: * -> *).
PrimMonad m =>
Rgb30Mut (PrimState m)
-> CInt -> CInt -> m (Maybe (PixelMut Rgb30Mut))
getPixel (Rgb30Mut CInt
w CInt
h CInt
s ForeignPtr PixelRgb30
d) CInt
x CInt
y = IO (Maybe (PixelMut Rgb30Mut)) -> m (Maybe (PixelMut Rgb30Mut))
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO (Maybe (PixelMut Rgb30Mut)) -> m (Maybe (PixelMut Rgb30Mut)))
-> IO (Maybe (PixelMut Rgb30Mut)) -> m (Maybe (PixelMut Rgb30Mut))
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelRgb30
-> (Ptr PixelRgb30 -> IO (Maybe (PixelMut Rgb30Mut)))
-> IO (Maybe (PixelMut Rgb30Mut))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelRgb30
d \Ptr PixelRgb30
p ->
		IO (Maybe (PixelMut Rgb30Mut))
-> (Ptr PixelRgb30 -> IO (Maybe (PixelMut Rgb30Mut)))
-> Maybe (Ptr PixelRgb30)
-> IO (Maybe (PixelMut Rgb30Mut))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe PixelRgb30 -> IO (Maybe PixelRgb30)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PixelRgb30
forall a. Maybe a
Nothing) ((PixelRgb30 -> Maybe PixelRgb30
forall a. a -> Maybe a
Just (PixelRgb30 -> Maybe PixelRgb30)
-> IO PixelRgb30 -> IO (Maybe PixelRgb30)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO PixelRgb30 -> IO (Maybe PixelRgb30))
-> (Ptr PixelRgb30 -> IO PixelRgb30)
-> Ptr PixelRgb30
-> IO (Maybe PixelRgb30)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr PixelRgb30 -> IO PixelRgb30
forall a. Storable a => Ptr a -> IO a
peek) (Maybe (Ptr PixelRgb30) -> IO (Maybe (PixelMut Rgb30Mut)))
-> Maybe (Ptr PixelRgb30) -> IO (Maybe (PixelMut Rgb30Mut))
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr PixelRgb30
-> CInt
-> CInt
-> Maybe (Ptr PixelRgb30)
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr PixelRgb30
p CInt
x CInt
y
	putPixel :: forall (m :: * -> *).
PrimMonad m =>
Rgb30Mut (PrimState m) -> CInt -> CInt -> PixelMut Rgb30Mut -> m ()
putPixel (Rgb30Mut CInt
w CInt
h CInt
s ForeignPtr PixelRgb30
d) CInt
x CInt
y PixelMut Rgb30Mut
px = IO () -> m ()
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr PixelRgb30 -> (Ptr PixelRgb30 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with ForeignPtr PixelRgb30
d \Ptr PixelRgb30
p ->
		IO ()
-> (Ptr (PixelMut Rgb30Mut) -> IO ())
-> Maybe (Ptr (PixelMut Rgb30Mut))
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Ptr (PixelMut Rgb30Mut) -> PixelMut Rgb30Mut -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
`poke` PixelMut Rgb30Mut
px) (Maybe (Ptr (PixelMut Rgb30Mut)) -> IO ())
-> Maybe (Ptr (PixelMut Rgb30Mut)) -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt
-> CInt
-> CInt
-> Ptr (PixelMut Rgb30Mut)
-> CInt
-> CInt
-> Maybe (Ptr (PixelMut Rgb30Mut))
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr (PixelMut Rgb30Mut)
Ptr PixelRgb30
p CInt
x CInt
y
	newImageMut :: forall (m :: * -> *).
PrimMonad m =>
CInt -> CInt -> m (Rgb30Mut (PrimState m))
newImageMut CInt
w CInt
h =
		CairoFormatT -> CInt -> m CInt
forall (m :: * -> *). PrimMonad m => CairoFormatT -> CInt -> m CInt
stride CairoFormatT
CairoFormatRgb30 CInt
w m CInt
-> (CInt -> m (Rgb30Mut (PrimState m)))
-> m (Rgb30Mut (PrimState m))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
s -> CInt
-> CInt -> CInt -> ForeignPtr PixelRgb30 -> Rgb30Mut (PrimState m)
forall s.
CInt -> CInt -> CInt -> ForeignPtr PixelRgb30 -> Rgb30Mut s
Rgb30Mut CInt
w CInt
h CInt
s (ForeignPtr PixelRgb30 -> Rgb30Mut (PrimState m))
-> m (ForeignPtr PixelRgb30) -> m (Rgb30Mut (PrimState m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CInt -> m (ForeignPtr PixelRgb30)
forall (m :: * -> *) a.
PrimMonad m =>
CInt -> CInt -> m (ForeignPtr a)
new CInt
s CInt
h