{-# LANGUAGE CPP #-}
module Data.Bitmap.Pure.Pixels
(
Bitmap1, Bitmap2, Bitmap3, Bitmap4
, bitmap1, bitmap2, bitmap3, bitmap4
, unsafeReadComponent
, unsafeReadComponents
, unsafeReadPixel
, unsafeReadPixel1
, unsafeReadPixel2
, unsafeReadPixel3
, unsafeReadPixel4
)
where
import Control.Monad
import Control.Applicative
import Data.Word
import Foreign hiding (unsafePerformIO)
import Data.Bitmap.Base
import Data.Bitmap.Internal
import System.IO.Unsafe
withComponentPtr
:: PixelComponent t
=> Bitmap t
-> Offset
-> Int
-> (Ptr t -> IO a)
-> IO a
withComponentPtr :: Bitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr 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
newtype Bitmap1 t = Bitmap1 { Bitmap1 t -> Bitmap t
fromBitmap1 :: Bitmap t }
newtype Bitmap2 t = Bitmap2 { Bitmap2 t -> Bitmap t
fromBitmap2 :: Bitmap t }
newtype Bitmap3 t = Bitmap3 { Bitmap3 t -> Bitmap t
fromBitmap3 :: Bitmap t }
newtype Bitmap4 t = Bitmap4 { Bitmap4 t -> Bitmap t
fromBitmap4 :: Bitmap t }
bitmap1 :: Bitmap t -> Bitmap1 t
bitmap2 :: Bitmap t -> Bitmap2 t
bitmap3 :: Bitmap t -> Bitmap3 t
bitmap4 :: Bitmap t -> Bitmap4 t
bitmap1 :: Bitmap t -> Bitmap1 t
bitmap1 Bitmap t
bm = if Bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels Bitmap t
bm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Bitmap t -> Bitmap1 t
forall t. Bitmap t -> Bitmap1 t
Bitmap1 Bitmap t
bm else [Char] -> Bitmap1 t
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/bitmap1: number of channels is not 1"
bitmap2 :: Bitmap t -> Bitmap2 t
bitmap2 Bitmap t
bm = if Bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels Bitmap t
bm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 then Bitmap t -> Bitmap2 t
forall t. Bitmap t -> Bitmap2 t
Bitmap2 Bitmap t
bm else [Char] -> Bitmap2 t
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/bitmap2: number of channels is not 2"
bitmap3 :: Bitmap t -> Bitmap3 t
bitmap3 Bitmap t
bm = if Bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels Bitmap t
bm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 then Bitmap t -> Bitmap3 t
forall t. Bitmap t -> Bitmap3 t
Bitmap3 Bitmap t
bm else [Char] -> Bitmap3 t
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/bitmap3: number of channels is not 3"
bitmap4 :: Bitmap t -> Bitmap4 t
bitmap4 Bitmap t
bm = if Bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels Bitmap t
bm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 then Bitmap t -> Bitmap4 t
forall t. Bitmap t -> Bitmap4 t
Bitmap4 Bitmap t
bm else [Char] -> Bitmap4 t
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/bitmap4: number of channels is not 4"
instance BitmapClass Bitmap1 where
underlyingBitmap :: Bitmap1 t -> Bitmap t
underlyingBitmap = Bitmap1 t -> Bitmap t
forall t. Bitmap1 t -> Bitmap t
fromBitmap1
instance BitmapClass Bitmap2 where
underlyingBitmap :: Bitmap2 t -> Bitmap t
underlyingBitmap = Bitmap2 t -> Bitmap t
forall t. Bitmap2 t -> Bitmap t
fromBitmap2
instance BitmapClass Bitmap3 where
underlyingBitmap :: Bitmap3 t -> Bitmap t
underlyingBitmap = Bitmap3 t -> Bitmap t
forall t. Bitmap3 t -> Bitmap t
fromBitmap3
instance BitmapClass Bitmap4 where
underlyingBitmap :: Bitmap4 t -> Bitmap t
underlyingBitmap = Bitmap4 t -> Bitmap t
forall t. Bitmap4 t -> Bitmap t
fromBitmap4
unsafeReadComponent
:: PixelComponent t
=> Bitmap t
-> Offset
-> Int
-> t
unsafeReadComponent :: Bitmap t -> Offset -> Int -> t
unsafeReadComponent Bitmap t
bm Offset
xy Int
ofs = IO t -> t
forall a. IO a -> a
unsafePerformIO (IO t -> t) -> IO t -> t
forall a b. (a -> b) -> a -> b
$ Bitmap t -> Offset -> Int -> (Ptr t -> IO t) -> IO t
forall t a.
PixelComponent t =>
Bitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr Bitmap 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
unsafeReadComponents
:: PixelComponent t
=> Bitmap t
-> Offset
-> Int
-> Int
-> [t]
unsafeReadComponents :: Bitmap t -> Offset -> Int -> Int -> [t]
unsafeReadComponents Bitmap t
bm Offset
xy Int
ofs Int
k = IO [t] -> [t]
forall a. IO a -> a
unsafePerformIO (IO [t] -> [t]) -> IO [t] -> [t]
forall a b. (a -> b) -> a -> b
$ Bitmap t -> Offset -> Int -> (Ptr t -> IO [t]) -> IO [t]
forall t a.
PixelComponent t =>
Bitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr Bitmap 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
unsafeReadPixel
:: PixelComponent t
=> Bitmap t
-> Offset
-> [t]
unsafeReadPixel :: Bitmap t -> Offset -> [t]
unsafeReadPixel Bitmap t
bm Offset
xy = Bitmap t -> Offset -> Int -> Int -> [t]
forall t.
PixelComponent t =>
Bitmap t -> Offset -> Int -> Int -> [t]
unsafeReadComponents Bitmap t
bm Offset
xy Int
0 (Bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels Bitmap t
bm)
unsafeReadPixel1 :: PixelComponent t => Bitmap1 t -> Offset -> t
unsafeReadPixel2 :: PixelComponent t => Bitmap2 t -> Offset -> (t,t)
unsafeReadPixel3 :: PixelComponent t => Bitmap3 t -> Offset -> (t,t,t)
unsafeReadPixel4 :: PixelComponent t => Bitmap4 t -> Offset -> (t,t,t,t)
unsafeReadPixel1 :: Bitmap1 t -> Offset -> t
unsafeReadPixel1 Bitmap1 t
bm Offset
xy = IO t -> t
forall a. IO a -> a
unsafePerformIO (IO t -> t) -> IO t -> t
forall a b. (a -> b) -> a -> b
$
Bitmap t -> Offset -> Int -> (Ptr t -> IO t) -> IO t
forall t a.
PixelComponent t =>
Bitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr (Bitmap1 t -> Bitmap t
forall t. Bitmap1 t -> Bitmap t
fromBitmap1 Bitmap1 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 :: Bitmap2 t -> Offset -> (t, t)
unsafeReadPixel2 Bitmap2 t
bm Offset
xy = IO (t, t) -> (t, t)
forall a. IO a -> a
unsafePerformIO (IO (t, t) -> (t, t)) -> IO (t, t) -> (t, t)
forall a b. (a -> b) -> a -> b
$
Bitmap t -> Offset -> Int -> (Ptr t -> IO (t, t)) -> IO (t, t)
forall t a.
PixelComponent t =>
Bitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr (Bitmap2 t -> Bitmap t
forall t. Bitmap2 t -> Bitmap t
fromBitmap2 Bitmap2 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 :: Bitmap3 t -> Offset -> (t, t, t)
unsafeReadPixel3 Bitmap3 t
bm Offset
xy = IO (t, t, t) -> (t, t, t)
forall a. IO a -> a
unsafePerformIO (IO (t, t, t) -> (t, t, t)) -> IO (t, t, t) -> (t, t, t)
forall a b. (a -> b) -> a -> b
$
Bitmap t
-> Offset -> Int -> (Ptr t -> IO (t, t, t)) -> IO (t, t, t)
forall t a.
PixelComponent t =>
Bitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr (Bitmap3 t -> Bitmap t
forall t. Bitmap3 t -> Bitmap t
fromBitmap3 Bitmap3 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 :: Bitmap4 t -> Offset -> (t, t, t, t)
unsafeReadPixel4 Bitmap4 t
bm Offset
xy = IO (t, t, t, t) -> (t, t, t, t)
forall a. IO a -> a
unsafePerformIO (IO (t, t, t, t) -> (t, t, t, t))
-> IO (t, t, t, t) -> (t, t, t, t)
forall a b. (a -> b) -> a -> b
$
Bitmap t
-> Offset -> Int -> (Ptr t -> IO (t, t, t, t)) -> IO (t, t, t, t)
forall t a.
PixelComponent t =>
Bitmap t -> Offset -> Int -> (Ptr t -> IO a) -> IO a
withComponentPtr (Bitmap4 t -> Bitmap t
forall t. Bitmap4 t -> Bitmap t
fromBitmap4 Bitmap4 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
{-# 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