--------------------------------------------------------------------------------
-- 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 :: IOBitmap t -> Bitmap t
unsafeFreezeBitmap = IOBitmap t -> Bitmap t
forall t. IOBitmap t -> Bitmap t
unIOBitmap

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

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

defaultAlignment :: Int
defaultAlignment :: Int
defaultAlignment = Int
4

validateMaybeAlignment :: Maybe Alignment -> Alignment
validateMaybeAlignment :: Maybe Int -> Int
validateMaybeAlignment = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
defaultAlignment Int -> Int
validateAlignment

validateAlignment :: Alignment -> Alignment
validateAlignment :: Int -> Int
validateAlignment Int
k = 
  if Int -> Bool
forall a. Integral a => a -> Bool
isValidAlignment Int
k 
    then Int
k 
    else [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"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 :: Bitmap t -> IO (Bitmap t)
allocBitmap Bitmap t
bm0 = do
  ForeignPtr t
fptr <- Int -> IO (ForeignPtr t)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (Bitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapSizeInBytes Bitmap t
bm0) -- :: IO (ForeignPtr t)
  Bitmap t -> IO (Bitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bitmap t -> IO (Bitmap t)) -> Bitmap t -> IO (Bitmap t)
forall a b. (a -> b) -> a -> b
$ Bitmap t
bm0 { _bitmapPtr :: ForeignPtr t
_bitmapPtr = ForeignPtr t
fptr }

allocIOBitmap :: PixelComponent t => IOBitmap t -> IO (IOBitmap t)
allocIOBitmap :: IOBitmap t -> IO (IOBitmap t)
allocIOBitmap IOBitmap t
bm = Bitmap t -> IOBitmap t
forall t. Bitmap t -> IOBitmap t
IOBitmap (Bitmap t -> IOBitmap t) -> IO (Bitmap t) -> IO (IOBitmap t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bitmap t -> IO (Bitmap t)
forall t. PixelComponent t => Bitmap t -> IO (Bitmap t)
allocBitmap (Bitmap t -> IO (Bitmap t)) -> Bitmap t -> IO (Bitmap t)
forall a b. (a -> b) -> a -> b
$ IOBitmap t -> Bitmap t
forall t. IOBitmap t -> Bitmap t
unIOBitmap IOBitmap t
bm)

-- we do not initialize the new bitmap!
newBitmapRaw :: PixelComponent t => Size -> NChn -> Padding -> Alignment -> IO (IOBitmap t)   
newBitmapRaw :: Size -> Int -> Int -> Int -> IO (IOBitmap t)
newBitmapRaw Size
siz Int
nchn Int
pad Int
align = do
  let bm0 :: Bitmap t
bm0 = Bitmap :: forall t. Size -> Int -> ForeignPtr t -> Int -> Int -> Bitmap t
Bitmap 
        { _bitmapSize :: Size
_bitmapSize = Size
siz
        , _bitmapNChannels :: Int
_bitmapNChannels = Int
nchn
        , _bitmapPtr :: ForeignPtr t
_bitmapPtr = ForeignPtr t
forall a. HasCallStack => a
undefined 
        , _bitmapRowPadding :: Int
_bitmapRowPadding = Int
pad
        , _bitmapRowAlignment :: Int
_bitmapRowAlignment = Int
align
        } -- :: Bitmap t
{-        
  let len = bitmapSizeInBytes bm0      
  fptr <- mallocForeignPtrBytes len -- :: IO (ForeignPtr t)
  return $ bm0 { bitmapPtr = fptr }
-}
  Bitmap t -> IOBitmap t
forall t. Bitmap t -> IOBitmap t
IOBitmap (Bitmap t -> IOBitmap t) -> IO (Bitmap t) -> IO (IOBitmap t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bitmap t -> IO (Bitmap t)
forall t. PixelComponent t => Bitmap t -> IO (Bitmap t)
allocBitmap Bitmap t
forall t. Bitmap t
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 :: Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmap Size
siz Int
nchn Maybe Int
malign = do  
  IOBitmap t
bm <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
nchn Maybe Int
malign -- :: IO (Bitmap t)
  let fptr :: ForeignPtr t
fptr = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm
      len :: Int
len  = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapSizeInBytes IOBitmap t
bm
  ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
p -> Ptr Word8 -> Int -> Word8 -> IO ()
c_memset (Ptr t -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr t
p) Int
len Word8
0
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm

allocBitmapWithRecommendedPadding :: PixelComponent t => Bitmap t -> IO (Bitmap t)
allocBitmapWithRecommendedPadding :: Bitmap t -> IO (Bitmap t)
allocBitmapWithRecommendedPadding Bitmap t
bm0 = 
  Bitmap t -> IO (Bitmap t)
forall t. PixelComponent t => Bitmap t -> IO (Bitmap t)
allocBitmap (Bitmap t -> IO (Bitmap t)) -> Bitmap t -> IO (Bitmap t)
forall a b. (a -> b) -> a -> b
$ 
    Bitmap t
bm0 { _bitmapRowPadding :: Int
_bitmapRowPadding = Bitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
recommendedPadding Bitmap t
bm0 } 
  
newIOBitmapUninitialized :: PixelComponent t => Size -> NChn -> Maybe Alignment -> IO (IOBitmap t)
newIOBitmapUninitialized :: Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
nchn Maybe Int
malign = do
  let align :: Int
align = Maybe Int -> Int
validateMaybeAlignment Maybe Int
malign
      bm0 :: Bitmap t
bm0 = Bitmap :: forall t. Size -> Int -> ForeignPtr t -> Int -> Int -> Bitmap t
Bitmap 
        { _bitmapSize :: Size
_bitmapSize = Size
siz
        , _bitmapNChannels :: Int
_bitmapNChannels = Int
nchn
        , _bitmapPtr :: ForeignPtr t
_bitmapPtr = ForeignPtr t
forall a. HasCallStack => a
undefined 
        , _bitmapRowPadding :: Int
_bitmapRowPadding = Int
forall a. HasCallStack => a
undefined -- pad
        , _bitmapRowAlignment :: Int
_bitmapRowAlignment = Int
align
        } -- :: Bitmap t
{-      
  let pad = recommendedPadding bm0
  newBitmapRaw siz nchn pad align
-}
  Bitmap t
bm <- Bitmap t -> IO (Bitmap t)
forall t. PixelComponent t => Bitmap t -> IO (Bitmap t)
allocBitmapWithRecommendedPadding Bitmap t
forall t. Bitmap t
bm0
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bitmap t -> IOBitmap t
forall t. Bitmap t -> IOBitmap t
IOBitmap Bitmap t
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 :: Size -> Maybe Int -> (Int -> Int -> t) -> IO (IOBitmap t)
createSingleChannelBitmap Size
siz Maybe Int
malign Int -> Int -> t
fun = do  
  IOBitmap t
bm <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
1 Maybe Int
malign 
  let fptr :: ForeignPtr t
fptr = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm
      len :: Int
len  = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapSizeInBytes IOBitmap t
bm
      -- f :: Int -> Int -> t -> t
      f :: Int -> Int -> p -> t
f Int
x Int
y p
_ = Int -> Int -> t
fun Int
x Int
y 
  (Int -> Int -> t -> t) -> IOBitmap t -> IOBitmap t -> IO ()
forall s t.
(PixelComponent s, PixelComponent t) =>
(Int -> Int -> s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
genericComponentMapWithPos Int -> Int -> t -> t
forall p. Int -> Int -> p -> t
f IOBitmap t
bm IOBitmap t
bm
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
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 :: Size -> Int -> Int -> Ptr t -> Maybe Int -> IO (IOBitmap t)
copyBitmapFromPtr siz :: Size
siz@(Int
w,Int
h) Int
nchn Int
srcpad Ptr t
srcptr Maybe Int
tgtmalign = do
  IOBitmap t
bm <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
nchn Maybe Int
tgtmalign
  IOBitmap t -> (Size -> Int -> Int -> Ptr t -> IO ()) -> IO ()
forall t a.
PixelComponent t =>
IOBitmap t -> (Size -> Int -> Int -> Ptr t -> IO a) -> IO a
withIOBitmap IOBitmap t
bm ((Size -> Int -> Int -> Ptr t -> IO ()) -> IO ())
-> (Size -> Int -> Int -> Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Size
_ Int
_ Int
_ Ptr t
tgtptr -> do
    let pure_line :: Int
pure_line = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapUnpaddedRowSizeInBytes IOBitmap t
bm
        src_line :: Int
src_line  = Int
pure_line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcpad
        tgt_line :: Int
tgt_line  = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm
    [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
y -> do
      let p :: Ptr t
p = Ptr t
srcptr Ptr t -> Int -> Ptr t
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
src_line)
          q :: Ptr t
q = Ptr t
tgtptr Ptr t -> Int -> Ptr t
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
tgt_line)
      Ptr Word8 -> Ptr Word8 -> Int -> IO ()
c_memcpy (Ptr t -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr t
p) (Ptr t -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr t
q) Int
pure_line 
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm

ioBitmapFromForeignPtrUnsafe 
  :: PixelComponent t 
  => Size -> NChn -> Alignment -> Padding -> ForeignPtr t -> IOBitmap t
ioBitmapFromForeignPtrUnsafe :: Size -> Int -> Int -> Int -> ForeignPtr t -> IOBitmap t
ioBitmapFromForeignPtrUnsafe Size
siz Int
nchn Int
align Int
pad ForeignPtr t
fptr = Bitmap t -> IOBitmap t
forall t. Bitmap t -> IOBitmap t
IOBitmap (Bitmap t -> IOBitmap t) -> Bitmap t -> IOBitmap t
forall a b. (a -> b) -> a -> b
$ 
  Size -> Int -> Int -> Int -> ForeignPtr t -> Bitmap t
forall t.
PixelComponent t =>
Size -> Int -> Int -> Int -> ForeignPtr t -> Bitmap t
bitmapFromForeignPtrUnsafe Size
siz Int
nchn Int
align Int
pad ForeignPtr t
fptr
        
-- | @withIOBitmap bitmap $ \\(w,h) nchn padding ptr -> ...@
withIOBitmap :: PixelComponent t => IOBitmap t -> (Size -> NChn -> Padding -> Ptr t -> IO a) -> IO a
withIOBitmap :: IOBitmap t -> (Size -> Int -> Int -> Ptr t -> IO a) -> IO a
withIOBitmap (IOBitmap Bitmap t
bm) Size -> Int -> Int -> 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 -> 
    Size -> Int -> Int -> Ptr t -> IO a
action (Bitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize Bitmap t
bm) (Bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels Bitmap t
bm) (Bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding Bitmap t
bm) Ptr t
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 :: (Int -> Int -> Ptr s -> Ptr t -> IO ())
-> IOBitmap s -> IOBitmap t -> IO ()
genericComponentRowMap Int -> Int -> Ptr s -> Ptr t -> IO ()
rowAction IOBitmap s
bm1 IOBitmap t
bm2 = do

  let (Int
w1,Int
h1) = IOBitmap s -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize       IOBitmap s
bm1
      pad1 :: Int
pad1    = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap s
bm1
      nchn1 :: Int
nchn1   = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels  IOBitmap s
bm1
      fptr1 :: ForeignPtr s
fptr1   = IOBitmap s -> ForeignPtr s
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr        IOBitmap s
bm1
      xlen1 :: Int
xlen1   = IOBitmap s -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap s
bm1
      
  let (Int
w2,Int
h2) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize       IOBitmap t
bm2
      pad2 :: Int
pad2    = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
      nchn2 :: Int
nchn2   = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels  IOBitmap t
bm2
      fptr2 :: ForeignPtr t
fptr2   = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr        IOBitmap t
bm2
      xlen2 :: Int
xlen2   = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm2
    
  let minw :: Int
minw = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
w1 Int
w2  
      npc :: Int
npc = Int
nchn1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
minw
      
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nchn1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ 
    [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/genericRowMap: number of channels disagree" 
    
  ForeignPtr s -> (Ptr s -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr s
fptr1 ((Ptr s -> IO ()) -> IO ()) -> (Ptr s -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr s
ptr1 -> ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 -> 
    [(Int, Int, Int)] -> ((Int, Int, Int) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0..Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
               ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen1) [Int
0..Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]) 
               ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen2) [Int
0..Int
h2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])) (((Int, Int, Int) -> IO ()) -> IO ())
-> ((Int, Int, Int) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
ypos,Int
vo1,Int
vo2) -> do
      let p1 :: Ptr s
p1 = Ptr s
ptr1 Ptr s -> Int -> Ptr s
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` Int
vo1     
          p2 :: Ptr t
p2 = Ptr t
ptr2 Ptr t -> Int -> Ptr t
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` Int
vo2     
      Int -> Int -> Ptr s -> Ptr t -> IO ()
rowAction Int
ypos Int
npc Ptr s
p1 Ptr t
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 :: (Int -> Int -> Ptr s -> Int -> Ptr t -> Int -> IO ())
-> IOBitmap s -> IOBitmap t -> IO ()
genericPixelRowMap Int -> Int -> Ptr s -> Int -> Ptr t -> Int -> IO ()
rowAction IOBitmap s
bm1 IOBitmap t
bm2 = do

  let (Int
w1,Int
h1) = IOBitmap s -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize       IOBitmap s
bm1
      pad1 :: Int
pad1    = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap s
bm1
      nchn1 :: Int
nchn1   = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels  IOBitmap s
bm1
      fptr1 :: ForeignPtr s
fptr1   = IOBitmap s -> ForeignPtr s
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr        IOBitmap s
bm1
      xlen1 :: Int
xlen1   = IOBitmap s -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap s
bm1
      
  let (Int
w2,Int
h2) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize       IOBitmap t
bm2
      pad2 :: Int
pad2    = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
      nchn2 :: Int
nchn2   = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels  IOBitmap t
bm2
      fptr2 :: ForeignPtr t
fptr2   = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr        IOBitmap t
bm2
      xlen2 :: Int
xlen2   = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm2
    
  let minw :: Int
minw = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
w1 Int
w2 

  ForeignPtr s -> (Ptr s -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr s
fptr1 ((Ptr s -> IO ()) -> IO ()) -> (Ptr s -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr s
ptr1 -> ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 -> 
    [(Int, Int, Int)] -> ((Int, Int, Int) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0..Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] 
                ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen1) [Int
0..Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]) 
                ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen2) [Int
0..Int
h2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])) (((Int, Int, Int) -> IO ()) -> IO ())
-> ((Int, Int, Int) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
ypos,Int
o1,Int
o2) -> do
      let p1 :: Ptr s
