--------------------------------------------------------------------------------
-- Module      : Data.Bitmap.IO
-- 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
--------------------------------------------------------------------------------

-- | The full, mutable API in the IO monad.

{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# CFILES cbits/bm.c #-}  -- for Hugs 
module Data.Bitmap.IO
  ( 
    module Data.Bitmap.Base
    -- * Mutable bitmap type
  , IOBitmap
  , IOBitmapChannel
  , unsafeFreezeBitmap
  , unsafeThawBitmap
    -- * Creating and accessing bitmaps
  , emptyBitmap
  , cloneBitmap
  , emptyCloneBitmap
  , createSingleChannelBitmap
  , newIOBitmap
  , newIOBitmapUninitialized
  , copyBitmapFromPtr
  -- , bitmapFromForeignPtrUnsafe
  , ioBitmapFromForeignPtrUnsafe
    -- * Using bitmaps
  , withIOBitmap
    -- * Mapping over bitmaps
  , componentMap
  , componentMap'
  , componentMapInPlace
    -- * Cropping and extending
  , copySubImage
  , copySubImage'  
  , copySubImageInto
    -- * Flipping and mirroring
  , flipBitmap
  , flipBitmapInPlace
  , mirrorBitmap
  , mirrorBitmapInPlace
    -- * Cast
  , castBitmap
  -- , castChannel
  -- , castChannelInto
    -- * Manipulating channels
  , combineChannels 
  , extractChannels 
  , extractSingleChannel 
  , extractChannelInto
    -- * Bilinear resampling
  , bilinearResample
  , bilinearResampleChannel
  , bilinearResampleChannelInto
    -- * Blending
  , blendBitmaps
  , blendChannels
  , blendChannelsInto
    -- * Gamma correction
  , powerlawGammaCorrection
  , powerlawGammaCorrectionChannel  
  , powerlawGammaCorrectionChannelInto  
{-  
    -- * Conversion to\/from ByteString
  , copyBitmapToByteString
  , copyBitmapFromByteString
-}  
{-
    -- * Reading and writing pixels
  , withComponentPtr
  , IOBitmap1 (..)
  , IOBitmap2 (..)
  , IOBitmap3 (..)
  , IOBitmap4 (..)
  , unsafeReadComponent
  , unsafeWriteComponent
  , unsafeReadComponents
  , unsafeWriteComponents
  , unsafeReadPixel
  , unsafeReadPixel1
  , unsafeReadPixel2
  , unsafeReadPixel3
  , unsafeReadPixel4
  , unsafeWritePixel1
  , unsafeWritePixel2
  , unsafeWritePixel3
  , unsafeWritePixel4
-}
  ) 
  where
  
--------------------------------------------------------------------------------

import Control.Monad
import Control.Applicative

--import Data.Array.IArray

import Data.Word
import Data.List (nub)

import Foreign.C
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable
import Foreign.Marshal

import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B

import Data.Bitmap.Internal
import Data.Bitmap.Base

--------------------------------------------------------------------------------
  
unsafeFreezeBitmap :: IOBitmap t -> Bitmap t  
unsafeFreezeBitmap = unIOBitmap

unsafeThawBitmap :: Bitmap t -> IOBitmap t
unsafeThawBitmap = IOBitmap

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

defaultAlignment :: Int
defaultAlignment = 4

validateMaybeAlignment :: Maybe Alignment -> Alignment
validateMaybeAlignment = maybe defaultAlignment validateAlignment

validateAlignment :: Alignment -> Alignment
validateAlignment k = 
  if isValidAlignment k 
    then k 
    else error "invalid row alignment (allowed values: 1, 2, 4, and 8)" -- and 16)"
  
--------------------------------------------------------------------------------

-- GHC's type inference is acting up, that's why we need this here
allocBitmap :: PixelComponent t => Bitmap t -> IO (Bitmap t)
allocBitmap bm0 = do
  fptr <- mallocForeignPtrBytes (bitmapSizeInBytes bm0) -- :: IO (ForeignPtr t)
  return $ bm0 { _bitmapPtr = fptr }

allocIOBitmap :: PixelComponent t => IOBitmap t -> IO (IOBitmap t)
allocIOBitmap bm = IOBitmap <$> (allocBitmap $ unIOBitmap bm)

-- we do not initialize the new bitmap!
newBitmapRaw :: PixelComponent t => Size -> NChn -> Padding -> Alignment -> IO (IOBitmap t)   
newBitmapRaw siz nchn pad align = do
  let bm0 = Bitmap 
        { _bitmapSize = siz
        , _bitmapNChannels = nchn
        , _bitmapPtr = undefined 
        , _bitmapRowPadding = pad
        , _bitmapRowAlignment = align
        } -- :: Bitmap t
{-        
  let len = bitmapSizeInBytes bm0      
  fptr <- mallocForeignPtrBytes len -- :: IO (ForeignPtr t)
  return $ bm0 { bitmapPtr = fptr }
-}
  IOBitmap <$> allocBitmap bm0
   
-- | Note: we /cannot/ guarantee the alignment
-- of the memory block (but typically it is aligned at least to machine word boundary),
-- but what we /can/ guarantee is that the rows are properly padded.
--
-- At the moment, the default alignment is 4, valid alignments are 1, 2, 4, 8 and 16,
-- and the padding method is compatible with the OpenGL one (that is, the padding is the
-- smallest multiple of a component size such that the next row is aligned).
-- 
-- The resulting new bitmap is filled with zeros.
newIOBitmap 
  :: PixelComponent t 
  => Size             -- ^ (width,height)
  -> NChn             -- ^ number of channels (components\/pixel)
  -> Maybe Alignment  -- ^ the row alignment of the new image
  -> IO (IOBitmap t)
newIOBitmap siz nchn malign = do  
  bm <- newIOBitmapUninitialized siz nchn malign -- :: IO (Bitmap t)
  let fptr = bitmapPtr bm
      len  = bitmapSizeInBytes bm
  withForeignPtr fptr $ \p -> c_memset (castPtr p) len 0
  return bm

allocBitmapWithRecommendedPadding :: PixelComponent t => Bitmap t -> IO (Bitmap t)
allocBitmapWithRecommendedPadding bm0 = 
  allocBitmap $ 
    bm0 { _bitmapRowPadding = recommendedPadding bm0 } 
  
newIOBitmapUninitialized :: PixelComponent t => Size -> NChn -> Maybe Alignment -> IO (IOBitmap t)
newIOBitmapUninitialized siz nchn malign = do
  let align = validateMaybeAlignment malign
      bm0 = Bitmap 
        { _bitmapSize = siz
        , _bitmapNChannels = nchn
        , _bitmapPtr = undefined 
        , _bitmapRowPadding = undefined -- pad
        , _bitmapRowAlignment = align
        } -- :: Bitmap t
{-      
  let pad = recommendedPadding bm0
  newBitmapRaw siz nchn pad align
-}
  bm <- allocBitmapWithRecommendedPadding bm0
  return (IOBitmap bm)

-- | Creates a new single-channel bitmap, using the given function to compute
-- the pixel values.
-- Warning, this is probably slow!  
createSingleChannelBitmap 
  :: PixelComponent t 
  => Size               -- ^ (width,height)
  -> Maybe Alignment    -- ^ the row alignment of the new image
  -> (Int -> Int -> t)  -- ^ the function we will use to fill the bitmap
  -> IO (IOBitmap t)
createSingleChannelBitmap siz malign fun = do  
  bm <- newIOBitmapUninitialized siz 1 malign 
  let fptr = bitmapPtr bm
      len  = bitmapSizeInBytes bm
      -- f :: Int -> Int -> t -> t
      f x y _ = fun x y 
  genericComponentMapWithPos f bm bm
  return bm

