{-# LANGUAGE CPP, ForeignFunctionInterface #-}
module Data.Bitmap.IO.Pixels
(
IOBitmap1
, IOBitmap2
, IOBitmap3
, IOBitmap4
, ioBitmap1
, ioBitmap2
, ioBitmap3
, ioBitmap4
, fromIOBitmap1
, fromIOBitmap2
, fromIOBitmap3
, fromIOBitmap4
, withComponentPtr
, unsafeReadComponent
, unsafeWriteComponent
, unsafeReadComponents
, unsafeWriteComponents
, unsafeReadPixel
, unsafeReadPixel1
, unsafeReadPixel2
, unsafeReadPixel3
, unsafeReadPixel4
, unsafeWritePixel1
, unsafeWritePixel2
, unsafeWritePixel3
, unsafeWritePixel4
)
where
import Control.Monad
import Control.Applicative
import Data.Word
import Foreign.C
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable
import Foreign.Marshal
import Data.Bitmap.Internal
import Data.Bitmap.Base
import Data.Bitmap.IO
withComponentPtr
:: PixelComponent t
=> IOBitmap t
-> Offset
-> Int
-> (Ptr t -> IO a)
-> IO a
withComponentPtr :: IOBitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr (IOBitmap Bitmap t
bm) (Int
x,Int
y) Int
ofs Ptr t -> IO a
action =
ForeignPtr t -> (Ptr t -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Bitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr Bitmap t
bm) ((Ptr t -> IO a) -> IO a) -> (Ptr t -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr t
p -> do
let nchn :: Int
nchn = Bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels Bitmap t
bm
rowsize :: Int
rowsize = Bitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes Bitmap t
bm
q :: Ptr t
q = Ptr t
p Ptr t -> Int -> Ptr t
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` ( ( Int
nchnInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ofs ) Int -> Int -> Int
forall a. Num a => a -> a -> a
* t -> Int
forall a. Storable a => a -> Int
sizeOf (Bitmap t -> t
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> t
bitmapUndefined Bitmap t
bm) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rowsize )
Ptr t -> IO a
action Ptr t
q
unsafeReadComponent
:: PixelComponent t
=> IOBitmap t
-> Offset
-> Int
-> IO t
unsafeReadComponent :: IOBitmap t -> Offset -> Int -> IO t
unsafeReadComponent IOBitmap t
bm Offset
xy Int
ofs = IOBitmap t -> Offset -> Int -> (Ptr t -> IO t) -> IO t
forall t a.
PixelComponent t =>
IOBitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr IOBitmap t
bm Offset
xy Int
ofs ((Ptr t -> IO t) -> IO t) -> (Ptr t -> IO t) -> IO t
forall a b. (a -> b) -> a -> b
$ Ptr t -> IO t
forall a. Storable a => Ptr a -> IO a
peek
unsafeWriteComponent
:: PixelComponent t
=> IOBitmap t
-> Offset
-> Int
-> t
-> IO ()
unsafeWriteComponent :: IOBitmap t -> Offset -> Int -> t -> IO ()
unsafeWriteComponent IOBitmap t
bm Offset
xy Int
ofs t
value = IOBitmap t -> Offset -> Int -> (Ptr t -> IO ()) -> IO ()
forall t a.
PixelComponent t =>
IOBitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr IOBitmap t
bm Offset
xy Int
ofs ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
q -> Ptr t -> t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr t
q t
value
unsafeReadComponents
:: PixelComponent t
=> IOBitmap t
-> Offset
-> Int
-> Int
-> IO [t]
unsafeReadComponents :: IOBitmap t -> Offset -> Int -> Int -> IO [t]
unsafeReadComponents IOBitmap t
bm Offset
xy Int
ofs Int
k = IOBitmap t -> Offset -> Int -> (Ptr t -> IO [t]) -> IO [t]
forall t a.
PixelComponent t =>
IOBitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr IOBitmap t
bm Offset
xy Int
ofs ((Ptr t -> IO [t]) -> IO [t]) -> (Ptr t -> IO [t]) -> IO [t]
forall a b. (a -> b) -> a -> b
$ \Ptr t
p -> Int -> Ptr t -> IO [t]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
k Ptr t
p
unsafeWriteComponents
:: PixelComponent t
=> IOBitmap t
-> Offset
-> Int
-> [t]
-> IO ()
unsafeWriteComponents :: IOBitmap t -> Offset -> Int -> [t] -> IO ()
unsafeWriteComponents IOBitmap t
bm Offset
xy Int
ofs [t]
values = IOBitmap t -> Offset -> Int -> (Ptr t -> IO ()) -> IO ()
forall t a.
PixelComponent t =>
IOBitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr IOBitmap t
bm Offset
xy Int
ofs ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
q -> Ptr t -> [t] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr t
q [t]
values
unsafeReadPixel
:: PixelComponent t
=> IOBitmap t
-> Offset
-> IO [t]
unsafeReadPixel :: IOBitmap t -> Offset -> IO [t]
unsafeReadPixel IOBitmap t
bm Offset
xy = IOBitmap t -> Offset -> Int -> Int -> IO [t]
forall t.
PixelComponent t =>
IOBitmap t -> Offset -> Int -> Int -> IO [t]
unsafeReadComponents IOBitmap t
bm Offset
xy Int
0 (IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm)
instance BitmapClass IOBitmap1 where
underlyingBitmap :: IOBitmap1 t -> Bitmap t
underlyingBitmap = IOBitmap t -> Bitmap t
forall t. IOBitmap t -> Bitmap t
unIOBitmap (IOBitmap t -> Bitmap t)
-> (IOBitmap1 t -> IOBitmap t) -> IOBitmap1 t -> Bitmap t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOBitmap1 t -> IOBitmap t
forall t. IOBitmap1 t -> IOBitmap t
fromIOBitmap1
instance BitmapClass IOBitmap2 where
underlyingBitmap :: IOBitmap2 t -> Bitmap t
underlyingBitmap = IOBitmap t -> Bitmap t
forall t. IOBitmap t -> Bitmap t
unIOBitmap (IOBitmap t -> Bitmap t)
-> (IOBitmap2 t -> IOBitmap t) -> IOBitmap2 t -> Bitmap t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOBitmap2 t -> IOBitmap t
forall t. IOBitmap2 t -> IOBitmap t
fromIOBitmap2
instance BitmapClass IOBitmap3 where
underlyingBitmap :: IOBitmap3 t -> Bitmap t
underlyingBitmap = IOBitmap t -> Bitmap t
forall t. IOBitmap t -> Bitmap t
unIOBitmap (IOBitmap t -> Bitmap t)
-> (IOBitmap3 t -> IOBitmap t) -> IOBitmap3 t -> Bitmap t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOBitmap3 t -> IOBitmap t
forall t. IOBitmap3 t -> IOBitmap t
fromIOBitmap3
instance BitmapClass IOBitmap4 where
underlyingBitmap :: IOBitmap4 t -> Bitmap t
underlyingBitmap = IOBitmap t -> Bitmap t
forall t. IOBitmap t -> Bitmap t
unIOBitmap (IOBitmap t -> Bitmap t)
-> (IOBitmap4 t -> IOBitmap t) -> IOBitmap4 t -> Bitmap t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOBitmap4 t -> IOBitmap t
forall t. IOBitmap4 t -> IOBitmap t
fromIOBitmap4
newtype IOBitmap1 t = IOBitmap1 { IOBitmap1 t -> IOBitmap t
fromIOBitmap1 :: IOBitmap t }
newtype IOBitmap2 t = IOBitmap2 { IOBitmap2 t -> IOBitmap t
fromIOBitmap2 :: IOBitmap t }
newtype IOBitmap3 t = IOBitmap3 { IOBitmap3 t -> IOBitmap t
fromIOBitmap3 :: IOBitmap t }
newtype IOBitmap4 t = IOBitmap4 { IOBitmap4 t -> IOBitmap t
fromIOBitmap4 :: IOBitmap t }
ioBitmap1 :: IOBitmap t -> IOBitmap1 t
ioBitmap2 :: IOBitmap t -> IOBitmap2 t
ioBitmap3 :: IOBitmap t -> IOBitmap3 t
ioBitmap4 :: IOBitmap t -> IOBitmap4 t
ioBitmap1 :: IOBitmap t -> IOBitmap1 t
ioBitmap1 IOBitmap t
bm = if IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then IOBitmap t -> IOBitmap1 t
forall t. IOBitmap t -> IOBitmap1 t
IOBitmap1 IOBitmap t
bm else [Char] -> IOBitmap1 t
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/ioBitmap1: number of channels is not 1"
ioBitmap2 :: IOBitmap t -> IOBitmap2 t
ioBitmap2 IOBitmap t
bm = if IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 then IOBitmap t -> IOBitmap2 t
forall t. IOBitmap t -> IOBitmap2 t
IOBitmap2 IOBitmap t
bm else [Char] -> IOBitmap2 t
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/ioBitmap2: number of channels is not 2"
ioBitmap3 :: IOBitmap t -> IOBitmap3 t
ioBitmap3 IOBitmap t
bm = if IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 then IOBitmap t -> IOBitmap3 t
forall t. IOBitmap t -> IOBitmap3 t
IOBitmap3 IOBitmap t
bm else [Char] -> IOBitmap3 t
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/ioBitmap3: number of channels is not 3"
ioBitmap4 :: IOBitmap t -> IOBitmap4 t
ioBitmap4 IOBitmap t
bm = if IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 then IOBitmap t -> IOBitmap4 t
forall t. IOBitmap t -> IOBitmap4 t
IOBitmap4 IOBitmap t
bm else [Char] -> IOBitmap4 t
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/ioBitmap4: number of channels is not 4"
unsafeReadPixel1 :: PixelComponent t => IOBitmap1 t -> Offset -> IO t
unsafeReadPixel2 :: PixelComponent t => IOBitmap2 t -> Offset -> IO (t,t)
unsafeReadPixel3 :: PixelComponent t => IOBitmap3 t -> Offset -> IO (t,t,t)
unsafeReadPixel4 :: PixelComponent t => IOBitmap4 t -> Offset -> IO (t,t,t,t)
unsafeWritePixel1 :: PixelComponent t => IOBitmap1 t -> Offset -> t -> IO ()
unsafeWritePixel2 :: PixelComponent t => IOBitmap2 t -> Offset -> (t,t) -> IO ()
unsafeWritePixel3 :: PixelComponent t => IOBitmap3 t -> Offset -> (t,t,t) -> IO ()
unsafeWritePixel4 :: PixelComponent t => IOBitmap4 t -> Offset -> (t,t,t,t) -> IO ()
unsafeReadPixel1 :: IOBitmap1 t -> Offset -> IO t
unsafeReadPixel1 IOBitmap1 t
bm Offset
xy = IOBitmap t -> Offset -> Int -> (Ptr t -> IO t) -> IO t
forall t a.
PixelComponent t =>
IOBitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr (IOBitmap1 t -> IOBitmap t
forall t. IOBitmap1 t -> IOBitmap t
fromIOBitmap1 IOBitmap1 t
bm) Offset
xy Int
0 ((Ptr t -> IO t) -> IO t) -> (Ptr t -> IO t) -> IO t
forall a b. (a -> b) -> a -> b
$ \Ptr t
p -> ([t] -> t) -> IO [t] -> IO t
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\[t
x] -> t
x ) (IO [t] -> IO t) -> IO [t] -> IO t
forall a b. (a -> b) -> a -> b
$ Int -> Ptr t -> IO [t]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
1 Ptr t
p
unsafeReadPixel2 :: IOBitmap2 t -> Offset -> IO (t, t)
unsafeReadPixel2 IOBitmap2 t
bm Offset
xy = IOBitmap t -> Offset -> Int -> (Ptr t -> IO (t, t)) -> IO (t, t)
forall t a.
PixelComponent t =>
IOBitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr (IOBitmap2 t -> IOBitmap t
forall t. IOBitmap2 t -> IOBitmap t
fromIOBitmap2 IOBitmap2 t
bm) Offset
xy Int
0 ((Ptr t -> IO (t, t)) -> IO (t, t))
-> (Ptr t -> IO (t, t)) -> IO (t, t)
forall a b. (a -> b) -> a -> b
$ \Ptr t
p -> ([t] -> (t, t)) -> IO [t] -> IO (t, t)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\[t
x,t
y] -> (t
x,t
y) ) (IO [t] -> IO (t, t)) -> IO [t] -> IO (t, t)
forall a b. (a -> b) -> a -> b
$ Int -> Ptr t -> IO [t]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
2 Ptr t
p
unsafeReadPixel3 :: IOBitmap3 t -> Offset -> IO (t, t, t)
unsafeReadPixel3 IOBitmap3 t
bm Offset
xy = IOBitmap t
-> Offset -> Int -> (Ptr t -> IO (t, t, t)) -> IO (t, t, t)
forall t a.
PixelComponent t =>
IOBitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr (IOBitmap3 t -> IOBitmap t
forall t. IOBitmap3 t -> IOBitmap t
fromIOBitmap3 IOBitmap3 t
bm) Offset
xy Int
0 ((Ptr t -> IO (t, t, t)) -> IO (t, t, t))
-> (Ptr t -> IO (t, t, t)) -> IO (t, t, t)
forall a b. (a -> b) -> a -> b
$ \Ptr t
p -> ([t] -> (t, t, t)) -> IO [t] -> IO (t, t, t)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\[t
x,t
y,t
z] -> (t
x,t
y,t
z) ) (IO [t] -> IO (t, t, t)) -> IO [t] -> IO (t, t, t)
forall a b. (a -> b) -> a -> b
$ Int -> Ptr t -> IO [t]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
3 Ptr t
p
unsafeReadPixel4 :: IOBitmap4 t -> Offset -> IO (t, t, t, t)
unsafeReadPixel4 IOBitmap4 t
bm Offset
xy = IOBitmap t
-> Offset -> Int -> (Ptr t -> IO (t, t, t, t)) -> IO (t, t, t, t)
forall t a.
PixelComponent t =>
IOBitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr (IOBitmap4 t -> IOBitmap t
forall t. IOBitmap4 t -> IOBitmap t
fromIOBitmap4 IOBitmap4 t
bm) Offset
xy Int
0 ((Ptr t -> IO (t, t, t, t)) -> IO (t, t, t, t))
-> (Ptr t -> IO (t, t, t, t)) -> IO (t, t, t, t)
forall a b. (a -> b) -> a -> b
$ \Ptr t
p -> ([t] -> (t, t, t, t)) -> IO [t] -> IO (t, t, t, t)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\[t
x,t
y,t
z,t
w] -> (t
x,t
y,t
z,t
w)) (IO [t] -> IO (t, t, t, t)) -> IO [t] -> IO (t, t, t, t)
forall a b. (a -> b) -> a -> b
$ Int -> Ptr t -> IO [t]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
4 Ptr t
p
unsafeWritePixel1 :: IOBitmap1 t -> Offset -> t -> IO ()
unsafeWritePixel1 IOBitmap1 t
bm Offset
xy t
x = IOBitmap t -> Offset -> Int -> (Ptr t -> IO ()) -> IO ()
forall t a.
PixelComponent t =>
IOBitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr (IOBitmap1 t -> IOBitmap t
forall t. IOBitmap1 t -> IOBitmap t
fromIOBitmap1 IOBitmap1 t
bm) Offset
xy Int
0 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
q -> Ptr t -> [t] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr t
q [t
x]
unsafeWritePixel2 :: IOBitmap2 t -> Offset -> (t, t) -> IO ()
unsafeWritePixel2 IOBitmap2 t
bm Offset
xy (t
x,t
y) = IOBitmap t -> Offset -> Int -> (Ptr t -> IO ()) -> IO ()
forall t a.
PixelComponent t =>
IOBitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr (IOBitmap2 t -> IOBitmap t
forall t. IOBitmap2 t -> IOBitmap t
fromIOBitmap2 IOBitmap2 t
bm) Offset
xy Int
0 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
q -> Ptr t -> [t] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr t
q [t
x,t
y]
unsafeWritePixel3 :: IOBitmap3 t -> Offset -> (t, t, t) -> IO ()
unsafeWritePixel3 IOBitmap3 t
bm Offset
xy (t
x,t
y,t
z) = IOBitmap t -> Offset -> Int -> (Ptr t -> IO ()) -> IO ()
forall t a.
PixelComponent t =>
IOBitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr (IOBitmap3 t -> IOBitmap t
forall t. IOBitmap3 t -> IOBitmap t
fromIOBitmap3 IOBitmap3 t
bm) Offset
xy Int
0 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
q -> Ptr t -> [t] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr t
q [t
x,t
y,t
z]
unsafeWritePixel4 :: IOBitmap4 t -> Offset -> (t, t, t, t) -> IO ()
unsafeWritePixel4 IOBitmap4 t
bm Offset
xy (t
x,t
y,t
z,t
w) = IOBitmap t -> Offset -> Int -> (Ptr t -> IO ()) -> IO ()
forall t a.
PixelComponent t =>
IOBitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr (IOBitmap4 t -> IOBitmap t
forall t. IOBitmap4 t -> IOBitmap t
fromIOBitmap4 IOBitmap4 t
bm) Offset
xy Int
0 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
q -> Ptr t -> [t] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr t
q [t
x,t
y,t
z,t
w]
{-# SPECIALIZE myPlusPtr :: Ptr Word8 -> Int -> Ptr Word8 #-}
{-# SPECIALIZE myPlusPtr :: Ptr Float -> Int -> Ptr Float #-}
myPlusPtr :: Ptr a -> Int -> Ptr a
myPlusPtr :: Ptr a -> Int -> Ptr a
myPlusPtr = Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
plusPtr