p1 = Ptr s
ptr1 Ptr s -> Int -> Ptr s
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` Int
o1     
          p2 :: Ptr t
p2 = Ptr t
ptr2 Ptr t -> Int -> Ptr t
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` Int
o2     
      Int -> Int -> Ptr s -> Int -> Ptr t -> Int -> IO ()
rowAction Int
ypos Int
minw Ptr s
p1 Int
nchn1 Ptr t
p2 Int
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 :: (s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
genericComponentMap s -> t
f IOBitmap s
bm1 IOBitmap t
bm2 = (Int -> Int -> Ptr s -> Ptr t -> IO ())
-> IOBitmap s -> IOBitmap t -> IO ()
forall s t.
(PixelComponent s, PixelComponent t) =>
(Int -> Int -> Ptr s -> Ptr t -> IO ())
-> IOBitmap s -> IOBitmap t -> IO ()
genericComponentRowMap Int -> Int -> Ptr s -> Ptr t -> IO ()
forall p p. (Num p, Enum p) => p -> p -> Ptr s -> Ptr t -> IO ()
g IOBitmap s
bm1 IOBitmap t
bm2 where
  --h :: (Ptr s, Ptr t) -> Int -> IO (Ptr s, Ptr t)
  h :: (Ptr s, Ptr t) -> p -> IO (Ptr s, Ptr t)
h (Ptr s
q1,Ptr t
q2) p
_ = do
    s
x <- Ptr s -> IO s
forall a. Storable a => Ptr a -> IO a
peek Ptr s
q1
    Ptr t -> t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr t
q2 (s -> t
f s
x)
    (Ptr s, Ptr t) -> IO (Ptr s, Ptr t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr s -> Ptr s
forall a. Storable a => Ptr a -> Ptr a
advancePtr1 Ptr s
q1, Ptr t -> Ptr t
forall a. Storable a => Ptr a -> Ptr a
advancePtr1 Ptr t
q2)
  --g :: Int -> Int -> Ptr s -> Ptr t -> IO ()
  g :: p -> p -> Ptr s -> Ptr t -> IO ()
g p
ypos p
n Ptr s
p1 Ptr t
p2 = do
    ((Ptr s, Ptr t) -> p -> IO (Ptr s, Ptr t))
-> (Ptr s, Ptr t) -> [p] -> IO ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ (Ptr s, Ptr t) -> p -> IO (Ptr s, Ptr t)
forall p. (Ptr s, Ptr t) -> p -> IO (Ptr s, Ptr t)
h (Ptr s
p1,Ptr t
p2) [p
0..p
np -> p -> p
forall a. Num a => a -> a -> a
-p
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 :: (Int -> Int -> s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
genericComponentMapWithPos Int -> Int -> s -> t
f IOBitmap s
bm1 IOBitmap t
bm2 = (Int -> Int -> Ptr s -> Ptr t -> IO ())
-> IOBitmap s -> IOBitmap t -> IO ()
forall s t.
(PixelComponent s, PixelComponent t) =>
(Int -> Int -> Ptr s -> Ptr t -> IO ())
-> IOBitmap s -> IOBitmap t -> IO ()
genericComponentRowMap Int -> Int -> Ptr s -> Ptr t -> IO ()
g IOBitmap s
bm1 IOBitmap t
bm2 where
  --h :: Int -> (Ptr s, Ptr t) -> Int -> IO (Ptr s, Ptr t)
  h :: Int -> (Ptr s, Ptr t) -> Int -> IO (Ptr s, Ptr t)
h Int
ypos (Ptr s
q1,Ptr t
q2) Int
xpos = do
    s
x <- Ptr s -> IO s
forall a. Storable a => Ptr a -> IO a
peek Ptr s
q1
    Ptr t -> t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr t
q2 (Int -> Int -> s -> t
f Int
xpos Int
ypos s
x)
    (Ptr s, Ptr t) -> IO (Ptr s, Ptr t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr s -> Ptr s
forall a. Storable a => Ptr a -> Ptr a
advancePtr1 Ptr s
q1, Ptr t -> Ptr t
forall a. Storable a => Ptr a -> Ptr a
advancePtr1 Ptr t
q2)
  --g :: Int -> Int -> Ptr s -> Ptr t -> IO ()
  g :: Int -> Int -> Ptr s -> Ptr t -> IO ()
g Int
ypos Int
n Ptr s
p1 Ptr t
p2 = do
    ((Ptr s, Ptr t) -> Int -> IO (Ptr s, Ptr t))
-> (Ptr s, Ptr t) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ (Int -> (Ptr s, Ptr t) -> Int -> IO (Ptr s, Ptr t)
h Int
ypos) (Ptr s
p1,Ptr t
p2) [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
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 :: (s -> s) -> IOBitmap s -> IO (IOBitmap s)
componentMap s -> s
f IOBitmap s
bm1 = do
  let siz :: Size
siz   = IOBitmap s -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap s
bm1
      nchn :: Int
nchn  = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap s
bm1
      align :: Int
align = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowAlignment IOBitmap s
bm1
  IOBitmap s
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap s)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
nchn (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
align) 
  (s -> s) -> IOBitmap s -> IOBitmap s -> IO ()
forall s t.
(PixelComponent s, PixelComponent t) =>
(s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
genericComponentMap s -> s
f IOBitmap s
bm1 IOBitmap s
bm2 
  IOBitmap s -> IO (IOBitmap s)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap s
bm2

componentMapInPlace :: PixelComponent s => (s -> s) -> IOBitmap s -> IO ()
componentMapInPlace :: (s -> s) -> IOBitmap s -> IO ()
componentMapInPlace s -> s
f IOBitmap s
bm = do
  (s -> s) -> IOBitmap s -> IOBitmap s -> IO ()
forall s t.
(PixelComponent s, PixelComponent t) =>
(s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
genericComponentMap s -> s
f IOBitmap s
bm IOBitmap s
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' :: (s -> t) -> IOBitmap s -> Maybe Int -> IO (IOBitmap t)
componentMap' s -> t
f IOBitmap s
bm1 Maybe Int
malign = do
  let siz :: Size
siz  = IOBitmap s -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap s
bm1
      nchn :: Int
nchn = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap s
bm1
      x :: Int
x = IOBitmap s -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap s
bm1 
  IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
nchn Maybe Int
malign 
  (s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
forall s t.
(PixelComponent s, PixelComponent t) =>
(s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
genericComponentMap s -> t
f IOBitmap s
bm1 IOBitmap t
bm2 
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
  
--------------------------------------------------------------------------------

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

  IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz1 Int
nchn1 Maybe Int
malign

  let fptr2 :: ForeignPtr t
fptr2   = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr                  IOBitmap t
bm2
      xlen2 :: Int
xlen2   = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm2
      
  let len1 :: Int
len1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapUnpaddedRowSizeInBytes IOBitmap t
bm1
      len2 :: Int
len2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapUnpaddedRowSizeInBytes IOBitmap t
bm2

  ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 -> 
    ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->     
      [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
        let p :: Ptr b
p = Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr t
ptr1 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen1)
            q :: Ptr b
q = Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr t
ptr2 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen2)
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
c_memcpy Ptr Word8
forall b. Ptr b
p Ptr Word8
forall b. Ptr b
q Int
len1
        
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
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 :: IOBitmap t -> Maybe Int -> IO (IOBitmap t)
emptyCloneBitmap IOBitmap t
bm1 Maybe Int
malign = do

  let siz1 :: Size
siz1  = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
      nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels  IOBitmap t
bm1

  IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz1 Int
nchn1 Maybe Int
malign

  let fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr         IOBitmap t
bm2
      n :: Int
n     = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapSizeInBytes IOBitmap t
bm2
  ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 -> do
    Ptr Word8 -> Int -> Word8 -> IO ()
c_memset (Ptr t -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr t
ptr2 :: Ptr Word8) Int
n Word8
0
    
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
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 :: Size -> Int -> Maybe Int -> IO (IOBitmap t)
emptyBitmap = Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
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 :: IOBitmap t -> Size -> Size -> IO (IOBitmap t)
copySubImage IOBitmap t
bm Size
ofs1 Size
siz1 = IOBitmap t -> Size -> Size -> Size -> Size -> IO (IOBitmap t)
forall t.
PixelComponent t =>
IOBitmap t -> Size -> Size -> Size -> Size -> IO (IOBitmap t)
copySubImage' IOBitmap t
bm Size
ofs1 Size
siz1 Size
siz1 (Int
0,Int
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' :: IOBitmap t -> Size -> Size -> Size -> Size -> IO (IOBitmap t)
copySubImage' IOBitmap t
bm1 Size
ofs1 Size
rsiz Size
tsiz Size
ofs2 = do
  let align :: Int
align   = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowAlignment  IOBitmap t
bm1
      nchn :: Int
nchn    = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels  IOBitmap t
bm1
  IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmap Size
tsiz Int
nchn (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
align)
  IOBitmap t -> Size -> Size -> IOBitmap t -> Size -> IO ()
forall t.
PixelComponent t =>
IOBitmap t -> Size -> Size -> IOBitmap t -> Size -> IO ()
copySubImageInto IOBitmap t
bm1 Size
ofs1 Size
rsiz IOBitmap t
bm2 Size
ofs2
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
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 :: IOBitmap t -> Size -> Size -> IOBitmap t -> Size -> IO ()
copySubImageInto IOBitmap t
bm1 ofs1 :: Size
ofs1@(Int
o1x0,Int
o1y0) siz1 :: Size
siz1@(Int
sx0,Int
sy0) IOBitmap t
bm2 ofs2 :: Size
ofs2@(Int
o2x0,Int
o2y0) = do

  let (Int
bm1xs,Int
bm1ys) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
      pad1 :: Int
pad1    = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
      align1 :: Int
align1  = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowAlignment  IOBitmap t
bm1
      nchn1 :: Int
nchn1   = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels  IOBitmap t
bm1
      pixsiz1 :: Int
pixsiz1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPixelSizeInBytes IOBitmap t
bm1
      fptr1 :: ForeignPtr t
fptr1   = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr        IOBitmap t
bm1
      xlen1 :: Int
xlen1   = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm1

  let (Int
bm2xs,Int
bm2ys) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
      pad2 :: Int
pad2    = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
      align2 :: Int
align2  = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowAlignment  IOBitmap t
bm2
      nchn2 :: Int
nchn2   = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels  IOBitmap t
bm2
      pixsiz2 :: Int
pixsiz2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPixelSizeInBytes IOBitmap t
bm2
      fptr2 :: ForeignPtr t
fptr2   = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr        IOBitmap t
bm2
      xlen2 :: Int
xlen2   = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm2

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nchn1Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/copySubImageInto: number of channels disagree" 

  -- handle negative offsets
  let (Int
o1x1,Int
sx1,Int
o2x1) = if Int
o1x0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then (Int
o1x0, Int
sx0, Int
o2x0) else (Int
0, Int
sx0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o1x0, Int
o2x0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o1x0) 
      (Int
o1y1,Int
sy1,Int
o2y1) = if Int
o1y0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then (Int
o1y0, Int
sy0, Int
o2y0) else (Int
0, Int
sy0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o1y0, Int
o2y0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o1y0) 

      (Int
o1x ,Int
sx ,Int
o2x ) = if Int
o2x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then (Int
o1x1, Int
sx1, Int
o2x1) else (Int
o1x1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o2x1, Int
sx1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o2x1, Int
0) 
      (Int
o1y ,Int
sy ,Int
o2y ) = if Int
o2y1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then (Int
o1y1, Int
sy1, Int
o2y1) else (Int
o1y1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o2y1, Int
sy1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o2y1, Int
0) 
  
  -- size of the rectangle we actually copy
  let xs :: Int
xs = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [ Int
sx , (Int
bm1xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o1x) , (Int
bm2xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o2x) ] 
      ys :: Int
ys = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [ Int
sy , (Int
bm1ys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o1y) , (Int
bm2ys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o2y) ] 
      pixsiz :: Int
pixsiz = Int
pixsiz1

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
xsInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 Bool -> Bool -> Bool
&& Int
ysInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1' -> ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2' -> do
      let ptr1 :: Ptr t
ptr1 = Ptr t
ptr1' Ptr t -> Int -> Ptr t
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` (Int
pixsizInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
o1x)
          ptr2 :: Ptr t
ptr2 = Ptr t
ptr2' Ptr t -> Int -> Ptr t
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` (Int
pixsizInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
o2x)
          nbytes :: Int
nbytes = Int
pixsizInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xs
      [Size] -> (Size -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Int] -> [Size]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen1) [Int
o1y..Int
o1yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ysInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]) 
                 ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen2) [Int
o2y..Int
o2yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ysInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])) ((Size -> IO ()) -> IO ()) -> (Size -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
vo1,Int
vo2) -> do
        let p1 :: Ptr b
p1 = Ptr t
ptr1 Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
vo1     
            p2 :: Ptr b
p2 = Ptr t
ptr2 Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
vo2     
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
c_memcpy Ptr Word8
forall b. Ptr b
p1 Ptr Word8
forall b. Ptr b
p2 Int
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 :: IOBitmap s -> Maybe Int -> IO (IOBitmap t)
castBitmap IOBitmap s
bm1 Maybe Int
malign = do
  
  let nchn1 :: Int
nchn1 = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap s
bm1
      siz1 :: Size
siz1@(Int
w,Int
h) = IOBitmap s -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap s
bm1
      pad1 :: Int
pad1  = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap s
bm1
      fptr1 :: ForeignPtr s
fptr1 = IOBitmap s -> ForeignPtr s
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap s
bm1

  IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz1 Int
nchn1 Maybe Int
malign

  let pad2 :: Int
pad2  = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
      fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2

  ForeignPtr s -> (Ptr s -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr s
fptr1 ((Ptr s -> IO ()) -> IO ()) -> (Ptr s -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr s
ptr1 -> 
    ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->     
      CInt
-> CInt
-> CInt
-> CInt
-> Ptr s
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> IO ()
forall a b.
CInt
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> Ptr b
-> CInt
-> CInt
-> CInt
-> IO ()
c_cast_bitmap 
        (IOBitmap s -> CInt
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> CInt
bitmapCType IOBitmap s
bm1)  (IOBitmap t -> CInt
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> CInt
bitmapCType IOBitmap t
bm2)
        (Int -> CInt
ci Int
w) (Int -> CInt
ci Int
h)
        Ptr s
ptr1 (Int -> CInt
ci Int
nchn1) (Int -> CInt
ci Int
pad1) CInt
0 -- (ci ofs1)
        Ptr t
ptr2 (Int -> CInt
ci Int
nchn1) (Int -> CInt
ci Int
pad2) CInt
0 -- (ci ofs2)

  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
          
--------------------------------------------------------------------------------

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

  let siz1 :: Size
siz1@(Int
w1,Int
h1) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
      pad1 :: Int
pad1    = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
      nchn1 :: Int
nchn1   = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels  IOBitmap t
bm1
      fptr1 :: ForeignPtr t
fptr1   = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr        IOBitmap t
bm1
      xlen1 :: Int
xlen1   = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm1

  let siz2 :: Size
siz2@(Int
w2,Int
h2) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
      pad2 :: Int
pad2    = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
      nchn2 :: Int
nchn2   = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels  IOBitmap t
bm2
      fptr2 :: ForeignPtr t
fptr2   = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr        IOBitmap t
bm2
      xlen2 :: Int
xlen2   = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm2
      
  let len1 :: Int
len1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapUnpaddedRowSizeInBytes IOBitmap t
bm1
      len2 :: Int
len2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapUnpaddedRowSizeInBytes IOBitmap t
bm2

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ( Size
siz1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz2 Bool -> Bool -> Bool
|| Int
nchn1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nchn2 Bool -> Bool -> Bool
|| Int
len1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
len2 ) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"_flipBitmapInto" 

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

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

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

  let siz1 :: Size
siz1@(Int
w1,Int
h1) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
      pad1 :: Int
pad1    = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
      nchn1 :: Int
nchn1   = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels  IOBitmap t
bm1
      fptr1 :: ForeignPtr t
fptr1   = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr        IOBitmap t
bm1
      xlen1 :: Int
xlen1   = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm1

  let siz2 :: Size
siz2@(Int
w2,Int
h2) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
      pad2 :: Int
pad2    = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
      nchn2 :: Int
nchn2   = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels  IOBitmap t
bm2
      fptr2 :: ForeignPtr t
fptr2   = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr        IOBitmap t
bm2
      xlen2 :: Int
xlen2   = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm2
      
  let len1 :: Int
len1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapUnpaddedRowSizeInBytes IOBitmap t
bm1
      len2 :: Int
len2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapUnpaddedRowSizeInBytes IOBitmap t
bm2
      bpp1 :: Int
bpp1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPixelSizeInBytes IOBitmap t
bm1
      bpp2 :: Int
bpp2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPixelSizeInBytes IOBitmap t
bm2

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ( Size
siz1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz2 Bool -> Bool -> Bool
|| Int
nchn1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nchn2 Bool -> Bool -> Bool
|| Int
len1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
len2 Bool -> Bool -> Bool
|| Int
bpp1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
bpp2 ) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"_mirrorBitmapInto" 

  ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 -> 
    ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->     
      [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
        let p :: Ptr b
p = Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr t
ptr1 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen1)
            q :: Ptr b
q = Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr t
ptr2 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen2)
        CInt -> CInt -> Ptr Any -> Ptr Any -> IO ()
forall a. CInt -> CInt -> Ptr a -> Ptr a -> IO ()
c_mirror_line (Int -> CInt
ci Int
w1) (Int -> CInt
ci Int
bpp1) Ptr Any
forall b. Ptr b
p Ptr Any
forall b. Ptr b
q
              
-- | Flips the bitmap horizontally.
mirrorBitmap 
  :: PixelComponent t 
  => IOBitmap t             -- ^ source image
  -> Maybe Alignment        -- ^ target image row alignment
  -> IO (IOBitmap t) 
mirrorBitmap :: IOBitmap t -> Maybe Int -> IO (IOBitmap t)
mirrorBitmap IOBitmap t
bm1 Maybe Int
malign = do
  let nchn :: Int
nchn = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
      siz :: Size
siz@(Int
w,Int
h) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
  IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
nchn Maybe Int
malign 
  IOBitmap t -> IOBitmap t -> IO ()
forall t. PixelComponent t => IOBitmap t -> IOBitmap t -> IO ()
_mirrorBitmapInto IOBitmap t
bm1 IOBitmap t
bm2
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
  
mirrorBitmapInPlace
  :: PixelComponent t 
  => IOBitmap t             -- ^ source image
  -> IO () 
mirrorBitmapInPlace :: IOBitmap t -> IO ()
mirrorBitmapInPlace IOBitmap t
bm = do
  IOBitmap t -> IOBitmap t -> IO ()
forall t. PixelComponent t => IOBitmap t -> IOBitmap t -> IO ()
_mirrorBitmapInto IOBitmap t
bm IOBitmap t
bm
  
--------------------------------------------------------------------------------

extractSingleChannel 
  :: PixelComponent t 
  => IOBitmap t             -- ^ source image
  -> Maybe Alignment        -- ^ target image row alignment
  -> Int                    -- ^ source channel index
  -> IO (IOBitmap t) 
extractSingleChannel :: IOBitmap t -> Maybe Int -> Int -> IO (IOBitmap t)
extractSingleChannel IOBitmap t
bm1 Maybe Int
malign Int
j = do
  let nchn :: Int
nchn = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
      siz :: Size
siz@(Int
w,Int
h) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/extractSingleChannel: invalid channel index"
  IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
1 Maybe Int
malign
  IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
forall t.
PixelComponent t =>
IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
extractChannelInto IOBitmap t
bm1 Int
j IOBitmap t
bm2 Int
0
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
  
extractChannels :: PixelComponent t => IOBitmap t -> Maybe Alignment -> IO [IOBitmap t]
extractChannels :: IOBitmap t -> Maybe Int -> IO [IOBitmap t]
extractChannels IOBitmap t
bm Maybe Int
malign = 
  (Int -> IO (IOBitmap t)) -> [Int] -> IO [IOBitmap t]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (IOBitmap t -> Maybe Int -> Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
IOBitmap t -> Maybe Int -> Int -> IO (IOBitmap t)
extractSingleChannel IOBitmap t
bm Maybe Int
malign) [Int
0..Int
nchnInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] 
    where nchn :: Int
nchn = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm


combineChannels :: PixelComponent t => [IOBitmap t] -> Maybe Alignment -> IO (IOBitmap t)
combineChannels :: [IOBitmap t] -> Maybe Int -> IO (IOBitmap t)
combineChannels [] Maybe Int
_ = [Char] -> IO (IOBitmap t)
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/combineChannels: no channel data"
combineChannels [IOBitmap t]
bms Maybe Int
malign = do
  let sizes :: [Size]
sizes = (IOBitmap t -> Size) -> [IOBitmap t] -> [Size]
forall a b. (a -> b) -> [a] -> [b]
map IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize [IOBitmap t]
bms
      nchns :: [Int]
nchns = (IOBitmap t -> Int) -> [IOBitmap t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels [IOBitmap t]
bms
      pixsizs :: [Int]
pixsizs = (IOBitmap t -> Int) -> [IOBitmap t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPixelSizeInBytes [IOBitmap t]
bms 
      sumchn :: Int
sumchn = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
nchns 
      siz :: Size
siz@(Int
w,Int
h) = [Size] -> Size
forall a. [a] -> a
head [Size]
sizes
      
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Size] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Size] -> [Size]
forall a. Eq a => [a] -> [a]
nub [Size]
sizes) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/combineChannels: incompatible sizes"

  IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
sumchn Maybe Int
malign
  let pad2 :: Int
pad2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
      fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2

  let loop :: [(IOBitmap t, Int)]
loop = (IOBitmap t -> [(IOBitmap t, Int)])
-> [IOBitmap t] -> [(IOBitmap t, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\IOBitmap t
bm -> [IOBitmap t] -> [Int] -> [(IOBitmap t, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (IOBitmap t -> [IOBitmap t]
forall a. a -> [a]
repeat IOBitmap t
bm) [Int
0..IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]) [IOBitmap t]
bms

  ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 -> do
    [(Int, (IOBitmap t, Int))]
-> ((Int, (IOBitmap t, Int)) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [(IOBitmap t, Int)] -> [(Int, (IOBitmap t, Int))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(IOBitmap t, Int)]
loop) (((Int, (IOBitmap t, Int)) -> IO ()) -> IO ())
-> ((Int, (IOBitmap t, Int)) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
i,(IOBitmap t
bm1,Int
j)) -> do
      let pad1 :: Int
pad1  = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
          fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1    
          nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1    
      ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 -> 
        CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> IO ()
forall a.
CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> IO ()
c_extract_channel 
          (IOBitmap t -> CInt
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> CInt
bitmapCType ([IOBitmap t] -> IOBitmap t
forall a. [a] -> a
head [IOBitmap t]
bms))
          (Int -> CInt
ci Int
w) (Int -> CInt
ci Int
h)
          Ptr t
ptr1 (Int -> CInt
ci Int
nchn1)  (Int -> CInt
ci Int
pad1) (Int -> CInt
ci Int
j)
          Ptr t
ptr2 (Int -> CInt
ci Int
sumchn) (Int -> CInt
ci Int
pad2) (Int -> CInt
ci Int
i)
          
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2

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

  let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
      siz1 :: Size
siz1@(Int
w,Int
h) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
      pad1 :: Int
pad1  = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
      fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1

  let nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
      siz2 :: Size
siz2  = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
      pad2 :: Int
pad2  = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
      fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Size
siz1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz2)          (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/extractChannelInto: incompatible dimensions"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/extractChannelInto: invalid source channel index"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/extractChannelInto: invalid target channel index"
  
  ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 -> 
    ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->     
      CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> IO ()
forall a.
CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> IO ()
c_extract_channel 
        (IOBitmap t -> CInt
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> CInt
bitmapCType IOBitmap t
bm1)
        (Int -> CInt
ci Int
w) (Int -> CInt
ci Int
h)
        Ptr t
ptr1 (Int -> CInt
ci Int
nchn1) (Int -> CInt
ci Int
pad1) (Int -> CInt
ci Int
ofs1)
        Ptr t
ptr2 (Int -> CInt
ci Int
nchn2) (Int -> CInt
ci Int
pad2) (Int -> CInt
ci Int
ofs2)

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

bilinearResample
  :: PixelComponent t 
  => IOBitmap t      -- ^ source image
  -> Size            -- ^ target image size
  -> Maybe Alignment -- ^ target image alignment
  -> IO (IOBitmap t)   
bilinearResample :: IOBitmap t -> Size -> Maybe Int -> IO (IOBitmap t)
bilinearResample IOBitmap t
bm1 siz2 :: Size
siz2@(Int
w2,Int
h2) Maybe Int
malign = do
  let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
  IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz2 Int
nchn1 Maybe Int
malign
  [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
nchn1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
ofs ->
    IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
forall t.
PixelComponent t =>
IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
bilinearResampleChannelInto IOBitmap t
bm1 Int
ofs IOBitmap t
bm2 Int
ofs
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
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 :: IOBitmap t -> Int -> Size -> Maybe Int -> IO (IOBitmap t)
bilinearResampleChannel IOBitmap t
bm1 Int
ofs1 siz2 :: Size
siz2@(Int
w2,Int
h2) Maybe Int
malign = do
  let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/bilinearResampleChannel: invalid channel index"
  IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz2 Int
1 Maybe Int
malign
  IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
forall t.
PixelComponent t =>
IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
bilinearResampleChannelInto IOBitmap t
bm1 Int
ofs1 IOBitmap t
bm2 Int
0
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2


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

  let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
      siz1 :: Size
siz1@(Int
w1,Int
h1) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
      pad1 :: Int
pad1  = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
      fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1

  let nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
      siz2 :: Size
siz2@(Int
w2,Int
h2) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
      pad2 :: Int
pad2  = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
      fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/bilinearResampleChannelInto: invalid source channel index"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/bilinearResampleChannelInto: invalid target channel index"
  
  ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 -> 
    ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->     
      CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> IO ()
forall a.
CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> IO ()
c_bilinear_resample_channel 
        (t -> CInt
forall t. PixelComponent t => t -> CInt
c_type (IOBitmap t -> t
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> t
bitmapUndefined IOBitmap t
bm1))
        (Int -> CInt
ci Int
w1) (Int -> CInt
ci Int
h1) Ptr t
ptr1 (Int -> CInt
ci Int
nchn1) (Int -> CInt
ci Int
pad1) (Int -> CInt
ci Int
ofs1)
        (Int -> CInt
ci Int
w2) (Int -> CInt
ci Int
h2) Ptr t
ptr2 (Int -> CInt
ci Int
nchn2) (Int -> CInt
ci Int
pad2) (Int -> CInt
ci Int
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 :: Float -> IOBitmap t -> Maybe Int -> IO (IOBitmap t)
powerlawGammaCorrection Float
gamma IOBitmap t
bm1 Maybe Int
malign = do
  let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
      siz1 :: Size
siz1@(Int
w1,Int
h1) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
      pad1 :: Int
pad1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
      fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1
  IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz1 Int
nchn1 Maybe Int
malign
  let pad2 :: Int
pad2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
      fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2
  ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 -> 
    ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->     
      CInt
-> CFloat
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> Ptr t
-> CInt
-> IO ()
forall a.
CInt
-> CFloat
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> Ptr a
-> CInt
-> IO ()
c_gamma_correct_all_channels 
        (t -> CInt
forall t. PixelComponent t => t -> CInt
c_type (IOBitmap t -> t
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> t
bitmapUndefined IOBitmap t
bm1))
        (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
gamma) 
        (Int -> CInt
ci Int
w1) (Int -> CInt
ci Int
h1) (Int -> CInt
ci Int
nchn1) 
        Ptr t
ptr1 (Int -> CInt
ci Int
pad1) 
        Ptr t
ptr2 (Int -> CInt
ci Int
pad2) 
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
  

powerlawGammaCorrectionChannel
  :: PixelComponent t 
  => Float           -- ^ gamma
  -> IOBitmap t      -- ^ source image
  -> Int             -- ^ source channel index 
  -> Maybe Alignment -- ^ target image alignment
  -> IO (IOBitmap t)   
powerlawGammaCorrectionChannel :: Float -> IOBitmap t -> Int -> Maybe Int -> IO (IOBitmap t)
powerlawGammaCorrectionChannel Float
gamma IOBitmap t
bm1 Int
ofs1 Maybe Int
malign = do
  let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
      siz1 :: Size
siz1  = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/powerlawGammaCorrectionChannel: invalid channel index"
  IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz1 Int
1 Maybe Int
malign
  Float -> IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
forall t.
PixelComponent t =>
Float -> IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
powerlawGammaCorrectionChannelInto Float
gamma IOBitmap t
bm1 Int
ofs1 IOBitmap t
bm2 Int
0
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
  
  
powerlawGammaCorrectionChannelInto
  :: PixelComponent t 
  => Float        -- ^ gamma
  -> IOBitmap t   -- ^ source image
  -> Int          -- ^ source channel index 
  -> IOBitmap t   -- ^ target image
  -> Int          -- ^ target channel index
  -> IO ()
powerlawGammaCorrectionChannelInto :: Float -> IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
powerlawGammaCorrectionChannelInto Float
gamma IOBitmap t
bm1 Int
ofs1 IOBitmap t
bm2 Int
ofs2 = do

  let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
      siz1 :: Size
siz1@(Int
w1,Int
h1) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
      pad1 :: Int
pad1  = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
      fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1

  let nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
      siz2 :: Size
siz2@(Int
w2,Int
h2) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
      pad2 :: Int
pad2  = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
      fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Size
siz1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz2)          (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/powerlawGammaCorrectionChannelInto: incompatible dimensions"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/powerlawGammaCorrectionChannelInto: invalid source channel index"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/powerlawGammaCorrectionChannelInto: invalid target channel index"
  
  ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 -> 
    ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->     
      CInt
-> CFloat
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> IO ()
forall a.
CInt
-> CFloat
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> IO ()
c_gamma_correct_channel 
        (t -> CInt
forall t. PixelComponent t => t -> CInt
c_type (IOBitmap t -> t
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> t
bitmapUndefined IOBitmap t
bm1))
        (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
gamma) 
        (Int -> CInt
ci Int
w1) (Int -> CInt
ci Int
h1) 
        Ptr t
ptr1 (Int -> CInt
ci Int
nchn1) (Int -> CInt
ci Int
pad1) (Int -> CInt
ci Int
ofs1)
        Ptr t
ptr2 (Int -> CInt
ci Int
nchn2) (Int -> CInt
ci Int
pad2) (Int -> CInt
ci Int
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 :: Float
-> Float
-> IOBitmap t
-> IOBitmap t
-> Maybe Int
-> IO (IOBitmap t)
blendBitmaps Float
weight1 Float
weight2 IOBitmap t
bm1 IOBitmap t
bm2 Maybe Int
malign = do 
  let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
      siz1 :: Size
siz1  = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
  let nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
      siz2 :: Size
siz2  = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Size
siz1  Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz2 ) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blend: incompatible dimensions"    
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nchn1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blend: incompatible number of channels"
  IOBitmap t
bm3 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz1 Int
nchn1 Maybe Int
malign
  [Int] -> (Int -> IO ()) -> IO [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..Int
nchn1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO ()) -> IO [()]) -> (Int -> IO ()) -> IO [()]
forall a b. (a -> b) -> a -> b
$ \Int
ofs -> 
    Float
-> Float
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IO ()
forall t.
PixelComponent t =>
Float
-> Float
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IO ()
blendChannelsInto Float
weight1 Float
weight2 IOBitmap t
bm1 Int
ofs IOBitmap t
bm2 Int
ofs IOBitmap t
bm3 Int
ofs
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
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 :: Float
-> Float
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> Maybe Int
-> IO (IOBitmap t)
blendChannels Float
weight1 Float
weight2 IOBitmap t
bm1 Int
ofs1 IOBitmap t
bm2 Int
ofs2 Maybe Int
malign = do
  let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
      siz1 :: Size
siz1  = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
  let nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
      siz2 :: Size
siz2  = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Size
siz1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz2)          (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannels: incompatible dimensions"    
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannels: invalid channel index"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannels: invalid channel index"
  IOBitmap t
bm3 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz1 Int
1 Maybe Int
malign
  Float
-> Float
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IO ()
forall t.
PixelComponent t =>
Float
-> Float
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IO ()
blendChannelsInto Float
weight1 Float
weight2 IOBitmap t
bm1 Int
ofs1 IOBitmap t
bm2 Int
ofs2 IOBitmap t
bm3 Int
0
  IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
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 :: Float
-> Float
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IO ()
blendChannelsInto Float
weight1 Float
weight2 IOBitmap t
bm1 Int
ofs1 IOBitmap t
bm2 Int
ofs2 IOBitmap t
bm3 Int
ofs3 = do

  let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
      siz1 :: Size
siz1@(Int
w1,Int
h1) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
      pad1 :: Int
pad1  = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
      fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1

  let nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
      siz2 :: Size
siz2@(Int
w2,Int
h2) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
      pad2 :: Int
pad2  = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
      fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2

  let nchn3 :: Int
nchn3 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm3
      siz3 :: Size
siz3@(Int
w3,Int
h3) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm3
      pad3 :: Int
pad3  = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm3
      fptr3 :: ForeignPtr t
fptr3 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm3

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Size
siz1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz2)          (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannelInto: incompatible dimensions"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Size
siz2 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz3)          (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannelInto: incompatible dimensions"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannelInto: invalid source channel index 1"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannelInto: invalid source channel index 2"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs3Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs3Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn3) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannelInto: invalid target channel index"
  
  ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 -> 
    ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->     
      ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr3 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr3 ->     
        CInt
-> CFloat
-> CFloat
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> IO ()
forall a.
CInt
-> CFloat
-> CFloat
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> IO ()
c_linear_combine_channels 
          (IOBitmap t -> CInt
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> CInt
bitmapCType IOBitmap t
bm1)
          (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
weight1) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
weight2) 
          (Int -> CInt
ci Int
w1) (Int -> CInt
ci Int
h1) 
          Ptr t
ptr1 (Int -> CInt
ci Int
nchn1) (Int -> CInt
ci Int
pad1) (Int -> CInt
ci Int
ofs1)
          Ptr t
ptr2 (Int -> CInt
ci Int
nchn2) (Int -> CInt
ci Int
pad2) (Int -> CInt
ci Int
ofs2)
          Ptr t
ptr3 (Int -> CInt
ci Int
nchn3) (Int -> CInt
ci Int
pad3) (Int -> CInt
ci Int
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 :: Ptr a -> a
ptrUndefined Ptr a
_ = a
forall a. HasCallStack => a
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 :: Ptr a -> Ptr a
advancePtr1 Ptr a
p = Ptr a
p Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (a -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr a -> a
forall a. Ptr a -> a
ptrUndefined Ptr a
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

ci :: Int -> CInt
ci :: Int -> CInt
ci = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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 ()

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