--------------------------------------------------------------------------------
-- Module      : Data.Bitmap.Pure.Pixels
-- Version     : 0.0.2
-- License     : BSD3
-- Copyright   : (c) 2009-2010 Balazs Komuves
-- Author      : Balazs Komuves
-- Maintainer  : bkomuves (plus) hackage (at) gmail (dot) com
-- Stability   : experimental
-- Portability : requires FFI and CPP
-- Tested with : GHC 6.10.1
--------------------------------------------------------------------------------

-- | Access to individual pixels. It isn't very efficient to handle bitmaps this way. 

{-# 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

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

-- | Note that the resulting pointer is valid only within a line (because of the padding)
withComponentPtr 
  :: PixelComponent t 
  => Bitmap t       -- ^ the bitmap
  -> Offset           -- ^ position (x,y)
  -> Int              -- ^ channel index {0,1,...,nchannels-1}
  -> (Ptr t -> IO a)  -- ^ user action
  -> 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

--------------------------------------------------------------------------------
        
-- | Newtypes for bitmaps with a fixed number of channels (components per pixel) 
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

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

-- | It is not very efficient to read\/write lots of pixels this way.
unsafeReadComponent 
  :: PixelComponent t 
  => Bitmap t      -- ^ the bitmap
  -> Offset        -- ^ position (x,y)
  -> Int           -- ^ channel index {0,1,...,nchannels-1}
  -> 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

-- | Please note that the component array to read shouldn't cross 
-- the boundary between lines.
unsafeReadComponents
  :: PixelComponent t 
  => Bitmap t      -- ^ the bitmap
  -> Offset        -- ^ position (x,y)
  -> Int           -- ^ channel index {0,1,...,nchannels-1}
  -> Int           -- ^ the number of components to read
  -> [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      -- ^ the bitmap
  -> Offset        -- ^ position (x,y)
  -> [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
  
--------------------------------------------------------------------------------

-- restricted type
{-# 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

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