{-    
createBitmap    
  :: PixelComponent t 
  => Size               -- ^ (width,height)
  -> Maybe Alignment    -- ^ the row alignment of the new image
  -> [Int -> Int -> t]  -- ^ the functions we will use to fill the bitmap
  -> IO (Bitmap t)
createBitmap siz malign funs = do 
  let nchn = length funs 
  bm <- newIOBitmapUninitialized siz nchn malign 
  let fptr = bitmapPtr bm
      len  = bitmapSizeInBytes bm
      f :: Int -> Int -> t -> t
      f x y _ = fun x y 
  genericComponentMapWithPos f bm bm
  return bm
-}
    
copyBitmapFromPtr 
  :: PixelComponent t 
  => Size       -- ^ (width,height) of the source
  -> NChn       -- ^ number of channels in the source 
  -> Padding    -- ^ source padding
  -> Ptr t      -- ^ the source
  -> Maybe Alignment  -- ^ target alignment
  -> IO (IOBitmap t)
copyBitmapFromPtr siz@(w,h) nchn srcpad srcptr tgtmalign = do
  bm <- newIOBitmapUninitialized siz nchn tgtmalign
  withIOBitmap bm $ \_ _ _ tgtptr -> do
    let pure_line = bitmapUnpaddedRowSizeInBytes bm
        src_line  = pure_line + srcpad
        tgt_line  = bitmapPaddedRowSizeInBytes bm
    forM_ [0..h-1] $ \y -> do
      let p = srcptr `myPlusPtr` (y*src_line)
          q = tgtptr `myPlusPtr` (y*tgt_line)
      c_memcpy (castPtr p) (castPtr q) pure_line 
  return bm

ioBitmapFromForeignPtrUnsafe 
  :: PixelComponent t 
  => Size -> NChn -> Alignment -> Padding -> ForeignPtr t -> IOBitmap t
ioBitmapFromForeignPtrUnsafe siz nchn align pad fptr = IOBitmap $ 
  bitmapFromForeignPtrUnsafe siz nchn align pad fptr
        
-- | @withIOBitmap bitmap $ \\(w,h) nchn padding ptr -> ...@
withIOBitmap :: PixelComponent t => IOBitmap t -> (Size -> NChn -> Padding -> Ptr t -> IO a) -> IO a
withIOBitmap (IOBitmap bm) action = 
  withForeignPtr (bitmapPtr bm) $ \p -> 
    action (bitmapSize bm) (bitmapNChannels bm) (bitmapRowPadding bm) p

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

{-

-- | Note that the resulting pointer is valid only within a line (because of the padding)
withComponentPtr 
  :: PixelComponent t 
  => IOBitmap t       -- ^ the bitmap
  -> Offset           -- ^ position (x,y)
  -> Int              -- ^ channel index {0,1,...,nchannels-1}
  -> (Ptr t -> IO a)  -- ^ user action
  -> IO a
withComponentPtr (IOBitmap bm) (x,y) ofs action = 
  withForeignPtr (bitmapPtr bm) $ \p -> do
    let nchn = bitmapNChannels bm
        rowsize = bitmapPaddedRowSizeInBytes bm
        q = p `myPlusPtr` ( ( nchn*x + ofs ) * sizeOf (bitmapUndefined bm) + y * rowsize ) 
    action q
    
-- | It is not very efficient to read\/write lots of pixels this way.
unsafeReadComponent 
  :: PixelComponent t 
  => IOBitmap t    -- ^ the bitmap
  -> Offset        -- ^ position (x,y)
  -> Int           -- ^ channel index {0,1,...,nchannels-1}
  -> IO t
unsafeReadComponent bm xy ofs = withComponentPtr bm xy ofs $ peek
    
unsafeWriteComponent
  :: PixelComponent t 
  => IOBitmap t    -- ^ the bitmap
  -> Offset        -- ^ position (x,y)
  -> Int           -- ^ channel index {0,1,...,nchannels-1}
  -> t             -- ^ the value to write
  -> IO ()
unsafeWriteComponent bm xy ofs value = withComponentPtr bm xy ofs $ \q -> poke q value

-- | Please note that the component array to read shouldn't cross 
-- the boundary between lines.
unsafeReadComponents
  :: PixelComponent t 
  => IOBitmap t    -- ^ the bitmap
  -> Offset        -- ^ position (x,y)
  -> Int           -- ^ channel index {0,1,...,nchannels-1}
  -> Int           -- ^ the number of components to read
  -> IO [t]
unsafeReadComponents bm xy ofs k = withComponentPtr bm xy ofs $ \p -> peekArray k p

-- | Please note that the component array to write shouldn't cross 
-- the boundary between lines.
unsafeWriteComponents
  :: PixelComponent t 
  => IOBitmap t      -- ^ the bitmap
  -> Offset        -- ^ position (x,y)
  -> Int           -- ^ channel index {0,1,...,nchannels-1}
  -> [t]           -- ^ the components to write
  -> IO ()
unsafeWriteComponents bm xy ofs values = withComponentPtr bm xy ofs $ \q -> pokeArray q values

unsafeReadPixel 
  :: PixelComponent t 
  => IOBitmap t      -- ^ the bitmap
  -> Offset        -- ^ position (x,y)
  -> IO [t]
unsafeReadPixel bm xy = unsafeReadComponents bm xy 0 (bitmapNChannels bm)
   
--------------------------------------------------------------------------------

instance BitmapClass IOBitmap1 where
  underlyingBitmap = unIOBitmap . fromIOBitmap1

instance BitmapClass IOBitmap2 where
  underlyingBitmap = unIOBitmap . fromIOBitmap2

instance BitmapClass IOBitmap3 where
  underlyingBitmap = unIOBitmap . fromIOBitmap3

instance BitmapClass IOBitmap4 where
  underlyingBitmap = unIOBitmap . fromIOBitmap4

--------------------------------------------------------------------------------
  
-- | Newtypes for mutable bitmaps with a fixed number of channels (components per pixel) 
newtype IOBitmap1 t = IOBitmap1 { fromIOBitmap1 :: IOBitmap t } 
newtype IOBitmap2 t = IOBitmap2 { fromIOBitmap2 :: IOBitmap t }
newtype IOBitmap3 t = IOBitmap3 { fromIOBitmap3 :: IOBitmap t }
newtype IOBitmap4 t = IOBitmap4 { fromIOBitmap4 :: IOBitmap t } 

ioBitmap1 :: IOBitmap t -> IOBitmap1 t
ioBitmap2 :: IOBitmap t -> IOBitmap2 t
ioBitmap3 :: IOBitmap t -> IOBitmap3 t
ioBitmap4 :: IOBitmap t -> IOBitmap4 t

ioBitmap1 bm = if bitmapNChannels bm == 1 then IOBitmap1 bm else error "bitmap/ioBitmap1: number of channels is not 1"
ioBitmap2 bm = if bitmapNChannels bm == 2 then IOBitmap2 bm else error "bitmap/ioBitmap2: number of channels is not 2"
ioBitmap3 bm = if bitmapNChannels bm == 3 then IOBitmap3 bm else error "bitmap/ioBitmap3: number of channels is not 3"
ioBitmap4 bm = if bitmapNChannels bm == 4 then IOBitmap4 bm else error "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 bm xy = withComponentPtr (fromIOBitmap1 bm) xy 0 $ \p -> liftM (\[x]       ->  x       ) $ peekArray 1 p
unsafeReadPixel2 bm xy = withComponentPtr (fromIOBitmap2 bm) xy 0 $ \p -> liftM (\[x,y]     -> (x,y)    ) $ peekArray 2 p
unsafeReadPixel3 bm xy = withComponentPtr (fromIOBitmap3 bm) xy 0 $ \p -> liftM (\[x,y,z]   -> (x,y,z)  ) $ peekArray 3 p
unsafeReadPixel4 bm xy = withComponentPtr (fromIOBitmap4 bm) xy 0 $ \p -> liftM (\[x,y,z,w] -> (x,y,z,w)) $ peekArray 4 p

unsafeWritePixel1 bm xy  x        = withComponentPtr (fromIOBitmap1 bm) xy 0 $ \q -> pokeArray q [x]
unsafeWritePixel2 bm xy (x,y)     = withComponentPtr (fromIOBitmap2 bm) xy 0 $ \q -> pokeArray q [x,y]
unsafeWritePixel3 bm xy (x,y,z)   = withComponentPtr (fromIOBitmap3 bm) xy 0 $ \q -> pokeArray q [x,y,z]
unsafeWritePixel4 bm xy (x,y,z,w) = withComponentPtr (fromIOBitmap4 bm) xy 0 $ \q -> pokeArray q [x,y,z,w]

-}

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

{-# SPECIALIZE genericComponentRowMap 
      :: (Int -> Int -> Ptr Word8  -> Ptr Word8  -> IO ()) -> IOBitmap Word8  -> IOBitmap Word8  -> IO () #-}
{-# SPECIALIZE genericComponentRowMap 
      :: (Int -> Int -> Ptr Word16 -> Ptr Word16 -> IO ()) -> IOBitmap Word16 -> IOBitmap Word16 -> IO () #-}
{-# SPECIALIZE genericComponentRowMap 
      :: (Int -> Int -> Ptr Word32 -> Ptr Word32 -> IO ()) -> IOBitmap Word32 -> IOBitmap Word32 -> IO () #-}
{-# SPECIALIZE genericComponentRowMap 
      :: (Int -> Int -> Ptr Float  -> Ptr Float  -> IO ()) -> IOBitmap Float  -> IOBitmap Float  -> IO () #-}

{-# SPECIALIZE genericComponentRowMap 
      :: (Int -> Int -> Ptr Word8  -> Ptr Float  -> IO ()) -> IOBitmap Word8  -> IOBitmap Float  -> IO () #-}
{-# SPECIALIZE genericComponentRowMap 
      :: (Int -> Int -> Ptr Float  -> Ptr Word8  -> IO ()) -> IOBitmap Float  -> IOBitmap Word8  -> IO () #-}

{-# SPECIALIZE genericComponentRowMap 
      :: (Int -> Int -> Ptr Word16 -> Ptr Float  -> IO ()) -> IOBitmap Word16 -> IOBitmap Float  -> IO () #-}
{-# SPECIALIZE genericComponentRowMap 
      :: (Int -> Int -> Ptr Float  -> Ptr Word16 -> IO ()) -> IOBitmap Float  -> IOBitmap Word16 -> IO () #-}

-- the first Int is the y position
-- the second Int is the number of pixel components (nchn*width)
genericComponentRowMap 
  :: (PixelComponent s, PixelComponent t) 
  => (Int -> Int -> Ptr s -> Ptr t -> IO ())        -- ^ ypos totalNumberOfComps src tgt
  -> IOBitmap s -> IOBitmap t -> IO ()
genericComponentRowMap rowAction bm1 bm2 = do

  let (w1,h1) = bitmapSize       bm1
      pad1    = bitmapRowPadding bm1
      nchn1   = bitmapNChannels  bm1
      fptr1   = bitmapPtr        bm1
      xlen1   = bitmapPaddedRowSizeInBytes bm1
      
  let (w2,h2) = bitmapSize       bm2
      pad2    = bitmapRowPadding bm2
      nchn2   = bitmapNChannels  bm2
      fptr2   = bitmapPtr        bm2
      xlen2   = bitmapPaddedRowSizeInBytes bm2
    
  let minw = min w1 w2  
      npc = nchn1 * minw
      
  when (nchn1 /= nchn2) $ 
    error "bitmap/genericRowMap: number of channels disagree" 
    
  withForeignPtr fptr1 $ \ptr1 -> withForeignPtr fptr2 $ \ptr2 -> 
    forM_ (zip3 [0..h1-1]
               (map (*xlen1) [0..h1-1]) 
               (map (*xlen2) [0..h2-1])) $ \(ypos,vo1,vo2) -> do
      let p1 = ptr1 `myPlusPtr` vo1     
          p2 = ptr2 `myPlusPtr` vo2     
      rowAction ypos npc p1 p2 

-------

-- userAction ypos width ptr1 nchn1 ptr2 nchn2 
genericPixelRowMap 
  :: (PixelComponent s, PixelComponent t) 
  => (Int -> Int -> Ptr s -> NChn -> Ptr t -> NChn -> IO ())    -- ^ ypos width ptr1 nchn1 ptr2 nchn2 
  -> IOBitmap s -> IOBitmap t -> IO ()
genericPixelRowMap rowAction bm1 bm2 = do

  let (w1,h1) = bitmapSize       bm1
      pad1    = bitmapRowPadding bm1
      nchn1   = bitmapNChannels  bm1
      fptr1   = bitmapPtr        bm1
      xlen1   = bitmapPaddedRowSizeInBytes bm1
      
  let (w2,h2) = bitmapSize       bm2
      pad2    = bitmapRowPadding bm2
      nchn2   = bitmapNChannels  bm2
      fptr2   = bitmapPtr        bm2
      xlen2   = bitmapPaddedRowSizeInBytes bm2
    
  let minw = min w1 w2 

  withForeignPtr fptr1 $ \ptr1 -> withForeignPtr fptr2 $ \ptr2 -> 
    forM_ (zip3 [0..h1-1] 
                (map (*xlen1) [0..h1-1]) 
                (map (*xlen2) [0..h2-1])) $ \(ypos,o1,o2) -> do
      let p1 = ptr1 `myPlusPtr` o1     
          p2 = ptr2 `myPlusPtr` o2     
      rowAction ypos minw p1 nchn1 p2 nchn2

--------------------------------------------------------------------------------
      
{-# SPECIALIZE genericComponentMap :: (Word8  -> Word8 ) -> IOBitmap Word8  -> IOBitmap Word8  -> IO () #-}      
{-# SPECIALIZE genericComponentMap :: (Word16 -> Word16) -> IOBitmap Word16 -> IOBitmap Word16 -> IO () #-}      
{-# SPECIALIZE genericComponentMap :: (Word32 -> Word32) -> IOBitmap Word32 -> IOBitmap Word32 -> IO () #-}      
{-# SPECIALIZE genericComponentMap :: (Float  -> Float ) -> IOBitmap Float  -> IOBitmap Float  -> IO () #-}      

{-# SPECIALIZE genericComponentMap :: (Word8  -> Float ) -> IOBitmap Word8  -> IOBitmap Float  -> IO () #-}      
{-# SPECIALIZE genericComponentMap :: (Float  -> Word8 ) -> IOBitmap Float  -> IOBitmap Word8  -> IO () #-}
      
{-# SPECIALIZE genericComponentMap :: (Word16 -> Float ) -> IOBitmap Word16 -> IOBitmap Float  -> IO () #-}      
{-# SPECIALIZE genericComponentMap :: (Float  -> Word16) -> IOBitmap Float  -> IOBitmap Word16 -> IO () #-}      
      
genericComponentMap 
--  :: forall s t . (PixelComponent s, PixelComponent t) 
  :: (PixelComponent s, PixelComponent t) 
  => (s -> t) -> IOBitmap s -> IOBitmap t -> IO ()  
genericComponentMap f bm1 bm2 = genericComponentRowMap g bm1 bm2 where
  --h :: (Ptr s, Ptr t) -> Int -> IO (Ptr s, Ptr t)
  h (q1,q2) _ = do
    x <- peek q1
    poke q2 (f x)
    return (advancePtr1 q1, advancePtr1 q2)
  --g :: Int -> Int -> Ptr s -> Ptr t -> IO ()
  g ypos n p1 p2 = do
    foldM_ h (p1,p2) [0..n-1]

{-# SPECIALIZE genericComponentMapWithPos :: (Int -> Int -> Word8  -> Word8 ) -> IOBitmap Word8  -> IOBitmap Word8  -> IO () #-}      
{-# SPECIALIZE genericComponentMapWithPos :: (Int -> Int -> Word16 -> Word16) -> IOBitmap Word16 -> IOBitmap Word16 -> IO () #-}      
{-# SPECIALIZE genericComponentMapWithPos :: (Int -> Int -> Word32 -> Word32) -> IOBitmap Word32 -> IOBitmap Word32 -> IO () #-}      
{-# SPECIALIZE genericComponentMapWithPos :: (Int -> Int -> Float  -> Float ) -> IOBitmap Float  -> IOBitmap Float  -> IO () #-}      

genericComponentMapWithPos 
--  :: forall s t . (PixelComponent s, PixelComponent t) 
  :: (PixelComponent s, PixelComponent t) 
  => (Int -> Int -> s -> t) -> IOBitmap s -> IOBitmap t -> IO ()  
genericComponentMapWithPos f bm1 bm2 = genericComponentRowMap g bm1 bm2 where
  --h :: Int -> (Ptr s, Ptr t) -> Int -> IO (Ptr s, Ptr t)
  h ypos (q1,q2) xpos = do
    x <- peek q1
    poke q2 (f xpos ypos x)
    return (advancePtr1 q1, advancePtr1 q2)
  --g :: Int -> Int -> Ptr s -> Ptr t -> IO ()
  g ypos n p1 p2 = do
    foldM_ (h ypos) (p1,p2) [0..n-1]

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

-- | Maps a function over each component of each pixel. Warning: this is probably slow!
-- Use a specialized function if there is one for your task.
{- 
-- Note: We don't do the more general (s->t) here, because then we would have no idea 
-- about the padding in the new bitmap. See `componentMap'` for that.
-}
componentMap :: PixelComponent s => (s -> s) -> IOBitmap s -> IO (IOBitmap s)
componentMap f bm1 = do
  let siz   = bitmapSize bm1
      nchn  = bitmapNChannels bm1
      align = bitmapRowAlignment bm1
  bm2 <- newIOBitmapUninitialized siz nchn (Just align) 
  genericComponentMap f bm1 bm2 
  return bm2

componentMapInPlace :: PixelComponent s => (s -> s) -> IOBitmap s -> IO ()
componentMapInPlace f bm = do
  genericComponentMap f bm bm
    
-- See the comments at 'componentMap'.
componentMap' 
  :: (PixelComponent s, PixelComponent t) 
  => (s -> t) 
  -> IOBitmap s           -- ^ source bitmap
  -> Maybe Alignment    -- ^ row alignment of the resulting bitmap
  -> IO (IOBitmap t)
componentMap' f bm1 malign = do
  let siz  = bitmapSize bm1
      nchn = bitmapNChannels bm1
      x = bitmapPaddedRowSizeInBytes bm1 
  bm2 <- newIOBitmapUninitialized siz nchn malign 
  genericComponentMap f bm1 bm2 
  return bm2
  
--------------------------------------------------------------------------------

-- | Clones a bitmap.
cloneBitmap 
  :: PixelComponent t 
  => IOBitmap t         -- ^ source image
  -> Maybe Alignment    -- ^ target alignment
  -> IO (IOBitmap t)
cloneBitmap bm1 malign = do
  let siz1@(w1,h1) = bitmapSize bm1
      pad1    = bitmapRowPadding bm1
      nchn1   = bitmapNChannels  bm1
      fptr1   = bitmapPtr        bm1
      xlen1   = bitmapPaddedRowSizeInBytes bm1

  bm2 <- newIOBitmapUninitialized siz1 nchn1 malign

  let fptr2   = bitmapPtr                  bm2
      xlen2   = bitmapPaddedRowSizeInBytes bm2
      
  let len1 = bitmapUnpaddedRowSizeInBytes bm1
      len2 = bitmapUnpaddedRowSizeInBytes bm2

  withForeignPtr fptr1 $ \ptr1 -> 
    withForeignPtr fptr2 $ \ptr2 ->     
      forM_ [0..h1-1] $ \i -> do
        let p = plusPtr ptr1 (i*xlen1)
            q = plusPtr ptr2 (i*xlen2)
        c_memcpy p q len1
        
  return bm2

-- | Creates an empty bitmap with the same properties as the source.
emptyCloneBitmap
  :: PixelComponent t 
  => IOBitmap t         -- ^ source (only dimensions and such is used)
  -> Maybe Alignment    -- ^ target alignment
  -> IO (IOBitmap t)    -- ^ new empty bitmap
emptyCloneBitmap bm1 malign = do

  let siz1  = bitmapSize bm1
      nchn1 = bitmapNChannels  bm1

  bm2 <- newIOBitmapUninitialized siz1 nchn1 malign

  let fptr2 = bitmapPtr         bm2
      n     = bitmapSizeInBytes bm2
  withForeignPtr fptr2 $ \ptr2 -> do
    c_memset (castPtr ptr2 :: Ptr Word8) n 0
    
  return bm2  

-- | Synonym for 'newIOBitmap'
emptyBitmap 
  :: PixelComponent t 
  => Size             -- ^ (width,height)
  -> NChn             -- ^ number of channels (components\/pixel)
  -> Maybe Alignment  -- ^ the row alignment of the new image
  -> IO (IOBitmap t)
emptyBitmap = newIOBitmap
    
--------------------------------------------------------------------------------


-- | Copies a subrectangle of the source image into a new image.  
copySubImage
  :: PixelComponent t 
  => IOBitmap t       -- ^ source image
  -> Offset           -- ^ source rectangle offset
  -> Size             -- ^ source rectangle size
  -> IO (IOBitmap t)
copySubImage bm ofs1 siz1 = copySubImage' bm ofs1 siz1 siz1 (0,0)   

-- | Copy into a new \"black\" bitmap; common generalization of crop and extend.
copySubImage'
  :: PixelComponent t 
  => IOBitmap t       -- ^ source image
  -> Offset           -- ^ source rectangle offset
  -> Size             -- ^ source rectangle size
  -> Size             -- ^ target image size
  -> Offset           -- ^ target rectangle offset
  -> IO (IOBitmap t)
copySubImage' bm1 ofs1 rsiz tsiz ofs2 = do
  let align   = bitmapRowAlignment  bm1
      nchn    = bitmapNChannels  bm1
  bm2 <- newIOBitmap tsiz nchn (Just align)
  copySubImageInto bm1 ofs1 rsiz bm2 ofs2
  return bm2

-- | The source rectangle may be arbitrary, may or may not intersect the
-- source image in any way. We only copy the intersection of the rectangle
-- with the image.  
copySubImageInto 
  :: PixelComponent t 
  => IOBitmap t       -- ^ source image
  -> Offset           -- ^ source rectangle offset
  -> Size             -- ^ source rectangle size
  -> IOBitmap t       -- ^ target image
  -> Offset           -- ^ target rectangle offset
  -> IO ()
  
copySubImageInto bm1 ofs1@(o1x0,o1y0) siz1@(sx0,sy0) bm2 ofs2@(o2x0,o2y0) = do

  let (bm1xs,bm1ys) = bitmapSize bm1
      pad1    = bitmapRowPadding bm1
      align1  = bitmapRowAlignment  bm1
      nchn1   = bitmapNChannels  bm1
      pixsiz1 = bitmapPixelSizeInBytes bm1
      fptr1   = bitmapPtr        bm1
      xlen1   = bitmapPaddedRowSizeInBytes bm1

  let (bm2xs,bm2ys) = bitmapSize bm2
      pad2    = bitmapRowPadding bm2
      align2  = bitmapRowAlignment  bm2
      nchn2   = bitmapNChannels  bm2
      pixsiz2 = bitmapPixelSizeInBytes bm2
      fptr2   = bitmapPtr        bm2
      xlen2   = bitmapPaddedRowSizeInBytes bm2

  when (nchn1/=nchn2) $ error "bitmap/copySubImageInto: number of channels disagree" 

  -- handle negative offsets
  let (o1x1,sx1,o2x1) = if o1x0 >= 0 then (o1x0, sx0, o2x0) else (0, sx0+o1x0, o2x0-o1x0) 
      (o1y1,sy1,o2y1) = if o1y0 >= 0 then (o1y0, sy0, o2y0) else (0, sy0+o1y0, o2y0-o1y0) 

      (o1x ,sx ,o2x ) = if o2x1 >= 0 then (o1x1, sx1, o2x1) else (o1x1-o2x1, sx1+o2x1, 0) 
      (o1y ,sy ,o2y ) = if o2y1 >= 0 then (o1y1, sy1, o2y1) else (o1y1-o2y1, sy1+o2y1, 0) 
  
  -- size of the rectangle we actually copy
  let xs = minimum [ sx , (bm1xs - o1x) , (bm2xs - o2x) ] 
      ys = minimum [ sy , (bm1ys - o1y) , (bm2ys - o2y) ] 
      pixsiz = pixsiz1

  when (xs>0 && ys>0) $ do
    withForeignPtr fptr1 $ \ptr1' -> withForeignPtr fptr2 $ \ptr2' -> do
      let ptr1 = ptr1' `myPlusPtr` (pixsiz*o1x)
          ptr2 = ptr2' `myPlusPtr` (pixsiz*o2x)
          nbytes = pixsiz*xs
      forM_ (zip (map (*xlen1) [o1y..o1y+ys-1]) 
                 (map (*xlen2) [o2y..o2y+ys-1])) $ \(vo1,vo2) -> do
        let p1 = ptr1 `plusPtr` vo1     
            p2 = ptr2 `plusPtr` vo2     
        c_memcpy p1 p2 nbytes

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

-- | Convert a bitmap to one with a different component type.
castBitmap 
  :: (PixelComponent s, PixelComponent t)
  => IOBitmap s             -- ^ source image
  -> Maybe Alignment        -- ^ target image row alignment
  -> IO (IOBitmap t) 
castBitmap bm1 malign = do
  
  let nchn1 = bitmapNChannels bm1
      siz1@(w,h) = bitmapSize bm1
      pad1  = bitmapRowPadding bm1
      fptr1 = bitmapPtr bm1

  bm2 <- newIOBitmapUninitialized siz1 nchn1 malign

  let pad2  = bitmapRowPadding bm2
      fptr2 = bitmapPtr bm2

  withForeignPtr fptr1 $ \ptr1 -> 
    withForeignPtr fptr2 $ \ptr2 ->     
      c_cast_bitmap 
        (bitmapCType bm1)  (bitmapCType bm2)
        (ci w) (ci h)
        ptr1 (ci nchn1) (ci pad1) 0 -- (ci ofs1)
        ptr2 (ci nchn1) (ci pad2) 0 -- (ci ofs2)

  return bm2
          
--------------------------------------------------------------------------------

_flipBitmapInto 
  :: PixelComponent t 
  => IOBitmap t             -- ^ source image
  -> IOBitmap t             -- ^ target image 
  -> IO () 
_flipBitmapInto bm1 bm2 = do

  let siz1@(w1,h1) = bitmapSize bm1
      pad1    = bitmapRowPadding bm1
      nchn1   = bitmapNChannels  bm1
      fptr1   = bitmapPtr        bm1
      xlen1   = bitmapPaddedRowSizeInBytes bm1

  let siz2@(w2,h2) = bitmapSize bm2
      pad2    = bitmapRowPadding bm2
      nchn2   = bitmapNChannels  bm2
      fptr2   = bitmapPtr        bm2
      xlen2   = bitmapPaddedRowSizeInBytes bm2
      
  let len1 = bitmapUnpaddedRowSizeInBytes bm1
      len2 = bitmapUnpaddedRowSizeInBytes bm2

  when ( siz1 /= siz2 || nchn1 /= nchn2 || len1 /= len2 ) $ error "_flipBitmapInto" 

  withForeignPtr fptr1 $ \ptr1 -> 
    withForeignPtr fptr2 $ \ptr2 ->     
    
      if ptr1 == ptr2
        then do 
          allocaBytes len1 $ \tmp -> do
            forM_ [0..(div h1 2)-1] $ \i -> do
              let j = h1-1-i
                  p1 = plusPtr ptr1 (i*xlen1)
                  q1 = plusPtr ptr1 (j*xlen1)                
                  p2 = plusPtr ptr2 (i*xlen2)
                  q2 = plusPtr ptr2 (j*xlen2)
              -- we have to be careful, since the two bitmaps coincide.
              -- that's why the extra copy
              c_memcpy p1  tmp len1
              c_memcpy q1  p2  len1
              c_memcpy tmp q2  len1    
        else do
          forM_ [0..h1-1] $ \i -> do
            let j = h1-1-i
                p = plusPtr ptr1 (i*xlen1)
                q = plusPtr ptr2 (j*xlen2)
            c_memcpy p q len1
              
-- | Flips the bitmap vertically.
flipBitmap 
  :: PixelComponent t 
  => IOBitmap t             -- ^ source image
  -> Maybe Alignment        -- ^ target image row alignment
  -> IO (IOBitmap t) 
flipBitmap bm1 malign = do
  let nchn = bitmapNChannels bm1
      siz@(w,h) = bitmapSize bm1
  bm2 <- newIOBitmapUninitialized siz nchn malign 
  _flipBitmapInto bm1 bm2
  return bm2
  
flipBitmapInPlace
  :: PixelComponent t 
  => IOBitmap t             -- ^ source image
  -> IO () 
flipBitmapInPlace bm = do
  _flipBitmapInto bm bm

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

_mirrorBitmapInto 
  :: PixelComponent t 
  => IOBitmap t             -- ^ source image
  -> IOBitmap t             -- ^ target image 
  -> IO () 
_mirrorBitmapInto bm1 bm2 = do

  let siz1@(w1,h1) = bitmapSize bm1
      pad1    = bitmapRowPadding bm1
      nchn1   = bitmapNChannels  bm1
      fptr1   = bitmapPtr        bm1
      xlen1   = bitmapPaddedRowSizeInBytes bm1

  let siz2@(w2,h2) = bitmapSize bm2
      pad2    = bitmapRowPadding bm2
      nchn2   = bitmapNChannels  bm2
      fptr2   = bitmapPtr        bm2
      xlen2   = bitmapPaddedRowSizeInBytes bm2
      
  let len1 = bitmapUnpaddedRowSizeInBytes bm1
      len2 = bitmapUnpaddedRowSizeInBytes bm2
      bpp1 = bitmapPixelSizeInBytes bm1
      bpp2 = bitmapPixelSizeInBytes bm2

  when ( siz1 /= siz2 || nchn1 /= nchn2 || len1 /= len2 || bpp1 /= bpp2 ) $ error "_mirrorBitmapInto" 

  withForeignPtr fptr1 $ \ptr1 -> 
    withForeignPtr fptr2 $ \ptr2 ->     
      forM_ [0..h1-1] $ \i -> do
        let p = plusPtr ptr1 (i*xlen1)
            q = plusPtr ptr2 (i*xlen2)
        c_mirror_line (ci w1) (ci bpp1) p q
              
-- | Flips the bitmap horizontally.
mirrorBitmap 
  :: PixelComponent t 
  => IOBitmap t             -- ^ source image
  -> Maybe Alignment        -- ^ target image row alignment
  -> IO (IOBitmap t) 
mirrorBitmap bm1 malign = do
  let nchn = bitmapNChannels bm1
      siz@(w,h) = bitmapSize bm1
  bm2 <- newIOBitmapUninitialized siz nchn malign 
  _mirrorBitmapInto bm1 bm2
  return bm2
  
mirrorBitmapInPlace
  :: PixelComponent t 
  => IOBitmap t             -- ^ source image
  -> IO () 
mirrorBitmapInPlace bm = do
  _mirrorBitmapInto bm bm
  
--------------------------------------------------------------------------------

extractSingleChannel 
  :: PixelComponent t 
  => IOBitmap t             -- ^ source image
  -> Maybe Alignment        -- ^ target image row alignment
  -> Int                    -- ^ source channel index
  -> IO (IOBitmap t) 
extractSingleChannel bm1 malign j = do
  let nchn = bitmapNChannels bm1
      siz@(w,h) = bitmapSize bm1
  when (j<0 || j>=nchn) $ error "bitmap/extractSingleChannel: invalid channel index"
  bm2 <- newIOBitmapUninitialized siz 1 malign
  extractChannelInto bm1 j bm2 0
  return bm2
  
extractChannels :: PixelComponent t => IOBitmap t -> Maybe Alignment -> IO [IOBitmap t]
extractChannels bm malign = 
  mapM (extractSingleChannel bm malign) [0..nchn-1] 
    where nchn = bitmapNChannels bm


combineChannels :: PixelComponent t => [IOBitmap t] -> Maybe Alignment -> IO (IOBitmap t)
combineChannels [] _ = error "bitmap/combineChannels: no channel data"
combineChannels bms malign = do
  let sizes = map bitmapSize bms
      nchns = map bitmapNChannels bms
      pixsizs = map bitmapPixelSizeInBytes bms 
      sumchn = sum nchns 
      siz@(w,h) = head sizes
      
  when (length (nub sizes) /= 1) $ error "bitmap/combineChannels: incompatible sizes"

  bm2 <- newIOBitmapUninitialized siz sumchn malign
  let pad2 = bitmapRowPadding bm2
      fptr2 = bitmapPtr bm2

  let loop = concatMap (\bm -> zip (repeat bm) [0..bitmapNChannels bm - 1]) bms

  withForeignPtr fptr2 $ \ptr2 -> do
    forM_ (zip [0..] loop) $ \(i,(bm1,j)) -> do
      let pad1  = bitmapRowPadding bm1
          fptr1 = bitmapPtr bm1    
          nchn1 = bitmapNChannels bm1    
      withForeignPtr fptr1 $ \ptr1 -> 
        c_extract_channel 
          (bitmapCType (head bms))
          (ci w) (ci h)
          ptr1 (ci nchn1)  (ci pad1) (ci j)
          ptr2 (ci sumchn) (ci pad2) (ci i)
          
  return bm2

extractChannelInto 
  :: PixelComponent t 
  => IOBitmap t   -- ^ source image
  -> Int          -- ^ source channel index 
  -> IOBitmap t   -- ^ target image
  -> Int          -- ^ target channel index
  -> IO ()
extractChannelInto bm1 ofs1 bm2 ofs2 = do

  let nchn1 = bitmapNChannels bm1
      siz1@(w,h) = bitmapSize bm1
      pad1  = bitmapRowPadding bm1
      fptr1 = bitmapPtr bm1

  let nchn2 = bitmapNChannels bm2
      siz2  = bitmapSize bm2
      pad2  = bitmapRowPadding bm2
      fptr2 = bitmapPtr bm2

  when (siz1 /= siz2)          $ error "bitmap/extractChannelInto: incompatible dimensions"
  when (ofs1<0 || ofs1>=nchn1) $ error "bitmap/extractChannelInto: invalid source channel index"
  when (ofs2<0 || ofs2>=nchn2) $ error "bitmap/extractChannelInto: invalid target channel index"
  
  withForeignPtr fptr1 $ \ptr1 -> 
    withForeignPtr fptr2 $ \ptr2 ->     
      c_extract_channel 
        (bitmapCType bm1)
        (ci w) (ci h)
        ptr1 (ci nchn1) (ci pad1) (ci ofs1)
        ptr2 (ci nchn2) (ci pad2) (ci ofs2)

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

bilinearResample
  :: PixelComponent t 
  => IOBitmap t      -- ^ source image
  -> Size            -- ^ target image size
  -> Maybe Alignment -- ^ target image alignment
  -> IO (IOBitmap t)   
bilinearResample bm1 siz2@(w2,h2) malign = do
  let nchn1 = bitmapNChannels bm1
  bm2 <- newIOBitmapUninitialized siz2 nchn1 malign
  forM_ [0..nchn1-1] $ \ofs ->
    bilinearResampleChannelInto bm1 ofs bm2 ofs
  return bm2


bilinearResampleChannel
  :: PixelComponent t 
  => IOBitmap t      -- ^ source image
  -> Int             -- ^ source channel index 
  -> Size            -- ^ target image size
  -> Maybe Alignment -- ^ target image alignment
  -> IO (IOBitmap t)   
bilinearResampleChannel bm1 ofs1 siz2@(w2,h2) malign = do
  let nchn1 = bitmapNChannels bm1
  when (ofs1<0 || ofs1>=nchn1) $ error "bitmap/bilinearResampleChannel: invalid channel index"
  bm2 <- newIOBitmapUninitialized siz2 1 malign
  bilinearResampleChannelInto bm1 ofs1 bm2 0
  return bm2


bilinearResampleChannelInto 
  :: PixelComponent t 
  => IOBitmap t   -- ^ source image
  -> Int          -- ^ source channel index 
  -> IOBitmap t   -- ^ target image
  -> Int          -- ^ target channel index
  -> IO ()
bilinearResampleChannelInto bm1 ofs1 bm2 ofs2 = do

  let nchn1 = bitmapNChannels bm1
      siz1@(w1,h1) = bitmapSize bm1
      pad1  = bitmapRowPadding bm1
      fptr1 = bitmapPtr bm1

  let nchn2 = bitmapNChannels bm2
      siz2@(w2,h2) = bitmapSize bm2
      pad2  = bitmapRowPadding bm2
      fptr2 = bitmapPtr bm2

  when (ofs1<0 || ofs1>=nchn1) $ error "bitmap/bilinearResampleChannelInto: invalid source channel index"
  when (ofs2<0 || ofs2>=nchn2) $ error "bitmap/bilinearResampleChannelInto: invalid target channel index"
  
  withForeignPtr fptr1 $ \ptr1 -> 
    withForeignPtr fptr2 $ \ptr2 ->     
      c_bilinear_resample_channel 
        (c_type (bitmapUndefined bm1))
        (ci w1) (ci h1) ptr1 (ci nchn1) (ci pad1) (ci ofs1)
        (ci w2) (ci h2) ptr2 (ci nchn2) (ci pad2) (ci ofs2)

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

-- | This is equivalent to @componentMap (\c -> c^gamma)@, except that
-- @(^)@ is defined only for integral exponents; but should be faster anyway.
powerlawGammaCorrection 
  :: PixelComponent t 
  => Float             -- ^ gamma
  -> IOBitmap t        -- ^ source bitmap
  -> Maybe Alignment   -- ^ target alignment
  -> IO (IOBitmap t)
powerlawGammaCorrection gamma bm1 malign = do
  let nchn1 = bitmapNChannels bm1
      siz1@(w1,h1) = bitmapSize bm1
      pad1 = bitmapRowPadding bm1
      fptr1 = bitmapPtr bm1
  bm2 <- newIOBitmapUninitialized siz1 nchn1 malign
  let pad2 = bitmapRowPadding bm2
      fptr2 = bitmapPtr bm2
  withForeignPtr fptr1 $ \ptr1 -> 
    withForeignPtr fptr2 $ \ptr2 ->     
      c_gamma_correct_all_channels 
        (c_type (bitmapUndefined bm1))
        (realToFrac gamma) 
        (ci w1) (ci h1) (ci nchn1) 
        ptr1 (ci pad1) 
        ptr2 (ci pad2) 
  return bm2
  

powerlawGammaCorrectionChannel
  :: PixelComponent t 
  => Float           -- ^ gamma
  -> IOBitmap t      -- ^ source image
  -> Int             -- ^ source channel index 
  -> Maybe Alignment -- ^ target image alignment
  -> IO (IOBitmap t)   
powerlawGammaCorrectionChannel gamma bm1 ofs1 malign = do
  let nchn1 = bitmapNChannels bm1
      siz1  = bitmapSize bm1
  when (ofs1<0 || ofs1>=nchn1) $ error "bitmap/powerlawGammaCorrectionChannel: invalid channel index"
  bm2 <- newIOBitmapUninitialized siz1 1 malign
  powerlawGammaCorrectionChannelInto gamma bm1 ofs1 bm2 0
  return bm2
  
  
powerlawGammaCorrectionChannelInto
  :: PixelComponent t 
  => Float        -- ^ gamma
  -> IOBitmap t   -- ^ source image
  -> Int          -- ^ source channel index 
  -> IOBitmap t   -- ^ target image
  -> Int          -- ^ target channel index
  -> IO ()
powerlawGammaCorrectionChannelInto gamma bm1 ofs1 bm2 ofs2 = do

  let nchn1 = bitmapNChannels bm1
      siz1@(w1,h1) = bitmapSize bm1
      pad1  = bitmapRowPadding bm1
      fptr1 = bitmapPtr bm1

  let nchn2 = bitmapNChannels bm2
      siz2@(w2,h2) = bitmapSize bm2
      pad2  = bitmapRowPadding bm2
      fptr2 = bitmapPtr bm2

  when (siz1 /= siz2)          $ error "bitmap/powerlawGammaCorrectionChannelInto: incompatible dimensions"
  when (ofs1<0 || ofs1>=nchn1) $ error "bitmap/powerlawGammaCorrectionChannelInto: invalid source channel index"
  when (ofs2<0 || ofs2>=nchn2) $ error "bitmap/powerlawGammaCorrectionChannelInto: invalid target channel index"
  
  withForeignPtr fptr1 $ \ptr1 -> 
    withForeignPtr fptr2 $ \ptr2 ->     
      c_gamma_correct_channel 
        (c_type (bitmapUndefined bm1))
        (realToFrac gamma) 
        (ci w1) (ci h1) 
        ptr1 (ci nchn1) (ci pad1) (ci ofs1)
        ptr2 (ci nchn2) (ci pad2) (ci ofs2)

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

-- | Blends two bitmaps with the given weights; that is, the result is
-- the specified linear combination. If the values are outside the allowed
-- range (this can happen with the Word8, Word16, Word32 types and weights
-- whose sum is bigger than 1, or with a negative weight), then they are
-- clipped. The clipping /does not/ happen with the Float component type.
blendBitmaps
  :: PixelComponent t 
  => Float           -- ^ weight1
  -> Float           -- ^ weight2
  -> IOBitmap t      -- ^ source1 image 
  -> IOBitmap t      -- ^ source2 image 
  -> Maybe Alignment -- ^ target alignment
  -> IO (IOBitmap t)
-- this could be implemented more effectively by a specialized c routine
blendBitmaps weight1 weight2 bm1 bm2 malign = do 
  let nchn1 = bitmapNChannels bm1
      siz1  = bitmapSize bm1
  let nchn2 = bitmapNChannels bm2
      siz2  = bitmapSize bm2
  when (siz1  /= siz2 ) $ error "bitmap/blend: incompatible dimensions"    
  when (nchn1 /= nchn2) $ error "bitmap/blend: incompatible number of channels"
  bm3 <- newIOBitmapUninitialized siz1 nchn1 malign
  forM [0..nchn1-1] $ \ofs -> 
    blendChannelsInto weight1 weight2 bm1 ofs bm2 ofs bm3 ofs
  return bm3  
  
blendChannels
  :: PixelComponent t 
  => Float        -- ^ weight1
  -> Float        -- ^ weight2
  -> IOBitmap t   -- ^ source1 image 
  -> Int          -- ^ source1 channel index  
  -> IOBitmap t   -- ^ source2 image 
  -> Int          -- ^ source2 channel index  
  -> Maybe Alignment -- ^ target alignment
  -> IO (IOBitmap t)
blendChannels weight1 weight2 bm1 ofs1 bm2 ofs2 malign = do
  let nchn1 = bitmapNChannels bm1
      siz1  = bitmapSize bm1
  let nchn2 = bitmapNChannels bm2
      siz2  = bitmapSize bm2
  when (siz1 /= siz2)          $ error "bitmap/blendChannels: incompatible dimensions"    
  when (ofs1<0 || ofs1>=nchn1) $ error "bitmap/blendChannels: invalid channel index"
  when (ofs2<0 || ofs2>=nchn2) $ error "bitmap/blendChannels: invalid channel index"
  bm3 <- newIOBitmapUninitialized siz1 1 malign
  blendChannelsInto weight1 weight2 bm1 ofs1 bm2 ofs2 bm3 0
  return bm3  
  
blendChannelsInto
  :: PixelComponent t 
  => Float        -- ^ weight1
  -> Float        -- ^ weight2
  -> IOBitmap t   -- ^ source1 image 
  -> Int          -- ^ source1 channel index  
  -> IOBitmap t   -- ^ source2 image 
  -> Int          -- ^ source2 channel index  
  -> IOBitmap t   -- ^ target image
  -> Int          -- ^ target channel index
  -> IO ()
blendChannelsInto weight1 weight2 bm1 ofs1 bm2 ofs2 bm3 ofs3 = do

  let nchn1 = bitmapNChannels bm1
      siz1@(w1,h1) = bitmapSize bm1
      pad1  = bitmapRowPadding bm1
      fptr1 = bitmapPtr bm1

  let nchn2 = bitmapNChannels bm2
      siz2@(w2,h2) = bitmapSize bm2
      pad2  = bitmapRowPadding bm2
      fptr2 = bitmapPtr bm2

  let nchn3 = bitmapNChannels bm3
      siz3@(w3,h3) = bitmapSize bm3
      pad3  = bitmapRowPadding bm3
      fptr3 = bitmapPtr bm3

  when (siz1 /= siz2)          $ error "bitmap/blendChannelInto: incompatible dimensions"
  when (siz2 /= siz3)          $ error "bitmap/blendChannelInto: incompatible dimensions"
  when (ofs1<0 || ofs1>=nchn1) $ error "bitmap/blendChannelInto: invalid source channel index 1"
  when (ofs2<0 || ofs2>=nchn2) $ error "bitmap/blendChannelInto: invalid source channel index 2"
  when (ofs3<0 || ofs3>=nchn3) $ error "bitmap/blendChannelInto: invalid target channel index"
  
  withForeignPtr fptr1 $ \ptr1 -> 
    withForeignPtr fptr2 $ \ptr2 ->     
      withForeignPtr fptr3 $ \ptr3 ->     
        c_linear_combine_channels 
          (bitmapCType bm1)
          (realToFrac weight1) (realToFrac weight2) 
          (ci w1) (ci h1) 
          ptr1 (ci nchn1) (ci pad1) (ci ofs1)
          ptr2 (ci nchn2) (ci pad2) (ci ofs2)
          ptr3 (ci nchn3) (ci pad3) (ci ofs3)
        
--------------------------------------------------------------------------------

{- 

-- | The data is copied, not shared. Note that the resulting ByteString is
-- encoded using the host machine's endianness, so it may be not compatible
-- across different architectures!
copyBitmapToByteString :: PixelComponent t => Bitmap t -> IO ByteString
copyBitmapToByteString bm = do
  let n = bitmapSizeInBytes bm
  newfp <- B.mallocByteString n
  withBitmap bm $ \_ _ _ src -> 
    withForeignPtr newfp $ \tgt -> do
      c_memcpy (castPtr src) tgt n
  return $ B.fromForeignPtr (castForeignPtr newfp) 0 n

-- | The data is copied, not shared.
-- Note that we expect the ByteString to be encoded
-- encoded using the host machine's endianness.
copyBitmapFromByteString :: PixelComponent t => ByteString -> Size -> NChn -> Padding -> IO (Bitmap t)
copyBitmapFromByteString bs siz nchn pad = do
  let (bsfptr0,ofs,len) = B.toForeignPtr bs
      bm = Bitmap 
        { bitmapSize = siz
        , bitmapNChannels = nchn
        , bitmapPtr = undefined 
        , bitmapRowPadding = pad
        , bitmapRowAlignment = 1
        } -- :: Bitmap t
      n = bitmapSizeInBytes bm
  if n > len-ofs
    then error "copyBitmapFromByteString: ByteString is too short"
    else do
      newfptr <- mallocForeignPtrBytes n
      withForeignPtr bsfptr0 $ \src0 -> do
        let src = src0 `myPlusPtr` ofs
        withForeignPtr newfptr $ \tgt ->
          c_memcpy src tgt n
      return $ bm { bitmapPtr = castForeignPtr newfptr } 

-}
  
--------------------------------------------------------------------------------

ptrUndefined :: Ptr a -> a
ptrUndefined _ = undefined

-- no multiplication
{-# SPECIALIZE advancePtr1 :: Ptr Word8 -> Ptr Word8 #-}
{-# SPECIALIZE advancePtr1 :: Ptr Float -> Ptr Float #-}
--advancePtr1 :: forall a. Storable a => Ptr a -> Ptr a
--advancePtr1 p = p `plusPtr` (sizeOf (undefined::a))
advancePtr1 :: Storable a => Ptr a -> Ptr a
advancePtr1 p = p `plusPtr` (sizeOf (ptrUndefined p))

-- restricted type
{-# SPECIALIZE myPlusPtr :: Ptr Word8 -> Int -> Ptr Word8 #-}
{-# SPECIALIZE myPlusPtr :: Ptr Float -> Int -> Ptr Float #-}
myPlusPtr :: Ptr a -> Int -> Ptr a
myPlusPtr = plusPtr

ci :: Int -> CInt
ci = fromIntegral

-- @c_memset target count fill@.
-- Note that we use /nonstandard/ argument order!
foreign import ccall unsafe "bm.h c_memset" 
  c_memset :: Ptr Word8 -> Int -> Word8 -> IO ()

-- @c_memcpy from to cnt@.
-- Note that we use /nonstandard/ argument order!
foreign import ccall unsafe "bm.h c_memcpy" 
  c_memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()

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

{-
// tgt and src can be potentally the same
void c_mirror_line(int width, int bytesperpixel, void *src, void *tgt);
-}

foreign import ccall unsafe "bm.h c_mirror_line"
  c_mirror_line 
    :: CInt        -- ^ width
    -> CInt        -- ^ bytesperpixel
    -> Ptr a       -- ^ src 
    -> Ptr a       -- ^ tgt
    -> IO ()

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

{-
void c_cast_bitmap
  ( int k_type1, int k_type2
  , int width, int height
  , void *p1, int nchn1, int pad1, int ofs1 
  , void *p2, int nchn2, int pad2, int ofs2 
  );
-}

-- offset is measured in components, not bytes!
-- also, nchn1 should be equal to nchn2
-- offset should be zero
foreign import ccall unsafe "bm.h c_cast_bitmap"
  c_cast_bitmap 
    :: CInt -> CInt      -- ^ component types
    -> CInt -> CInt      -- ^ width, height
    -> Ptr a -> CInt -> CInt -> CInt  -- ^ source, nchn, pad, offset
    -> Ptr b -> CInt -> CInt -> CInt  -- ^ target, nchn, pad, offset
    -> IO ()

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

{-
void c_extract_channel(
  ( int k_type
  , int width, int height 
  , void *p1, int nchn1, int pad1, int ofs1 
  , void *p2, int nchn2, int pad2, int ofs2 
  );
-}

-- offset is measured in components, not bytes!
foreign import ccall unsafe "bm.h c_extract_channel"
  c_extract_channel 
    :: CInt              -- ^ component type
    -> CInt -> CInt      -- ^ width, height
    -> Ptr a -> CInt -> CInt -> CInt  -- ^ source, nchn, pad, offset
    -> Ptr a -> CInt -> CInt -> CInt  -- ^ target, nchn, pad, offset
    -> IO ()

--------------------
 
{-
void c_bilinear_resample_channel
  ( int k_type
  , int width1, int height1, void *p1, int nchn1, int pad1, int ofs1 
  , int width2, int height2, void *p2, int nchn2, int pad2, int ofs2 
  );       
-}

-- offset is measured in components, not bytes!
foreign import ccall unsafe "bm.h c_bilinear_resample_channel"
  c_bilinear_resample_channel 
    :: CInt                                           -- ^ component type
    -> CInt -> CInt -> Ptr a -> CInt -> CInt -> CInt  -- ^ width, height, source, nchn, pad, offset
    -> CInt -> CInt -> Ptr a -> CInt -> CInt -> CInt  -- ^ width, height, target, nchn, pad, offset
    -> IO ()

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

{-
void c_gamma_correct_channel
  ( int k_type
  , float gamma
  , int width, int height
  , void *p1, int nchn1, int pad1, int ofs1 
  , void *p2, int nchn2, int pad2, int ofs2 
  );
  
void c_gamma_correct_all_channels
  ( int k_type
  , float gamma
  , int width, int height, int nchn
  , void *p1, int pad1 
  , void *p2, int pad2 
  );
-}
 
-- offset is measured in components, not bytes!
foreign import ccall unsafe "bm.h c_gamma_correct_channel"
  c_gamma_correct_channel 
    :: CInt              -- ^ component type
    -> CFloat            -- ^ gamma
    -> CInt -> CInt      -- ^ width, height
    -> Ptr a -> CInt -> CInt -> CInt  -- ^ source, nchn, pad, offset
    -> Ptr a -> CInt -> CInt -> CInt  -- ^ target, nchn, pad, offset
    -> IO ()

foreign import ccall unsafe "bm.h c_gamma_correct_all_channels"
  c_gamma_correct_all_channels 
    :: CInt                 -- ^ component type
    -> CFloat               -- ^ gamma
    -> CInt -> CInt -> CInt -- ^ width, height, nchn
    -> Ptr a -> CInt        -- ^ source, pad
    -> Ptr a -> CInt        -- ^ target, pad
    -> IO ()

--------------------
    
{-
void c_linear_combine_channels
  ( int k_type
  , float weight1, float weight2
  , int width, int height
  , void *p1, int nchn1, int pad1, int ofs1 
  , void *p2, int nchn2, int pad2, int ofs2 
  , void *p3, int nchn3, int pad3, int ofs3 
  );    
-}

-- offset is measured in components, not bytes!
foreign import ccall unsafe "bm.h c_linear_combine_channels"
  c_linear_combine_channels 
    :: CInt              -- ^ component type
    -> CFloat -> CFloat  -- ^ weight1, weight2 
    -> CInt -> CInt      -- ^ width, height
    -> Ptr a -> CInt -> CInt -> CInt  -- ^ source1, nchn, pad, offset
    -> Ptr a -> CInt -> CInt -> CInt  -- ^ source2, nchn, pad, offset
    -> Ptr a -> CInt -> CInt -> CInt  -- ^ target,  nchn, pad, offset
    -> IO ()

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