bitmap 0.0.1 → 0.0.2

raw patch · 14 files changed

+1827/−278 lines, 14 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Data/Bitmap.hs +7/−10
• Data/Bitmap/Base.hs +13/−4
• Data/Bitmap/IO.hs +541/−196
• Data/Bitmap/IO/File.hs +166/−0
• Data/Bitmap/IO/Pixels.hs +202/−0
• Data/Bitmap/Internal.hs +179/−27
• Data/Bitmap/Pure.hs +104/−35
• Data/Bitmap/Pure/File.hs +67/−0
• Data/Bitmap/Pure/Pixels.hs +153/−0
• Data/Bitmap/Simple.hs +236/−0
• LICENSE +1/−1
• bitmap.cabal +11/−5
• cbits/bm.c +133/−0
• cbits/bm.h +14/−0

@@ -1,13 +1,13 @@  -------------------------------------------------------------------------------- -- Module      : Data.Bitmap--- Version     : 0.0.1+-- Version     : 0.0.2 -- License     : BSD3--- Copyright   : (c) 2009 Balazs Komuves+-- Copyright   : (c) 2009-2010 Balazs Komuves -- Author      : Balazs Komuves -- Maintainer  : bkomuves (plus) hackage (at) gmail (dot) com -- Stability   : experimental--- Portability : requires FFI, CPP and ScopedTypeVariables+-- Portability : requires FFI and CPP -- Tested with : GHC 6.10.1 -------------------------------------------------------------------------------- @@ -36,21 +36,18 @@ -- performance is not the primary goal (thus there is no inline assembly, -- no SSE, etc.; but the critical functions are coded in C). ----- There are both pure and IO versions of the API; you shouldn't mix--- the two without taking special care.--- This module re-exports the pure interface; if you want the IO one,--- import 'Data.Bitmap.IO' instead.+-- There are both pure and mutable IO versions of the API (ST is also planned).+-- This module re-exports the simplified pure interface. -- -{-# LANGUAGE CPP, ForeignFunctionInterface, ScopedTypeVariables #-} module Data.Bitmap -  ( module Data.Bitmap.Pure+  ( module Data.Bitmap.Simple   )    where  -------------------------------------------------------------------------------- -import Data.Bitmap.Pure+import Data.Bitmap.Simple  -------------------------------------------------------------------------------- 

@@ -1,13 +1,13 @@  -------------------------------------------------------------------------------- -- Module      : Data.Bitmap.Base--- Version     : 0.0.1+-- Version     : 0.0.2 -- License     : BSD3 -- Copyright   : (c) 2009 Balazs Komuves -- Author      : Balazs Komuves -- Maintainer  : bkomuves (plus) hackage (at) gmail (dot) com -- Stability   : experimental--- Portability : requires FFI, CPP and ScopedTypeVariables+-- Portability : requires FFI and CPP -- Tested with : GHC 6.10.1 -------------------------------------------------------------------------------- @@ -28,10 +28,10 @@ -- word boundary, for example.  -- -{-# LANGUAGE CPP, ForeignFunctionInterface, ScopedTypeVariables #-}+{-# LANGUAGE CPP #-} module Data.Bitmap.Base    ( -    -- * Types+    --      PixelComponent   , PixelComponentType(..)   , pixelComponentSize@@ -53,12 +53,21 @@   , bitmapRowPadding    , bitmapRowAlignment    , bitmapAspect+  , bitmapComponentType     --   , bitmapComponentSizeInBytes   , bitmapPixelSizeInBytes   , bitmapPaddedRowSizeInBytes   , bitmapUnpaddedRowSizeInBytes   , bitmapSizeInBytes+    --+  , BitmapClass -- (..)+{-+  , Bitmap1, Bitmap2, Bitmap3, Bitmap4+  , bitmap1, bitmap2, bitmap3, bitmap4+-}+    --+  , BitmapChannel(..)   )    where 

@@ -1,30 +1,40 @@  -------------------------------------------------------------------------------- -- Module      : Data.Bitmap.IO--- Version     : 0.0.1+-- Version     : 0.0.2 -- License     : BSD3--- Copyright   : (c) 2009 Balazs Komuves+-- Copyright   : (c) 2009-2010 Balazs Komuves -- Author      : Balazs Komuves -- Maintainer  : bkomuves (plus) hackage (at) gmail (dot) com -- Stability   : experimental--- Portability : requires FFI, CPP and ScopedTypeVariables+-- Portability : requires FFI and CPP -- Tested with : GHC 6.10.1 --------------------------------------------------------------------------------  -- | The full, mutable API in the IO monad. -{-# LANGUAGE CPP, ForeignFunctionInterface, ScopedTypeVariables #-}+{-# 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-  , newBitmap-  , newBitmapUninitialized+  , emptyBitmap+  , cloneBitmap+  , emptyCloneBitmap   , createSingleChannelBitmap+  , newIOBitmap+  , newIOBitmapUninitialized   , copyBitmapFromPtr-  , bitmapFromForeignPtrUnsafe-  , withBitmap+  -- , bitmapFromForeignPtrUnsafe+  , ioBitmapFromForeignPtrUnsafe+    -- * Using bitmaps+  , withIOBitmap     -- * Mapping over bitmaps   , componentMap   , componentMap'@@ -33,6 +43,15 @@   , copySubImage   , copySubImage'     , copySubImageInto+    -- * Flipping and mirroring+  , flipBitmap+  , flipBitmapInPlace+  , mirrorBitmap+  , mirrorBitmapInPlace+    -- * Cast+  , castBitmap+  -- , castChannel+  -- , castChannelInto     -- * Manipulating channels   , combineChannels    , extractChannels @@ -50,11 +69,18 @@   , powerlawGammaCorrection   , powerlawGammaCorrectionChannel     , powerlawGammaCorrectionChannelInto  +{-       -- * Conversion to\/from ByteString   , copyBitmapToByteString   , copyBitmapFromByteString+-}  +{-     -- * Reading and writing pixels   , withComponentPtr+  , IOBitmap1 (..)+  , IOBitmap2 (..)+  , IOBitmap3 (..)+  , IOBitmap4 (..)   , unsafeReadComponent   , unsafeWriteComponent   , unsafeReadComponents@@ -68,20 +94,25 @@   , unsafeWritePixel2   , unsafeWritePixel3   , unsafeWritePixel4+-}   )    where    --------------------------------------------------------------------------------  import Control.Monad+import Control.Applicative  --import Data.Array.IArray  import Data.Word import Data.List (nub) -import Foreign 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@@ -91,7 +122,15 @@ import Data.Bitmap.Base  --------------------------------------------------------------------------------+  +unsafeFreezeBitmap :: IOBitmap t -> Bitmap t  +unsafeFreezeBitmap = unIOBitmap +unsafeThawBitmap :: Bitmap t -> IOBitmap t+unsafeThawBitmap = IOBitmap++--------------------------------------------------------------------------------+ defaultAlignment :: Int defaultAlignment = 4 @@ -102,24 +141,36 @@ validateAlignment k =    if isValidAlignment k      then k -    else error "invalid row alignment (allowed values: 1, 2, 4 and 8)"+    else error "invalid row alignment (allowed values: 1, 2, 4, and 8)" -- and 16)"    ---------------------------------------------------------------------------------  ++-- GHC's type inference is acting up, that's why we need this here+allocBitmap :: PixelComponent t => Bitmap t -> IO (Bitmap t)+allocBitmap bm0 = do+  fptr <- mallocForeignPtrBytes (bitmapSizeInBytes bm0) -- :: IO (ForeignPtr t)+  return $ bm0 { _bitmapPtr = fptr }++allocIOBitmap :: PixelComponent t => IOBitmap t -> IO (IOBitmap t)+allocIOBitmap bm = IOBitmap <$> (allocBitmap $ unIOBitmap bm)+ -- we do not initialize the new bitmap!-newBitmapRaw :: forall t. PixelComponent t => Size -> NChn -> Padding -> Alignment -> IO (Bitmap t)   +newBitmapRaw :: PixelComponent t => Size -> NChn -> Padding -> Alignment -> IO (IOBitmap t)    newBitmapRaw siz nchn pad align = do   let bm0 = Bitmap -        { bitmapSize = siz-        , bitmapNChannels = nchn-        , bitmapPtr = undefined -        , bitmapRowPadding = pad-        , bitmapRowAlignment = align-        } :: Bitmap t-      len = bitmapSizeInBytes bm0-  fptr <- mallocForeignPtrBytes len :: IO (ForeignPtr t)+        { _bitmapSize = siz+        , _bitmapNChannels = nchn+        , _bitmapPtr = undefined +        , _bitmapRowPadding = pad+        , _bitmapRowAlignment = align+        } -- :: Bitmap t+{-        +  let len = bitmapSizeInBytes bm0      +  fptr <- mallocForeignPtrBytes len -- :: IO (ForeignPtr t)   return $ bm0 { bitmapPtr = fptr }-  +-}+  IOBitmap <$> allocBitmap bm0+    -- | Note: we /cannot/ guarantee the alignment -- of the memory block (but typically it is aligned at least to machine word boundary), -- but what we /can/ guarantee is that the rows are properly padded.@@ -129,67 +180,69 @@ -- smallest multiple of a component size such that the next row is aligned). --  -- The resulting new bitmap is filled with zeros.-newBitmap -  :: forall t. PixelComponent t +newIOBitmap +  :: PixelComponent t    => Size             -- ^ (width,height)   -> NChn             -- ^ number of channels (components\/pixel)   -> Maybe Alignment  -- ^ the row alignment of the new image-  -> IO (Bitmap t)-newBitmap siz nchn malign = do  -  bm <- newBitmapUninitialized siz nchn malign -- :: IO (Bitmap t)+  -> IO (IOBitmap t)+newIOBitmap siz nchn malign = do  +  bm <- newIOBitmapUninitialized siz nchn malign -- :: IO (Bitmap t)   let fptr = bitmapPtr bm       len  = bitmapSizeInBytes bm   withForeignPtr fptr $ \p -> c_memset (castPtr p) len 0   return bm -newBitmapUninitialized :: forall t. PixelComponent t => Size -> NChn -> Maybe Alignment -> IO (Bitmap t)-newBitmapUninitialized siz nchn malign = do-  let bm0 = Bitmap -        { bitmapSize = siz-        , bitmapNChannels = nchn-        , bitmapPtr = undefined -        , bitmapRowPadding = pad-        , bitmapRowAlignment = align-        } :: Bitmap t-      x0 = bitmapUnpaddedRowSizeInBytes bm0-      -      align = validateMaybeAlignment malign-      pad = recommendedPadding bm0-{--      (pad,align) = case malign of-        Nothing -> (0,1)-        Just align -> let x1 = align * ((x0 + align - 1) `div` align) in (x1 - x0, align)--}        -  newBitmapRaw siz nchn pad align+allocBitmapWithRecommendedPadding :: PixelComponent t => Bitmap t -> IO (Bitmap t)+allocBitmapWithRecommendedPadding bm0 = +  allocBitmap $ +    bm0 { _bitmapRowPadding = recommendedPadding bm0 }    +newIOBitmapUninitialized :: PixelComponent t => Size -> NChn -> Maybe Alignment -> IO (IOBitmap t)+newIOBitmapUninitialized siz nchn malign = do+  let align = validateMaybeAlignment malign+      bm0 = Bitmap +        { _bitmapSize = siz+        , _bitmapNChannels = nchn+        , _bitmapPtr = undefined +        , _bitmapRowPadding = undefined -- pad+        , _bitmapRowAlignment = align+        } -- :: Bitmap t+{-      +  let pad = recommendedPadding bm0+  newBitmapRaw siz nchn pad align+-}+  bm <- allocBitmapWithRecommendedPadding bm0+  return (IOBitmap bm)+ -- | Creates a new single-channel bitmap, using the given function to compute -- the pixel values. -- Warning, this is probably slow!   createSingleChannelBitmap -  :: forall t. PixelComponent t +  :: 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 (Bitmap t)+  -> IO (IOBitmap t) createSingleChannelBitmap siz malign fun = do  -  bm <- newBitmapUninitialized siz 1 malign +  bm <- newIOBitmapUninitialized siz 1 malign    let fptr = bitmapPtr bm       len  = bitmapSizeInBytes bm-      f :: Int -> Int -> t -> t+      -- f :: Int -> Int -> t -> t       f x y _ = fun x y    genericComponentMapWithPos f bm bm   return bm  {-     createBitmap    -  :: forall t. PixelComponent t +  :: 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 <- newBitmapUninitialized siz nchn malign +  bm <- newIOBitmapUninitialized siz nchn malign    let fptr = bitmapPtr bm       len  = bitmapSizeInBytes bm       f :: Int -> Int -> t -> t@@ -199,16 +252,16 @@ -}      copyBitmapFromPtr -  :: forall t. PixelComponent t +  :: 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 (Bitmap t)+  -> IO (IOBitmap t) copyBitmapFromPtr siz@(w,h) nchn srcpad srcptr tgtmalign = do-  bm <- newBitmapUninitialized siz nchn tgtmalign-  withBitmap bm $ \_ _ _ tgtptr -> do+  bm <- newIOBitmapUninitialized siz nchn tgtmalign+  withIOBitmap bm $ \_ _ _ tgtptr -> do     let pure_line = bitmapUnpaddedRowSizeInBytes bm         src_line  = pure_line + srcpad         tgt_line  = bitmapPaddedRowSizeInBytes bm@@ -216,46 +269,43 @@       let p = srcptr `myPlusPtr` (y*src_line)           q = tgtptr `myPlusPtr` (y*tgt_line)       c_memcpy (castPtr p) (castPtr q) pure_line -  return bm  +  return bm -bitmapFromForeignPtrUnsafe -  :: forall t. PixelComponent t -  => Size -> NChn -> Alignment -> Padding -> ForeignPtr t -> Bitmap t-bitmapFromForeignPtrUnsafe siz nchn align pad fptr = Bitmap-  { bitmapSize      = siz -  , bitmapNChannels = nchn -  , bitmapPtr       = fptr -  , bitmapRowPadding   = pad -  , bitmapRowAlignment = align-  }-      --- | @withBitmap bitmap $ \\(w,h) nchn padding ptr -> ...@-withBitmap :: PixelComponent t => Bitmap t -> (Size -> NChn -> Padding -> Ptr t -> IO a) -> IO a-withBitmap bm action = +ioBitmapFromForeignPtrUnsafe +  :: PixelComponent t +  => Size -> NChn -> Alignment -> Padding -> ForeignPtr t -> IOBitmap t+ioBitmapFromForeignPtrUnsafe siz nchn align pad fptr = IOBitmap $ +  bitmapFromForeignPtrUnsafe siz nchn align pad fptr+        +-- | @withIOBitmap bitmap $ \\(w,h) nchn padding ptr -> ...@+withIOBitmap :: PixelComponent t => IOBitmap t -> (Size -> NChn -> Padding -> Ptr t -> IO a) -> IO a+withIOBitmap (IOBitmap bm) action =    withForeignPtr (bitmapPtr bm) $ \p ->      action (bitmapSize bm) (bitmapNChannels bm) (bitmapRowPadding bm) p  -------------------------------------------------------------------------------- +{-+ -- | Note that the resulting pointer is valid only within a line (because of the padding) withComponentPtr -  :: forall t a. PixelComponent t -  => Bitmap t         -- ^ the bitmap+  :: 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 bm (x,y) ofs action = +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 (undefined::t) + y * rowsize ) +        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 -  => Bitmap t      -- ^ the bitmap+  => IOBitmap t    -- ^ the bitmap   -> Offset        -- ^ position (x,y)   -> Int           -- ^ channel index {0,1,...,nchannels-1}   -> IO t@@ -263,7 +313,7 @@      unsafeWriteComponent   :: PixelComponent t -  => Bitmap t      -- ^ the bitmap+  => IOBitmap t    -- ^ the bitmap   -> Offset        -- ^ position (x,y)   -> Int           -- ^ channel index {0,1,...,nchannels-1}   -> t             -- ^ the value to write@@ -274,7 +324,7 @@ -- the boundary between lines. unsafeReadComponents   :: PixelComponent t -  => Bitmap t      -- ^ the bitmap+  => IOBitmap t    -- ^ the bitmap   -> Offset        -- ^ position (x,y)   -> Int           -- ^ channel index {0,1,...,nchannels-1}   -> Int           -- ^ the number of components to read@@ -285,7 +335,7 @@ -- the boundary between lines. unsafeWriteComponents   :: PixelComponent t -  => Bitmap t      -- ^ the bitmap+  => IOBitmap t      -- ^ the bitmap   -> Offset        -- ^ position (x,y)   -> Int           -- ^ channel index {0,1,...,nchannels-1}   -> [t]           -- ^ the components to write@@ -294,64 +344,94 @@  unsafeReadPixel    :: PixelComponent t -  => Bitmap t      -- ^ the bitmap+  => IOBitmap t      -- ^ the bitmap   -> Offset        -- ^ position (x,y)   -> IO [t] unsafeReadPixel bm xy = unsafeReadComponents bm xy 0 (bitmapNChannels bm)    --- | These functions assume that the number of channels of the bitmap--- agrees with the number suffix of the function. ------ (Maybe I should put--- the number of components into the Bitmap type? But that would cause--- different problems...)-unsafeReadPixel1 :: PixelComponent t => Bitmap t -> Offset -> IO t-unsafeReadPixel2 :: PixelComponent t => Bitmap t -> Offset -> IO (t,t)-unsafeReadPixel3 :: PixelComponent t => Bitmap t -> Offset -> IO (t,t,t)-unsafeReadPixel4 :: PixelComponent t => Bitmap t -> Offset -> IO (t,t,t,t)+-------------------------------------------------------------------------------- -unsafeWritePixel1 :: PixelComponent t => Bitmap t -> Offset -> t -> IO ()-unsafeWritePixel2 :: PixelComponent t => Bitmap t -> Offset -> (t,t) -> IO ()-unsafeWritePixel3 :: PixelComponent t => Bitmap t -> Offset -> (t,t,t) -> IO ()-unsafeWritePixel4 :: PixelComponent t => Bitmap t -> Offset -> (t,t,t,t) -> IO ()+instance BitmapClass IOBitmap1 where+  underlyingBitmap = unIOBitmap . fromIOBitmap1 -unsafeReadPixel1 bm xy = withComponentPtr bm xy 0 $ \p -> liftM (\[x]       ->  x       ) $ peekArray 1 p-unsafeReadPixel2 bm xy = withComponentPtr bm xy 0 $ \p -> liftM (\[x,y]     -> (x,y)    ) $ peekArray 2 p-unsafeReadPixel3 bm xy = withComponentPtr bm xy 0 $ \p -> liftM (\[x,y,z]   -> (x,y,z)  ) $ peekArray 3 p-unsafeReadPixel4 bm xy = withComponentPtr bm xy 0 $ \p -> liftM (\[x,y,z,w] -> (x,y,z,w)) $ peekArray 4 p+instance BitmapClass IOBitmap2 where+  underlyingBitmap = unIOBitmap . fromIOBitmap2 -unsafeWritePixel1 bm xy  x        = withComponentPtr bm xy 0 $ \q -> pokeArray q [x]-unsafeWritePixel2 bm xy (x,y)     = withComponentPtr bm xy 0 $ \q -> pokeArray q [x,y]-unsafeWritePixel3 bm xy (x,y,z)   = withComponentPtr bm xy 0 $ \q -> pokeArray q [x,y,z]-unsafeWritePixel4 bm xy (x,y,z,w) = withComponentPtr bm xy 0 $ \q -> pokeArray q [x,y,z,w]+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 ()) -> Bitmap Word8  -> Bitmap Word8  -> IO () #-}+      :: (Int -> Int -> Ptr Word8  -> Ptr Word8  -> IO ()) -> IOBitmap Word8  -> IOBitmap Word8  -> IO () #-} {-# SPECIALIZE genericComponentRowMap -      :: (Int -> Int -> Ptr Word16 -> Ptr Word16 -> IO ()) -> Bitmap Word16 -> Bitmap Word16 -> IO () #-}+      :: (Int -> Int -> Ptr Word16 -> Ptr Word16 -> IO ()) -> IOBitmap Word16 -> IOBitmap Word16 -> IO () #-} {-# SPECIALIZE genericComponentRowMap -      :: (Int -> Int -> Ptr Word32 -> Ptr Word32 -> IO ()) -> Bitmap Word32 -> Bitmap Word32 -> IO () #-}+      :: (Int -> Int -> Ptr Word32 -> Ptr Word32 -> IO ()) -> IOBitmap Word32 -> IOBitmap Word32 -> IO () #-} {-# SPECIALIZE genericComponentRowMap -      :: (Int -> Int -> Ptr Float  -> Ptr Float  -> IO ()) -> Bitmap Float  -> Bitmap Float  -> IO () #-}+      :: (Int -> Int -> Ptr Float  -> Ptr Float  -> IO ()) -> IOBitmap Float  -> IOBitmap Float  -> IO () #-}  {-# SPECIALIZE genericComponentRowMap -      :: (Int -> Int -> Ptr Word8  -> Ptr Float  -> IO ()) -> Bitmap Word8  -> Bitmap Float  -> IO () #-}+      :: (Int -> Int -> Ptr Word8  -> Ptr Float  -> IO ()) -> IOBitmap Word8  -> IOBitmap Float  -> IO () #-} {-# SPECIALIZE genericComponentRowMap -      :: (Int -> Int -> Ptr Float  -> Ptr Word8  -> IO ()) -> Bitmap Float  -> Bitmap Word8  -> IO () #-}+      :: (Int -> Int -> Ptr Float  -> Ptr Word8  -> IO ()) -> IOBitmap Float  -> IOBitmap Word8  -> IO () #-}  {-# SPECIALIZE genericComponentRowMap -      :: (Int -> Int -> Ptr Word16 -> Ptr Float  -> IO ()) -> Bitmap Word16 -> Bitmap Float  -> IO () #-}+      :: (Int -> Int -> Ptr Word16 -> Ptr Float  -> IO ()) -> IOBitmap Word16 -> IOBitmap Float  -> IO () #-} {-# SPECIALIZE genericComponentRowMap -      :: (Int -> Int -> Ptr Float  -> Ptr Word16 -> IO ()) -> Bitmap Float  -> Bitmap Word16 -> IO () #-}+      :: (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-  -> Bitmap s -> Bitmap t -> IO ()+  -> IOBitmap s -> IOBitmap t -> IO () genericComponentRowMap rowAction bm1 bm2 = do    let (w1,h1) = bitmapSize       bm1@@ -386,7 +466,7 @@ genericPixelRowMap    :: (PixelComponent s, PixelComponent t)    => (Int -> Int -> Ptr s -> NChn -> Ptr t -> NChn -> IO ())    -- ^ ypos width ptr1 nchn1 ptr2 nchn2 -  -> Bitmap s -> Bitmap t -> IO ()+  -> IOBitmap s -> IOBitmap t -> IO () genericPixelRowMap rowAction bm1 bm2 = do    let (w1,h1) = bitmapSize       bm1@@ -413,45 +493,47 @@  --------------------------------------------------------------------------------       -{-# SPECIALIZE genericComponentMap :: (Word8  -> Word8 ) -> Bitmap Word8  -> Bitmap Word8  -> IO () #-}      -{-# SPECIALIZE genericComponentMap :: (Word16 -> Word16) -> Bitmap Word16 -> Bitmap Word16 -> IO () #-}      -{-# SPECIALIZE genericComponentMap :: (Word32 -> Word32) -> Bitmap Word32 -> Bitmap Word32 -> IO () #-}      -{-# SPECIALIZE genericComponentMap :: (Float  -> Float ) -> Bitmap Float  -> Bitmap Float  -> IO () #-}      +{-# 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 ) -> Bitmap Word8  -> Bitmap Float  -> IO () #-}      -{-# SPECIALIZE genericComponentMap :: (Float  -> Word8 ) -> Bitmap Float  -> Bitmap Word8  -> IO () #-}+{-# SPECIALIZE genericComponentMap :: (Word8  -> Float ) -> IOBitmap Word8  -> IOBitmap Float  -> IO () #-}      +{-# SPECIALIZE genericComponentMap :: (Float  -> Word8 ) -> IOBitmap Float  -> IOBitmap Word8  -> IO () #-}       -{-# SPECIALIZE genericComponentMap :: (Word16 -> Float ) -> Bitmap Word16 -> Bitmap Float  -> IO () #-}      -{-# SPECIALIZE genericComponentMap :: (Float  -> Word16) -> Bitmap Float  -> Bitmap Word16 -> 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) -  => (s -> t) -> Bitmap s -> Bitmap t -> IO ()  +--  :: forall s t . (PixelComponent s, PixelComponent t) +  :: (PixelComponent s, PixelComponent t) +  => (s -> t) -> IOBitmap s -> IOBitmap t -> IO ()   genericComponentMap f bm1 bm2 = genericComponentRowMap g bm1 bm2 where-  h :: (Ptr s, Ptr t) -> Int -> IO (Ptr s, Ptr t)+  --h :: (Ptr s, Ptr t) -> Int -> IO (Ptr s, Ptr t)   h (q1,q2) _ = do     x <- peek q1     poke q2 (f x)     return (advancePtr1 q1, advancePtr1 q2)-  g :: Int -> Int -> Ptr s -> Ptr t -> IO ()+  --g :: Int -> Int -> Ptr s -> Ptr t -> IO ()   g ypos n p1 p2 = do     foldM_ h (p1,p2) [0..n-1] -{-# SPECIALIZE genericComponentMapWithPos :: (Int -> Int -> Word8  -> Word8 ) -> Bitmap Word8  -> Bitmap Word8  -> IO () #-}      -{-# SPECIALIZE genericComponentMapWithPos :: (Int -> Int -> Word16 -> Word16) -> Bitmap Word16 -> Bitmap Word16 -> IO () #-}      -{-# SPECIALIZE genericComponentMapWithPos :: (Int -> Int -> Word32 -> Word32) -> Bitmap Word32 -> Bitmap Word32 -> IO () #-}      -{-# SPECIALIZE genericComponentMapWithPos :: (Int -> Int -> Float  -> Float ) -> Bitmap Float  -> Bitmap Float  -> IO () #-}      +{-# 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) -  => (Int -> Int -> s -> t) -> Bitmap s -> Bitmap t -> IO ()  +--  :: forall s t . (PixelComponent s, PixelComponent t) +  :: (PixelComponent s, PixelComponent t) +  => (Int -> Int -> s -> t) -> IOBitmap s -> IOBitmap t -> IO ()   genericComponentMapWithPos f bm1 bm2 = genericComponentRowMap g bm1 bm2 where-  h :: Int -> (Ptr s, Ptr t) -> Int -> IO (Ptr s, Ptr t)+  --h :: Int -> (Ptr s, Ptr t) -> Int -> IO (Ptr s, Ptr t)   h ypos (q1,q2) xpos = do     x <- peek q1     poke q2 (f xpos ypos x)     return (advancePtr1 q1, advancePtr1 q2)-  g :: Int -> Int -> Ptr s -> Ptr t -> IO ()+  --g :: Int -> Int -> Ptr s -> Ptr t -> IO ()   g ypos n p1 p2 = do     foldM_ (h ypos) (p1,p2) [0..n-1] @@ -463,16 +545,16 @@ -- 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) -> Bitmap s -> IO (Bitmap s)+componentMap :: PixelComponent s => (s -> s) -> IOBitmap s -> IO (IOBitmap s) componentMap f bm1 = do   let siz   = bitmapSize bm1       nchn  = bitmapNChannels bm1       align = bitmapRowAlignment bm1-  bm2 <- newBitmapUninitialized siz nchn (Just align) +  bm2 <- newIOBitmapUninitialized siz nchn (Just align)    genericComponentMap f bm1 bm2    return bm2 -componentMapInPlace :: PixelComponent s => (s -> s) -> Bitmap s -> IO ()+componentMapInPlace :: PixelComponent s => (s -> s) -> IOBitmap s -> IO () componentMapInPlace f bm = do   genericComponentMap f bm bm     @@ -480,41 +562,103 @@ componentMap'    :: (PixelComponent s, PixelComponent t)    => (s -> t) -  -> Bitmap s           -- ^ source bitmap+  -> IOBitmap s           -- ^ source bitmap   -> Maybe Alignment    -- ^ row alignment of the resulting bitmap-  -> IO (Bitmap t)+  -> IO (IOBitmap t) componentMap' f bm1 malign = do   let siz  = bitmapSize bm1       nchn = bitmapNChannels bm1       x = bitmapPaddedRowSizeInBytes bm1 -  bm2 <- newBitmapUninitialized siz nchn malign +  bm2 <- newIOBitmapUninitialized siz nchn malign    genericComponentMap f bm1 bm2    return bm2    -------------------------------------------------------------------------------- +-- | Clones a bitmap.+cloneBitmap +  :: PixelComponent t +  => IOBitmap t         -- ^ source image+  -> Maybe Alignment    -- ^ target alignment+  -> IO (IOBitmap t)+cloneBitmap bm1 malign = do+  let siz1@(w1,h1) = bitmapSize bm1+      pad1    = bitmapRowPadding bm1+      nchn1   = bitmapNChannels  bm1+      fptr1   = bitmapPtr        bm1+      xlen1   = bitmapPaddedRowSizeInBytes bm1++  bm2 <- newIOBitmapUninitialized siz1 nchn1 malign++  let fptr2   = bitmapPtr                  bm2+      xlen2   = bitmapPaddedRowSizeInBytes bm2+      +  let len1 = bitmapUnpaddedRowSizeInBytes bm1+      len2 = bitmapUnpaddedRowSizeInBytes bm2++  withForeignPtr fptr1 $ \ptr1 -> +    withForeignPtr fptr2 $ \ptr2 ->     +      forM_ [0..h1-1] $ \i -> do+        let p = plusPtr ptr1 (i*xlen1)+            q = plusPtr ptr2 (i*xlen2)+        c_memcpy p q len1+        +  return bm2++-- | Creates an empty bitmap with the same properties as the source.+emptyCloneBitmap+  :: PixelComponent t +  => IOBitmap t         -- ^ source (only dimensions and such is used)+  -> Maybe Alignment    -- ^ target alignment+  -> IO (IOBitmap t)    -- ^ new empty bitmap+emptyCloneBitmap bm1 malign = do++  let siz1  = bitmapSize bm1+      nchn1 = bitmapNChannels  bm1++  bm2 <- newIOBitmapUninitialized siz1 nchn1 malign++  let fptr2 = bitmapPtr         bm2+      n     = bitmapSizeInBytes bm2+  withForeignPtr fptr2 $ \ptr2 -> do+    c_memset (castPtr ptr2 :: Ptr Word8) n 0+    +  return bm2  ++-- | Synonym for 'newIOBitmap'+emptyBitmap +  :: PixelComponent t +  => Size             -- ^ (width,height)+  -> NChn             -- ^ number of channels (components\/pixel)+  -> Maybe Alignment  -- ^ the row alignment of the new image+  -> IO (IOBitmap t)+emptyBitmap = newIOBitmap+    +--------------------------------------------------------------------------------++ -- | Copies a subrectangle of the source image into a new image.   copySubImage   :: PixelComponent t -  => Bitmap t         -- ^ source image+  => IOBitmap t       -- ^ source image   -> Offset           -- ^ source rectangle offset   -> Size             -- ^ source rectangle size-  -> IO (Bitmap t)-copySubImage bm ofs1 siz1 = copySubImage' bm ofs1 siz1 (0,0) siz1  +  -> IO (IOBitmap t)+copySubImage bm ofs1 siz1 = copySubImage' bm ofs1 siz1 siz1 (0,0)     -- | Copy into a new \"black\" bitmap; common generalization of crop and extend. copySubImage'   :: PixelComponent t -  => Bitmap t         -- ^ source image+  => IOBitmap t       -- ^ source image   -> Offset           -- ^ source rectangle offset   -> Size             -- ^ source rectangle size   -> Size             -- ^ target image size   -> Offset           -- ^ target rectangle offset-  -> IO (Bitmap t)+  -> IO (IOBitmap t) copySubImage' bm1 ofs1 rsiz tsiz ofs2 = do   let align   = bitmapRowAlignment  bm1       nchn    = bitmapNChannels  bm1-  bm2 <- newBitmap tsiz nchn (Just align)+  bm2 <- newIOBitmap tsiz nchn (Just align)   copySubImageInto bm1 ofs1 rsiz bm2 ofs2   return bm2 @@ -523,10 +667,10 @@ -- with the image.   copySubImageInto    :: PixelComponent t -  => Bitmap t         -- ^ source image+  => IOBitmap t       -- ^ source image   -> Offset           -- ^ source rectangle offset   -> Size             -- ^ source rectangle size-  -> Bitmap t         -- ^ target image+  -> IOBitmap t       -- ^ target image   -> Offset           -- ^ target rectangle offset   -> IO ()   @@ -575,28 +719,182 @@  -------------------------------------------------------------------------------- +-- | Convert a bitmap to one with a different component type.+castBitmap +  :: (PixelComponent s, PixelComponent t)+  => IOBitmap s             -- ^ source image+  -> Maybe Alignment        -- ^ target image row alignment+  -> IO (IOBitmap t) +castBitmap bm1 malign = do+  +  let nchn1 = bitmapNChannels bm1+      siz1@(w,h) = bitmapSize bm1+      pad1  = bitmapRowPadding bm1+      fptr1 = bitmapPtr bm1++  bm2 <- newIOBitmapUninitialized siz1 nchn1 malign++  let pad2  = bitmapRowPadding bm2+      fptr2 = bitmapPtr bm2++  withForeignPtr fptr1 $ \ptr1 -> +    withForeignPtr fptr2 $ \ptr2 ->     +      c_cast_bitmap +        (bitmapCType bm1)  (bitmapCType bm2)+        (ci w) (ci h)+        ptr1 (ci nchn1) (ci pad1) 0 -- (ci ofs1)+        ptr2 (ci nchn1) (ci pad2) 0 -- (ci ofs2)++  return bm2+          +--------------------------------------------------------------------------------++_flipBitmapInto +  :: PixelComponent t +  => IOBitmap t             -- ^ source image+  -> IOBitmap t             -- ^ target image +  -> IO () +_flipBitmapInto bm1 bm2 = do++  let siz1@(w1,h1) = bitmapSize bm1+      pad1    = bitmapRowPadding bm1+      nchn1   = bitmapNChannels  bm1+      fptr1   = bitmapPtr        bm1+      xlen1   = bitmapPaddedRowSizeInBytes bm1++  let siz2@(w2,h2) = bitmapSize bm2+      pad2    = bitmapRowPadding bm2+      nchn2   = bitmapNChannels  bm2+      fptr2   = bitmapPtr        bm2+      xlen2   = bitmapPaddedRowSizeInBytes bm2+      +  let len1 = bitmapUnpaddedRowSizeInBytes bm1+      len2 = bitmapUnpaddedRowSizeInBytes bm2++  when ( siz1 /= siz2 || nchn1 /= nchn2 || len1 /= len2 ) $ error "_flipBitmapInto" ++  withForeignPtr fptr1 $ \ptr1 -> +    withForeignPtr fptr2 $ \ptr2 ->     +    +      if ptr1 == ptr2+        then do +          allocaBytes len1 $ \tmp -> do+            forM_ [0..(div h1 2)-1] $ \i -> do+              let j = h1-1-i+                  p1 = plusPtr ptr1 (i*xlen1)+                  q1 = plusPtr ptr1 (j*xlen1)                +                  p2 = plusPtr ptr2 (i*xlen2)+                  q2 = plusPtr ptr2 (j*xlen2)+              -- we have to be careful, since the two bitmaps coincide.+              -- that's why the extra copy+              c_memcpy p1  tmp len1+              c_memcpy q1  p2  len1+              c_memcpy tmp q2  len1    +        else do+          forM_ [0..h1-1] $ \i -> do+            let j = h1-1-i+                p = plusPtr ptr1 (i*xlen1)+                q = plusPtr ptr2 (j*xlen2)+            c_memcpy p q len1+              +-- | Flips the bitmap vertically.+flipBitmap +  :: PixelComponent t +  => IOBitmap t             -- ^ source image+  -> Maybe Alignment        -- ^ target image row alignment+  -> IO (IOBitmap t) +flipBitmap bm1 malign = do+  let nchn = bitmapNChannels bm1+      siz@(w,h) = bitmapSize bm1+  bm2 <- newIOBitmapUninitialized siz nchn malign +  _flipBitmapInto bm1 bm2+  return bm2+  +flipBitmapInPlace+  :: PixelComponent t +  => IOBitmap t             -- ^ source image+  -> IO () +flipBitmapInPlace bm = do+  _flipBitmapInto bm bm++--------------------------------------------------------------------------------++_mirrorBitmapInto +  :: PixelComponent t +  => IOBitmap t             -- ^ source image+  -> IOBitmap t             -- ^ target image +  -> IO () +_mirrorBitmapInto bm1 bm2 = do++  let siz1@(w1,h1) = bitmapSize bm1+      pad1    = bitmapRowPadding bm1+      nchn1   = bitmapNChannels  bm1+      fptr1   = bitmapPtr        bm1+      xlen1   = bitmapPaddedRowSizeInBytes bm1++  let siz2@(w2,h2) = bitmapSize bm2+      pad2    = bitmapRowPadding bm2+      nchn2   = bitmapNChannels  bm2+      fptr2   = bitmapPtr        bm2+      xlen2   = bitmapPaddedRowSizeInBytes bm2+      +  let len1 = bitmapUnpaddedRowSizeInBytes bm1+      len2 = bitmapUnpaddedRowSizeInBytes bm2+      bpp1 = bitmapPixelSizeInBytes bm1+      bpp2 = bitmapPixelSizeInBytes bm2++  when ( siz1 /= siz2 || nchn1 /= nchn2 || len1 /= len2 || bpp1 /= bpp2 ) $ error "_mirrorBitmapInto" ++  withForeignPtr fptr1 $ \ptr1 -> +    withForeignPtr fptr2 $ \ptr2 ->     +      forM_ [0..h1-1] $ \i -> do+        let p = plusPtr ptr1 (i*xlen1)+            q = plusPtr ptr2 (i*xlen2)+        c_mirror_line (ci w1) (ci bpp1) p q+              +-- | Flips the bitmap horizontally.+mirrorBitmap +  :: PixelComponent t +  => IOBitmap t             -- ^ source image+  -> Maybe Alignment        -- ^ target image row alignment+  -> IO (IOBitmap t) +mirrorBitmap bm1 malign = do+  let nchn = bitmapNChannels bm1+      siz@(w,h) = bitmapSize bm1+  bm2 <- newIOBitmapUninitialized siz nchn malign +  _mirrorBitmapInto bm1 bm2+  return bm2+  +mirrorBitmapInPlace+  :: PixelComponent t +  => IOBitmap t             -- ^ source image+  -> IO () +mirrorBitmapInPlace bm = do+  _mirrorBitmapInto bm bm+  +--------------------------------------------------------------------------------+ extractSingleChannel    :: PixelComponent t -  => Bitmap t               -- ^ source image+  => IOBitmap t             -- ^ source image   -> Maybe Alignment        -- ^ target image row alignment   -> Int                    -- ^ source channel index-  -> IO (Bitmap t) +  -> IO (IOBitmap t)  extractSingleChannel bm1 malign j = do   let nchn = bitmapNChannels bm1       siz@(w,h) = bitmapSize bm1   when (j<0 || j>=nchn) $ error "bitmap/extractSingleChannel: invalid channel index"-  bm2 <- newBitmapUninitialized siz 1 malign+  bm2 <- newIOBitmapUninitialized siz 1 malign   extractChannelInto bm1 j bm2 0   return bm2   -    -extractChannels :: PixelComponent t => Bitmap t -> Maybe Alignment -> IO [Bitmap t]+extractChannels :: PixelComponent t => IOBitmap t -> Maybe Alignment -> IO [IOBitmap t] extractChannels bm malign =    mapM (extractSingleChannel bm malign) [0..nchn-1]      where nchn = bitmapNChannels bm  -combineChannels :: forall t. PixelComponent t => [Bitmap t] -> Maybe Alignment -> IO (Bitmap t)+combineChannels :: PixelComponent t => [IOBitmap t] -> Maybe Alignment -> IO (IOBitmap t) combineChannels [] _ = error "bitmap/combineChannels: no channel data" combineChannels bms malign = do   let sizes = map bitmapSize bms@@ -607,7 +905,7 @@          when (length (nub sizes) /= 1) $ error "bitmap/combineChannels: incompatible sizes" -  bm2 <- newBitmapUninitialized siz sumchn malign+  bm2 <- newIOBitmapUninitialized siz sumchn malign   let pad2 = bitmapRowPadding bm2       fptr2 = bitmapPtr bm2 @@ -620,7 +918,7 @@           nchn1 = bitmapNChannels bm1           withForeignPtr fptr1 $ \ptr1 ->          c_extract_channel -          (c_type (undefined::t))+          (bitmapCType (head bms))           (ci w) (ci h)           ptr1 (ci nchn1)  (ci pad1) (ci j)           ptr2 (ci sumchn) (ci pad2) (ci i)@@ -628,10 +926,10 @@   return bm2  extractChannelInto -  :: forall t. PixelComponent t -  => Bitmap t     -- ^ source image+  :: PixelComponent t +  => IOBitmap t   -- ^ source image   -> Int          -- ^ source channel index -  -> Bitmap t     -- ^ target image+  -> IOBitmap t   -- ^ target image   -> Int          -- ^ target channel index   -> IO () extractChannelInto bm1 ofs1 bm2 ofs2 = do@@ -653,7 +951,7 @@   withForeignPtr fptr1 $ \ptr1 ->      withForeignPtr fptr2 $ \ptr2 ->            c_extract_channel -        (c_type (undefined::t))+        (bitmapCType bm1)         (ci w) (ci h)         ptr1 (ci nchn1) (ci pad1) (ci ofs1)         ptr2 (ci nchn2) (ci pad2) (ci ofs2)@@ -662,13 +960,13 @@  bilinearResample   :: PixelComponent t -  => Bitmap t        -- ^ source image+  => IOBitmap t      -- ^ source image   -> Size            -- ^ target image size   -> Maybe Alignment -- ^ target image alignment-  -> IO (Bitmap t)   +  -> IO (IOBitmap t)    bilinearResample bm1 siz2@(w2,h2) malign = do   let nchn1 = bitmapNChannels bm1-  bm2 <- newBitmapUninitialized siz2 nchn1 malign+  bm2 <- newIOBitmapUninitialized siz2 nchn1 malign   forM_ [0..nchn1-1] $ \ofs ->     bilinearResampleChannelInto bm1 ofs bm2 ofs   return bm2@@ -676,24 +974,24 @@  bilinearResampleChannel   :: PixelComponent t -  => Bitmap t        -- ^ source image+  => IOBitmap t      -- ^ source image   -> Int             -- ^ source channel index    -> Size            -- ^ target image size   -> Maybe Alignment -- ^ target image alignment-  -> IO (Bitmap t)   +  -> IO (IOBitmap t)    bilinearResampleChannel bm1 ofs1 siz2@(w2,h2) malign = do   let nchn1 = bitmapNChannels bm1   when (ofs1<0 || ofs1>=nchn1) $ error "bitmap/bilinearResampleChannel: invalid channel index"-  bm2 <- newBitmapUninitialized siz2 1 malign+  bm2 <- newIOBitmapUninitialized siz2 1 malign   bilinearResampleChannelInto bm1 ofs1 bm2 0   return bm2   bilinearResampleChannelInto -  :: forall t. PixelComponent t -  => Bitmap t     -- ^ source image+  :: PixelComponent t +  => IOBitmap t   -- ^ source image   -> Int          -- ^ source channel index -  -> Bitmap t     -- ^ target image+  -> IOBitmap t   -- ^ target image   -> Int          -- ^ target channel index   -> IO () bilinearResampleChannelInto bm1 ofs1 bm2 ofs2 = do@@ -714,7 +1012,7 @@   withForeignPtr fptr1 $ \ptr1 ->      withForeignPtr fptr2 $ \ptr2 ->            c_bilinear_resample_channel -        (c_type (undefined::t))+        (c_type (bitmapUndefined bm1))         (ci w1) (ci h1) ptr1 (ci nchn1) (ci pad1) (ci ofs1)         (ci w2) (ci h2) ptr2 (ci nchn2) (ci pad2) (ci ofs2) @@ -723,23 +1021,23 @@ -- | This is equivalent to @componentMap (\c -> c^gamma)@, except that -- @(^)@ is defined only for integral exponents; but should be faster anyway. powerlawGammaCorrection -  :: forall t. PixelComponent t +  :: PixelComponent t    => Float             -- ^ gamma-  -> Bitmap t          -- ^ source bitmap+  -> IOBitmap t        -- ^ source bitmap   -> Maybe Alignment   -- ^ target alignment-  -> IO (Bitmap t)+  -> IO (IOBitmap t) powerlawGammaCorrection gamma bm1 malign = do   let nchn1 = bitmapNChannels bm1       siz1@(w1,h1) = bitmapSize bm1       pad1 = bitmapRowPadding bm1       fptr1 = bitmapPtr bm1-  bm2 <- newBitmapUninitialized siz1 nchn1 malign+  bm2 <- newIOBitmapUninitialized siz1 nchn1 malign   let pad2 = bitmapRowPadding bm2       fptr2 = bitmapPtr bm2   withForeignPtr fptr1 $ \ptr1 ->      withForeignPtr fptr2 $ \ptr2 ->            c_gamma_correct_all_channels -        (c_type (undefined::t))+        (c_type (bitmapUndefined bm1))         (realToFrac gamma)          (ci w1) (ci h1) (ci nchn1)          ptr1 (ci pad1) @@ -750,24 +1048,25 @@ powerlawGammaCorrectionChannel   :: PixelComponent t    => Float           -- ^ gamma-  -> Bitmap t        -- ^ source image+  -> IOBitmap t      -- ^ source image   -> Int             -- ^ source channel index    -> Maybe Alignment -- ^ target image alignment-  -> IO (Bitmap t)   +  -> IO (IOBitmap t)    powerlawGammaCorrectionChannel gamma bm1 ofs1 malign = do   let nchn1 = bitmapNChannels bm1       siz1  = bitmapSize bm1   when (ofs1<0 || ofs1>=nchn1) $ error "bitmap/powerlawGammaCorrectionChannel: invalid channel index"-  bm2 <- newBitmapUninitialized siz1 1 malign+  bm2 <- newIOBitmapUninitialized siz1 1 malign   powerlawGammaCorrectionChannelInto gamma bm1 ofs1 bm2 0   return bm2   +   powerlawGammaCorrectionChannelInto-  :: forall t. PixelComponent t +  :: PixelComponent t    => Float        -- ^ gamma-  -> Bitmap t     -- ^ source image+  -> IOBitmap t   -- ^ source image   -> Int          -- ^ source channel index -  -> Bitmap t     -- ^ target image+  -> IOBitmap t   -- ^ target image   -> Int          -- ^ target channel index   -> IO () powerlawGammaCorrectionChannelInto gamma bm1 ofs1 bm2 ofs2 = do@@ -789,7 +1088,7 @@   withForeignPtr fptr1 $ \ptr1 ->      withForeignPtr fptr2 $ \ptr2 ->            c_gamma_correct_channel -        (c_type (undefined::t))+        (c_type (bitmapUndefined bm1))         (realToFrac gamma)          (ci w1) (ci h1)          ptr1 (ci nchn1) (ci pad1) (ci ofs1)@@ -806,10 +1105,10 @@   :: PixelComponent t    => Float           -- ^ weight1   -> Float           -- ^ weight2-  -> Bitmap t        -- ^ source1 image -  -> Bitmap t        -- ^ source2 image +  -> IOBitmap t      -- ^ source1 image +  -> IOBitmap t      -- ^ source2 image    -> Maybe Alignment -- ^ target alignment-  -> IO (Bitmap t)+  -> IO (IOBitmap t) -- this could be implemented more effectively by a specialized c routine blendBitmaps weight1 weight2 bm1 bm2 malign = do    let nchn1 = bitmapNChannels bm1@@ -818,7 +1117,7 @@       siz2  = bitmapSize bm2   when (siz1  /= siz2 ) $ error "bitmap/blend: incompatible dimensions"       when (nchn1 /= nchn2) $ error "bitmap/blend: incompatible number of channels"-  bm3 <- newBitmapUninitialized siz1 nchn1 malign+  bm3 <- newIOBitmapUninitialized siz1 nchn1 malign   forM [0..nchn1-1] $ \ofs ->      blendChannelsInto weight1 weight2 bm1 ofs bm2 ofs bm3 ofs   return bm3  @@ -827,12 +1126,12 @@   :: PixelComponent t    => Float        -- ^ weight1   -> Float        -- ^ weight2-  -> Bitmap t     -- ^ source1 image +  -> IOBitmap t   -- ^ source1 image    -> Int          -- ^ source1 channel index  -  -> Bitmap t     -- ^ source2 image +  -> IOBitmap t   -- ^ source2 image    -> Int          -- ^ source2 channel index     -> Maybe Alignment -- ^ target alignment-  -> IO (Bitmap t)+  -> IO (IOBitmap t) blendChannels weight1 weight2 bm1 ofs1 bm2 ofs2 malign = do   let nchn1 = bitmapNChannels bm1       siz1  = bitmapSize bm1@@ -841,19 +1140,19 @@   when (siz1 /= siz2)          $ error "bitmap/blendChannels: incompatible dimensions"       when (ofs1<0 || ofs1>=nchn1) $ error "bitmap/blendChannels: invalid channel index"   when (ofs2<0 || ofs2>=nchn2) $ error "bitmap/blendChannels: invalid channel index"-  bm3 <- newBitmapUninitialized siz1 1 malign+  bm3 <- newIOBitmapUninitialized siz1 1 malign   blendChannelsInto weight1 weight2 bm1 ofs1 bm2 ofs2 bm3 0   return bm3      blendChannelsInto-  :: forall t. PixelComponent t +  :: PixelComponent t    => Float        -- ^ weight1   -> Float        -- ^ weight2-  -> Bitmap t     -- ^ source1 image +  -> IOBitmap t   -- ^ source1 image    -> Int          -- ^ source1 channel index  -  -> Bitmap t     -- ^ source2 image +  -> IOBitmap t   -- ^ source2 image    -> Int          -- ^ source2 channel index  -  -> Bitmap t     -- ^ target image+  -> IOBitmap t   -- ^ target image   -> Int          -- ^ target channel index   -> IO () blendChannelsInto weight1 weight2 bm1 ofs1 bm2 ofs2 bm3 ofs3 = do@@ -883,7 +1182,7 @@     withForeignPtr fptr2 $ \ptr2 ->            withForeignPtr fptr3 $ \ptr3 ->              c_linear_combine_channels -          (c_type (undefined::t))+          (bitmapCType bm1)           (realToFrac weight1) (realToFrac weight2)            (ci w1) (ci h1)            ptr1 (ci nchn1) (ci pad1) (ci ofs1)@@ -892,6 +1191,8 @@          -------------------------------------------------------------------------------- +{- + -- | 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!@@ -907,7 +1208,7 @@ -- | The data is copied, not shared. -- Note that we expect the ByteString to be encoded -- encoded using the host machine's endianness.-copyBitmapFromByteString :: forall t. PixelComponent t => ByteString -> Size -> NChn -> Padding -> IO (Bitmap t)+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 @@ -916,7 +1217,7 @@         , bitmapPtr = undefined          , bitmapRowPadding = pad         , bitmapRowAlignment = 1-        } :: Bitmap t+        } -- :: Bitmap t       n = bitmapSizeInBytes bm   if n > len-ofs     then error "copyBitmapFromByteString: ByteString is too short"@@ -927,14 +1228,21 @@         withForeignPtr newfptr $ \tgt ->           c_memcpy src tgt n       return $ bm { bitmapPtr = castForeignPtr newfptr } ++-}    -------------------------------------------------------------------------------- +ptrUndefined :: Ptr a -> a+ptrUndefined _ = undefined+ -- no multiplication {-# SPECIALIZE advancePtr1 :: Ptr Word8 -> Ptr Word8 #-} {-# SPECIALIZE advancePtr1 :: Ptr Float -> Ptr Float #-}-advancePtr1 :: forall a. Storable a => Ptr a -> Ptr a-advancePtr1 p = p `plusPtr` (sizeOf (undefined::a))+--advancePtr1 :: forall a. Storable a => Ptr a -> Ptr a+--advancePtr1 p = p `plusPtr` (sizeOf (undefined::a))+advancePtr1 :: Storable a => Ptr a -> Ptr a+advancePtr1 p = p `plusPtr` (sizeOf (ptrUndefined p))  -- restricted type {-# SPECIALIZE myPlusPtr :: Ptr Word8 -> Int -> Ptr Word8 #-}@@ -954,6 +1262,43 @@ -- 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 ()  -------------------- 

@@ -0,0 +1,166 @@++--------------------------------------------------------------------------------+-- Module      : Data.Bitmap.IO.File+-- 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+--------------------------------------------------------------------------------++-- | Saving and loading uncompressed bitmaps.+-- For loading from compressed formats, see the @stb-image@ library:+-- <http://hackage.haskell.org/package/stb-image>.+--+-- The goal of this module is to provide the simplest possible interface +-- for loading and saving bitmaps; so you can start experimenting+-- without much hassle.+-- +-- Note: Endianness is the endianness of the host, so the resulting file is +-- not portable across platforms with different endiannesses.+-- +{-# LANGUAGE CPP, ForeignFunctionInterface #-}+module Data.Bitmap.IO.File+  ( readBitmap+  , writeBitmap+    --+  , readRawData+  , writeRawData+    --+  , hPutHeader+  , hPutRawData+  , hGetHeader+  , hGetRawData+  ) +  where++--------------------------------------------------------------------------------++import Control.Monad+import System.IO++--import Foreign     -- GHC 7 complains?+import Foreign.C+import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.Storable+import Foreign.Marshal++import Data.Int++import Data.Bitmap.Base+import Data.Bitmap.Internal+import Data.Bitmap.IO++--------------------------------------------------------------------------------++readBitmap :: PixelComponent t => FilePath -> IO (IOBitmap t)+readBitmap fpath = do+  h <- openFile fpath ReadMode+  header <- hGetHeader h+  bitmap <- hGetRawData h header+  hClose h+  return bitmap+  +readRawData :: PixelComponent t => FilePath -> (Size,NChn,PixelComponentType) -> IO (IOBitmap t) +readRawData fpath header = do +  h <- openFile fpath ReadMode+  bitmap <- hGetRawData h header+  hClose h+  return bitmap++--------------------------------------------------------------------------------++writeBitmap :: PixelComponent t => FilePath -> IOBitmap t -> IO ()+writeBitmap fpath bm = do+  h <- openFile fpath WriteMode+  hPutHeader  h bm+  hPutRawData h bm+  hClose h++-- | Saves only the raw pixel data, no resolution etc.+writeRawData :: PixelComponent t => FilePath -> IOBitmap t -> IO ()+writeRawData fpath bm = do+  h <- openFile fpath WriteMode+  hPutRawData h bm+  hClose h++--------------------------------------------------------------------------------++-- | Writes a 16 byte header in the following format:+-- +-- > dword xsize+-- > dword ysize+-- > dword nchn+-- > dword pixelcomponent_type+--+-- Pixel component encoding is the following:+-- +-- * 1 = Word8+--+-- * 2 = Word16+--+-- * 3 = Word32+--+-- * 4 = Float+--+-- Endianness is the endianness of the host, so the resulting file is +-- not portable across platform with different endiannesses.+hPutHeader :: PixelComponent t => Handle -> IOBitmap t -> IO ()+hPutHeader h bm = do+  let (xsize,ysize) = bitmapSize bm+      nchn = bitmapNChannels bm+      typ  = bitmapCType bm+  with (fromIntegral xsize :: Int32) $ \p -> hPutBuf h p 4 +  with (fromIntegral ysize :: Int32) $ \p -> hPutBuf h p 4 +  with (fromIntegral nchn  :: Int32) $ \p -> hPutBuf h p 4 +  with (fromIntegral typ   :: Int32) $ \p -> hPutBuf h p 4 +  +-- | Saves only the raw pixel data, no resolution etc.+hPutRawData :: PixelComponent t => Handle -> IOBitmap t -> IO ()+hPutRawData h bm = +  withIOBitmap bm $ \(xres,yres) nchn padding ptr -> do+    forM_ [0..yres-1] $ \k -> do+      let q = ptr `plusPtr` (k*long)+      hPutBuf h q short    +  where+    long  = bitmapPaddedRowSizeInBytes   bm+    short = bitmapUnpaddedRowSizeInBytes bm+    +--------------------------------------------------------------------------------+    +hGetRawData :: PixelComponent t => Handle -> (Size,NChn,PixelComponentType) -> IO (IOBitmap t)+hGetRawData h (siz,nchn,pct) = do+  bm <- newIOBitmapUninitialized siz nchn (Just 1)+  if bitmapComponentType bm /= pct+    then error "bitmap/getRawData: bitmap component type does not match"+    else do+      withIOBitmap bm $ \(_,ysiz) _ _ ptr -> do+        let n = ysiz * bitmapUnpaddedRowSizeInBytes bm+        k <- hGetBuf h ptr n+        when (k/=n) $ error "bitmap/getRawData: not enough data"+        return bm +    +hGetHeader :: Handle -> IO (Size,NChn,PixelComponentType)+hGetHeader h = do+  xsize <- loadInt32+  ysize <- loadInt32+  nchn  <- loadInt32+  ctyp  <- loadInt32+  return +    ( (fromIntegral xsize, fromIntegral ysize)+    , fromIntegral nchn+    , decodeCType (fromIntegral ctyp)+    )+  where+    loadInt32 :: IO Int32+    loadInt32 = alloca $ \p -> do+      hGetBuf h p 4+      peek p+    +--------------------------------------------------------------------------------++    

@@ -0,0 +1,202 @@++--------------------------------------------------------------------------------+-- Module      : Data.Bitmap.IO.Pixels+-- Version     : 0.0.2+-- License     : BSD3+-- Copyright   : (c) 2009-2010 Balazs Komuves+-- Author      : Balazs Komuves+-- Maintainer  : bkomuves (plus) hackage (at) gmail (dot) com+-- Stability   : experimental+-- Portability : requires FFI and CPP+-- Tested with : GHC 6.10.1+--------------------------------------------------------------------------------++-- | Accessing individual pixels.++{-# LANGUAGE CPP, ForeignFunctionInterface #-}+module Data.Bitmap.IO.Pixels+  ( +    -- * Types+    IOBitmap1 -- (..)+  , IOBitmap2 -- (..)+  , IOBitmap3 -- (..)+  , IOBitmap4 -- (..)+    --+  , ioBitmap1+  , ioBitmap2+  , ioBitmap3+  , ioBitmap4+    --+  , fromIOBitmap1+  , fromIOBitmap2+  , fromIOBitmap3+  , fromIOBitmap4+    -- * Reading and writing pixels+  , withComponentPtr+   --+  , unsafeReadComponent+  , unsafeWriteComponent+  , unsafeReadComponents+  , unsafeWriteComponents+    --+  , unsafeReadPixel+  , unsafeReadPixel1+  , unsafeReadPixel2+  , unsafeReadPixel3+  , unsafeReadPixel4+  , unsafeWritePixel1+  , unsafeWritePixel2+  , unsafeWritePixel3+  , unsafeWritePixel4+  ) +  where+  +--------------------------------------------------------------------------------++import Control.Monad+import Control.Applicative++import Data.Word++--import Foreign    -- GHC 7 complains?+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+import Data.Bitmap.IO++--------------------------------------------------------------------------------++-- | 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]++--------------------------------------------------------------------------------++-- restricted type+{-# SPECIALIZE myPlusPtr :: Ptr Word8 -> Int -> Ptr Word8 #-}+{-# SPECIALIZE myPlusPtr :: Ptr Float -> Int -> Ptr Float #-}+myPlusPtr :: Ptr a -> Int -> Ptr a+myPlusPtr = plusPtr++--------------------------------------------------------------------------------

@@ -1,17 +1,17 @@  -------------------------------------------------------------------------------- -- Module      : Data.Bitmap.Internal--- Version     : 0.0.1+-- Version     : 0.0.2 -- License     : BSD3--- Copyright   : (c) 2009 Balazs Komuves+-- Copyright   : (c) 2009-2010 Balazs Komuves -- Author      : Balazs Komuves -- Maintainer  : bkomuves (plus) hackage (at) gmail (dot) com -- Stability   : experimental--- Portability : requires FFI, CPP and ScopedTypeVariables+-- Portability : requires FFI and CPP -- Tested with : GHC 6.10.1 -------------------------------------------------------------------------------- -{-# LANGUAGE CPP, ForeignFunctionInterface, ScopedTypeVariables #-}+{-# LANGUAGE CPP #-} module Data.Bitmap.Internal where  --------------------------------------------------------------------------------@@ -31,7 +31,7 @@   | PctWord16   | PctWord32    | PctFloat-  deriving Show+  deriving (Show,Eq)    pixelComponentSize :: PixelComponentType -> Int pixelComponentSize pct = case pct of@@ -39,7 +39,14 @@   PctWord16 -> 2    PctWord32 -> 4    PctFloat  -> 4 -  ++prettyPrintPixelComponentType :: PixelComponentType -> String+prettyPrintPixelComponentType t = case t of+  PctWord8  -> "Word8"+  PctWord16 -> "Word16"+  PctWord32 -> "Word32"+  PctFloat  -> "Float"+ --------------------------------------------------------------------------------  class (Num t, Storable t) => PixelComponent t where@@ -50,7 +57,10 @@   fromFloat :: Float -> t    pixelComponentType :: PixelComponent t => t -> PixelComponentType-pixelComponentType t = case c_type t of+pixelComponentType t = decodeCType (c_type t)+  +decodeCType :: CInt -> PixelComponentType +decodeCType k = case k of   1 -> PctWord8   2 -> PctWord16   3 -> PctWord32@@ -88,12 +98,67 @@  -------------------------------------------------------------------------------- -{-# SPECIALIZE isValidAlignment :: Int -> Bool #-}-isValidAlignment :: Integral a => a -> Bool-isValidAlignment a = elem a [1,2,4,8,16]+-- this is for portability, to avoid ScopedTypeVariables ---------------------------------------------------------------------------------+bitmapUndefined :: BitmapClass bitmap => bitmap t -> t+bitmapUndefined _ = undefined  ++bitmapCType :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> CInt+bitmapCType = c_type . bitmapUndefined   +--------------------------------------------------------------------------------++{-+-- | Newtypes for bitmaps with a fixed number of channels (components per pixel) +newtype Bitmap1 t = Bitmap1 { fromBitmap1 :: Bitmap t } +newtype Bitmap2 t = Bitmap2 { fromBitmap2 :: Bitmap t }+newtype Bitmap3 t = Bitmap3 { fromBitmap3 :: Bitmap t }+newtype Bitmap4 t = Bitmap4 { fromBitmap4 :: Bitmap t } ++bitmap1 :: Bitmap t -> Bitmap1 t+bitmap2 :: Bitmap t -> Bitmap2 t+bitmap3 :: Bitmap t -> Bitmap3 t+bitmap4 :: Bitmap t -> Bitmap4 t++bitmap1 bm = if bitmapNChannels bm == 1 then Bitmap1 bm else error "bitmap/bitmap1: number of channels is not 1"+bitmap2 bm = if bitmapNChannels bm == 2 then Bitmap2 bm else error "bitmap/bitmap2: number of channels is not 2"+bitmap3 bm = if bitmapNChannels bm == 3 then Bitmap3 bm else error "bitmap/bitmap3: number of channels is not 3"+bitmap4 bm = if bitmapNChannels bm == 4 then Bitmap4 bm else error "bitmap/bitmap4: number of channels is not 4"+-}++--------------------------------------------------------------------------------++-- | A class so that using newtypes is convenient.+class BitmapClass b where+  underlyingBitmap :: b t -> Bitmap t    -- ?? better name ??++instance BitmapClass Bitmap where+  underlyingBitmap = id++{-+instance BitmapClass Bitmap1 where+  underlyingBitmap = fromBitmap1++instance BitmapClass Bitmap2 where+  underlyingBitmap = fromBitmap2++instance BitmapClass Bitmap3 where+  underlyingBitmap = fromBitmap3++instance BitmapClass Bitmap4 where+  underlyingBitmap = fromBitmap4+-}++--------------------------------------------------------------------------------++-- A fixed channel of a bitmap+data BitmapChannel t = BmChn (Bitmap t) Int++data IOBitmapChannel t = IOBmChn (IOBitmap t) Int+data STBitmapChannel t = STBmChn (STBitmap t) Int++--------------------------------------------------------------------------------+ -- to provide better documentation type Size   = (Int,Int) type Offset = (Int,Int)@@ -101,50 +166,137 @@ type Padding   = Int type Alignment = Int +-- | A bitmap. data Bitmap t = Bitmap-  { bitmapSize      :: Size          -- ^ (width,height)-  , bitmapNChannels :: NChn          -- ^ number of channels (eg. 3 for RGB)-  , bitmapPtr  :: ForeignPtr t       -- ^ pointer to the data-  , bitmapRowPadding   :: Padding    -- ^ the padding of the rows, measured in /bytes/-  , bitmapRowAlignment :: Alignment  -- ^ the alignment of the rows (in bytes)+  { _bitmapSize      :: Size          -- ^ (width,height)+  , _bitmapNChannels :: NChn          -- ^ number of channels (eg. 3 for RGB)+  , _bitmapPtr  :: ForeignPtr t       -- ^ pointer to the data+  , _bitmapRowPadding   :: Padding    -- ^ the padding of the rows, measured in /bytes/+  , _bitmapRowAlignment :: Alignment  -- ^ the alignment of the rows (in bytes)   }-  deriving Show+--  deriving Show -bitmapComponentSizeInBytes :: forall t. PixelComponent t => Bitmap t -> Int-bitmapComponentSizeInBytes _ = sizeOf (undefined::t) +-------------------------------------------------------------------------------- -bitmapPixelSizeInBytes :: PixelComponent t => Bitmap t -> Int+-- | A mutable Bitmap in the IO Monad. Only the content is mutable, the shape isn't.+newtype IOBitmap t = IOBitmap { unIOBitmap :: Bitmap t }+-- | A mutable Bitmap in the ST Monad. Only the content is mutable, the shape isn't.+newtype STBitmap t = STBitmap { unSTBitmap :: Bitmap t }++instance BitmapClass IOBitmap where underlyingBitmap = unIOBitmap+instance BitmapClass STBitmap where underlyingBitmap = unSTBitmap++--------------------------------------------------------------------------------++bitmapSize :: BitmapClass bitmap => bitmap t -> Size+bitmapSize = _bitmapSize . underlyingBitmap  ++bitmapNChannels :: BitmapClass bitmap => bitmap t -> NChn+bitmapNChannels = _bitmapNChannels . underlyingBitmap  ++bitmapPtr :: BitmapClass bitmap => bitmap t -> ForeignPtr t+bitmapPtr = _bitmapPtr . underlyingBitmap  ++bitmapRowPadding :: BitmapClass bitmap => bitmap t -> Padding+bitmapRowPadding = _bitmapRowPadding . underlyingBitmap  ++bitmapRowAlignment :: BitmapClass bitmap => bitmap t -> Alignment+bitmapRowAlignment = _bitmapRowAlignment . underlyingBitmap  ++--------------------------------------------------------------------------------++bitmapComponentType :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> PixelComponentType+bitmapComponentType bm = pixelComponentType (bitmapUndefined bm)++bitmapComponentSizeInBytes :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> Int+bitmapComponentSizeInBytes bm = sizeOf (bitmapUndefined bm) ++bitmapPixelSizeInBytes :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> Int bitmapPixelSizeInBytes bm = bitmapNChannels bm * bitmapComponentSizeInBytes bm   -bitmapUnpaddedRowSizeInBytes :: forall t. PixelComponent t => Bitmap t -> Int  -bitmapUnpaddedRowSizeInBytes bm = w * sizeOf (undefined::t) * nchn where+bitmapUnpaddedRowSizeInBytes :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> Int  +bitmapUnpaddedRowSizeInBytes bm = w * sizeOf (bitmapUndefined bm) * nchn where   (w,h) = bitmapSize bm   nchn  = bitmapNChannels bm      -bitmapPaddedRowSizeInBytes :: PixelComponent t => Bitmap t -> Int  +bitmapPaddedRowSizeInBytes :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> Int   bitmapPaddedRowSizeInBytes bm = bitmapUnpaddedRowSizeInBytes bm + bitmapRowPadding bm    -bitmapSizeInBytes :: PixelComponent t => Bitmap t -> Int +bitmapSizeInBytes :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> Int  bitmapSizeInBytes bm = h*x where   x = bitmapPaddedRowSizeInBytes bm   (_,h) = bitmapSize bm     -- | The width divided by the height.-bitmapAspect :: Fractional a => Bitmap t -> a+bitmapAspect :: (Fractional a, BitmapClass bitmap) => bitmap t -> a bitmapAspect bm = (fromIntegral x / fromIntegral y) where   (x,y) = bitmapSize bm  -------------------------------------------------------------------------------- +prettyPrintBitmap :: (BitmapClass bitmap, PixelComponent t) => String -> bitmap t -> String+prettyPrintBitmap prefix bm = text where+  text = "<" ++ prefix ++ " " ++ typ ++ ", " ++ show xres ++ "x" ++ show yres ++ ", " ++ show nchn ++ " channels>" where+  (xres,yres) = bitmapSize bm+  typ = prettyPrintPixelComponentType (bitmapComponentType bm)+  nchn = bitmapNChannels bm++instance PixelComponent t => Show (Bitmap t) where+  show = prettyPrintBitmap "Bitmap"++--------------------------------------------------------------------------------++-- | @withBitmap bitmap $ \\(w,h) nchn padding ptr -> ...@+withBitmap :: PixelComponent t => Bitmap t -> (Size -> NChn -> Padding -> Ptr t -> IO a) -> IO a+withBitmap bm action = +  withForeignPtr (bitmapPtr bm) $ \p -> +    action (bitmapSize bm) (bitmapNChannels bm) (bitmapRowPadding bm) p++bitmapFromForeignPtrUnsafe +  :: PixelComponent t +  => Size -> NChn -> Alignment -> Padding -> ForeignPtr t -> Bitmap t+bitmapFromForeignPtrUnsafe siz nchn align pad fptr = Bitmap+  { _bitmapSize      = siz +  , _bitmapNChannels = nchn +  , _bitmapPtr       = fptr +  , _bitmapRowPadding   = pad +  , _bitmapRowAlignment = align+  }+    +--------------------------------------------------------------------------------+  +{-# SPECIALIZE isValidAlignment :: Int -> Bool #-}+isValidAlignment :: Integral a => a -> Bool+isValidAlignment a = elem a [1,2,4,8,16]++--------------------------------------------------------------------------------+ -- we mimic the OpenGL padding at the moment-recommendedPadding :: forall t. PixelComponent t => Bitmap t -> Int+recommendedPadding :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> Int recommendedPadding bm = pad where   (w,_) = bitmapSize bm   n = bitmapNChannels bm   b = bitmapRowAlignment bm-  s = sizeOf (undefined::t)+  s = sizeOf (bitmapUndefined bm)   a = if b<s then s else b   k = case divMod a s of (q,r) -> if r==0 then q else error "recommendedPadding: should not happen"   pad = s * ( k * div (n*w + k-1) k - n*w )    +  +{-+-- OpenGL padding algorithm test+recommendedPadding' +  :: Int  -- ^ number of channels+  -> Int  -- ^ size of a component+  -> Int  -- ^ width of the picture+  -> Int  -- ^ target alignment+  -> (Int,Int)+recommendedPadding' n s w b = (pad,pad2) where  +  a = if b<s then s else b+  k = case divMod a s of (q,r) -> if r==0 then q else error "recommendedPadding': should not happen"+  pad = s * ( k * div (n*w + k-1) k - n*w )    ++  kk = a * (div (s*n*w + a-1) a)+  pad2 = kk - w*s*nn+-}    --------------------------------------------------------------------------------

@@ -1,30 +1,43 @@  -------------------------------------------------------------------------------- -- Module      : Data.Bitmap.Pure--- Version     : 0.0.1+-- Version     : 0.0.2 -- License     : BSD3--- Copyright   : (c) 2009 Balazs Komuves+-- Copyright   : (c) 2009-2010 Balazs Komuves -- Author      : Balazs Komuves -- Maintainer  : bkomuves (plus) hackage (at) gmail (dot) com -- Stability   : experimental--- Portability : requires FFI, CPP and ScopedTypeVariables+-- Portability : requires FFI and CPP -- Tested with : GHC 6.10.1 -------------------------------------------------------------------------------- -{-# LANGUAGE CPP, ScopedTypeVariables #-}+-- | The pure, inmutable API.++{-# LANGUAGE CPP #-} module Data.Bitmap.Pure    (      module Data.Bitmap.Base          -- * Creating bitmaps   , emptyBitmap+  , cloneBitmap+  , emptyCloneBitmap   , createSingleChannelBitmap+  , bitmapFromForeignPtrUnsafe+    -- * Using bitmaps+  , withBitmap     -- * Mapping over bitmaps   , componentMap   , componentMap'     -- * Cropping and extending   , copySubImage-  , copySubImage'  +  , copySubImage'+    -- * Flipping and mirroring+  , flipBitmap  +  , mirrorBitmap+    -- * Casting+  , castBitmap+  -- , castChannel     -- * Manipulating channels   , combineChannels    , extractChannels @@ -38,8 +51,10 @@     -- * Gamma correction   , powerlawGammaCorrection   , powerlawGammaCorrectionChannel   +{-       -- * Conversion to ByteString   , bitmapToByteString  +-}     )    where @@ -47,7 +62,7 @@  import Data.Word -import Foreign+-- import Foreign.ForeignPtr  import Data.ByteString (ByteString) import qualified Data.ByteString as B@@ -66,33 +81,55 @@ -- 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. emptyBitmap -  :: forall t. PixelComponent t +  :: PixelComponent t    => Size             -- ^ (width,height)   -> NChn             -- ^ number of channels (components\/pixel)   -> Maybe Alignment  -- ^ the row alignment of the new image   -> Bitmap t-emptyBitmap siz nchn malign = unsafePerformIO $ IO.newBitmap siz nchn malign+emptyBitmap siz nchn malign = unIOBitmap $ unsafePerformIO $ IO.newIOBitmap siz nchn malign  -- | Creates a single channel bitmap from a function. -- This is probably a bit slow. createSingleChannelBitmap-  :: forall t. PixelComponent t +  :: PixelComponent t    => Size               -- ^ (width,height)   -> Maybe Alignment    -- ^ the row alignment of the new image   -> (Int -> Int -> t)  -- ^ the function used to create the bitmap   -> Bitmap t-createSingleChannelBitmap siz maling fun = unsafePerformIO $ +createSingleChannelBitmap siz maling fun = unIOBitmap $ unsafePerformIO $    IO.createSingleChannelBitmap siz maling fun  +-- | Creates an empty bitmap with the same properties as the source.+emptyCloneBitmap +  :: PixelComponent t +  => Bitmap t           -- ^ source (only dimensions and such is used)+  -> Maybe Alignment    -- ^ target alignment+  -> Bitmap t           -- ^ new empty bitmap+emptyCloneBitmap bm1 malign = unIOBitmap $ unsafePerformIO $ +  IO.emptyCloneBitmap (IOBitmap bm1) malign++-- | Clones a bitmap. The only effect of this in the pure +-- setting should be that the alignment/padding can change.+-- You shouldn't normally use this function.+cloneBitmap +  :: PixelComponent t +  => Bitmap t           -- ^ source image+  -> Maybe Alignment    -- ^ target alignment+  -> Bitmap t+cloneBitmap bm1 malign = unIOBitmap $ unsafePerformIO $ +  IO.cloneBitmap (IOBitmap bm1) malign+ --------------------------------------------------------------------------------  -- | Warning: this is probably slow. componentMap :: PixelComponent s => (s -> s) -> Bitmap s -> Bitmap s-componentMap f bm = unsafePerformIO $ IO.componentMap f bm+componentMap f bm = unIOBitmap $ unsafePerformIO $ +  IO.componentMap f (IOBitmap bm)  -- | Warning: this is probably slow. componentMap' :: (PixelComponent s, PixelComponent t) => (s -> t) -> Bitmap s -> Maybe Alignment -> Bitmap t-componentMap' f bm malign = unsafePerformIO $ IO.componentMap' f bm malign+componentMap' f bm malign = unIOBitmap $ unsafePerformIO $ +  IO.componentMap' f (IOBitmap bm) malign  -------------------------------------------------------------------------------- @@ -103,7 +140,8 @@   -> Offset           -- ^ source rectangle offset   -> Size             -- ^ source rectangle size   -> Bitmap t-copySubImage bm ofs siz = unsafePerformIO $ IO.copySubImage bm ofs siz+copySubImage bm ofs siz = unIOBitmap $ unsafePerformIO $ +  IO.copySubImage (IOBitmap bm) ofs siz  -- | Copy into a new \"black\" bitmap; common generalization of crop and extend. copySubImage'@@ -114,27 +152,56 @@   -> Size             -- ^ target image size   -> Offset           -- ^ target rectangle offset   -> Bitmap t-copySubImage' bm1 ofs1 rsiz tsiz ofs2 = unsafePerformIO $-  IO.copySubImage' bm1 ofs1 rsiz tsiz ofs2+copySubImage' bm1 ofs1 rsiz tsiz ofs2 = unIOBitmap $ unsafePerformIO $+  IO.copySubImage' (IOBitmap bm1) ofs1 rsiz tsiz ofs2    -------------------------------------------------------------------------------- +-- | Flips the bitmap vertically.+flipBitmap +  :: PixelComponent t +  => Bitmap t+  -> Maybe Alignment+  -> Bitmap t+flipBitmap bm malign = unIOBitmap $ unsafePerformIO $ IO.flipBitmap (IOBitmap bm) malign++-- | Flips the bitmap horizontally.+mirrorBitmap +  :: PixelComponent t +  => Bitmap t+  -> Maybe Alignment+  -> Bitmap t+mirrorBitmap bm malign = unIOBitmap $ unsafePerformIO $ IO.mirrorBitmap (IOBitmap bm) malign+  +--------------------------------------------------------------------------------++-- | Converts between different component types.+castBitmap +  :: (PixelComponent s, PixelComponent t)+  => Bitmap s               -- ^ source image+  -> Maybe Alignment        -- ^ target image row alignment+  -> Bitmap t +castBitmap bm1 malign = unIOBitmap $ unsafePerformIO $ +  IO.castBitmap (IOBitmap bm1) malign++--------------------------------------------------------------------------------+ extractSingleChannel    :: PixelComponent t    => Bitmap t               -- ^ source image   -> Maybe Alignment        -- ^ target image row alignment   -> Int                    -- ^ source channel index   -> Bitmap t-extractSingleChannel bm1 malign j = unsafePerformIO $ -  IO.extractSingleChannel bm1 malign j +extractSingleChannel bm1 malign j = unIOBitmap $ unsafePerformIO $ +  IO.extractSingleChannel (IOBitmap bm1) malign j   extractChannels :: PixelComponent t => Bitmap t -> Maybe Alignment -> [Bitmap t]-extractChannels bm malign = unsafePerformIO $-  IO.extractChannels bm malign +extractChannels bm malign = map unIOBitmap $ unsafePerformIO $+  IO.extractChannels (IOBitmap bm) malign  -combineChannels :: forall t. PixelComponent t => [Bitmap t] -> Maybe Alignment -> Bitmap t-combineChannels bms malign = unsafePerformIO $-  IO.combineChannels bms malign+combineChannels :: PixelComponent t => [Bitmap t] -> Maybe Alignment -> Bitmap t+combineChannels bms malign = unIOBitmap $ unsafePerformIO $+  IO.combineChannels (map IOBitmap bms) malign  -------------------------------------------------------------------------------- @@ -144,8 +211,8 @@   -> Size               -- ^ target image size   -> Maybe Alignment    -- ^ target image row alignment   -> Bitmap t  -bilinearResample bm siz malign = unsafePerformIO $ -  IO.bilinearResample bm siz malign+bilinearResample bm siz malign = unIOBitmap $ unsafePerformIO $ +  IO.bilinearResample (IOBitmap bm) siz malign  bilinearResampleChannel   :: PixelComponent t @@ -154,8 +221,8 @@   -> Size               -- ^ target image size   -> Maybe Alignment    -- ^ target image row alignment   -> Bitmap t  -bilinearResampleChannel bm j siz malign = unsafePerformIO $ -  IO.bilinearResampleChannel bm j siz malign+bilinearResampleChannel bm j siz malign = unIOBitmap $ unsafePerformIO $ +  IO.bilinearResampleChannel (IOBitmap bm) j siz malign    -------------------------------------------------------------------------------- @@ -172,8 +239,8 @@   -> Bitmap t        -- ^ source image 2   -> Maybe Alignment -- ^ target alignment   -> Bitmap t-blendBitmaps w1 w2 bm1 bm2 malign = unsafePerformIO $ -  IO.blendBitmaps w1 w2 bm1 bm2 malign+blendBitmaps w1 w2 bm1 bm2 malign = unIOBitmap $ unsafePerformIO $ +  IO.blendBitmaps w1 w2 (IOBitmap bm1) (IOBitmap bm2) malign  blendChannels   :: PixelComponent t @@ -185,8 +252,8 @@   -> Int             -- ^ channel index 2   -> Maybe Alignment -- ^ target alignment   -> Bitmap t-blendChannels w1 w2 bm1 ofs1 bm2 ofs2 malign = unsafePerformIO $ -  IO.blendChannels w1 w2 bm1 ofs1 bm2 ofs2 malign+blendChannels w1 w2 bm1 ofs1 bm2 ofs2 malign = unIOBitmap $ unsafePerformIO $ +  IO.blendChannels w1 w2 (IOBitmap bm1) ofs1 (IOBitmap bm2) ofs2 malign    --------------------------------------------------------------------------------   @@ -198,8 +265,8 @@   -> Bitmap t           -- ^ source image   -> Maybe Alignment    -- ^ target image row alignment   -> Bitmap t  -powerlawGammaCorrection gamma bm malign = unsafePerformIO $ -  IO.powerlawGammaCorrection gamma bm malign+powerlawGammaCorrection gamma bm malign = unIOBitmap $ unsafePerformIO $ +  IO.powerlawGammaCorrection gamma (IOBitmap bm) malign  powerlawGammaCorrectionChannel   :: PixelComponent t @@ -208,21 +275,23 @@   -> Int                -- ^ source channel indexe   -> Maybe Alignment    -- ^ target image row alignment   -> Bitmap t  -powerlawGammaCorrectionChannel gamma bm j malign = unsafePerformIO $ -  IO.powerlawGammaCorrectionChannel gamma bm j malign+powerlawGammaCorrectionChannel gamma bm j malign = unIOBitmap $ unsafePerformIO $ +  IO.powerlawGammaCorrectionChannel gamma (IOBitmap bm) j malign    -------------------------------------------------------------------------------- +{- -- | Note that the data is /shared/; and also that the resulting ByteString -- is encoded using the host machine's endianness. bitmapToByteString :: PixelComponent t => Bitmap t -> ByteString bitmapToByteString bm = bs where   bs = B.fromForeignPtr (castForeignPtr $ bitmapPtr bm) 0 n   n = bitmapSizeInBytes bm +-}  {-   -- | As its name says, this pretty much unsafe!-reallyUnsafeBitmapFromByteString :: forall t. ByteString -> Size -> NChn -> Padding -> Bitmap t+reallyUnsafeBitmapFromByteString :: ByteString -> Size -> NChn -> Padding -> Bitmap t reallyUnsafeBitmapFromByteString bs siz nchn pad =    if n > len || ofs /= 0      then error "reallyUnsafeBitmapFromByteString: better than segfault :)"

@@ -0,0 +1,67 @@++--------------------------------------------------------------------------------+-- Module      : Data.Bitmap.Pure.File+-- 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+--------------------------------------------------------------------------------++-- | Saving and loading uncompressed bitmaps.+-- For loading from compressed formats, see the @stb-image@ library:+-- <http://hackage.haskell.org/package/stb-image>.+--+-- The goal of this module is to provide the simplest possible interface +-- for loading and saving bitmaps; so you can start experimenting+-- without much hassle.+-- +-- Note: Endianness is the endianness of the host, so the resulting file is +-- not portable across platforms with different endiannesses.+-- +-- See the module "Data.Bitmap.IO.File" for the file format.+--++{-# LANGUAGE CPP, ForeignFunctionInterface #-}+module Data.Bitmap.Pure.File+  ( readBitmap+  , writeBitmap+  , readRawData+  , writeRawData+  ) +  where++--------------------------------------------------------------------------------++import Control.Applicative+import Control.Monad+import Foreign+import System.IO++import Data.Bitmap.Base+import Data.Bitmap.Internal+import Data.Bitmap.IO+import qualified Data.Bitmap.IO.File as IO++--------------------------------------------------------------------------------++readBitmap :: PixelComponent t => FilePath -> IO (Bitmap t)+readBitmap fpath = unIOBitmap <$> IO.readBitmap fpath+  +readRawData :: PixelComponent t => FilePath -> (Size,NChn,PixelComponentType) -> IO (Bitmap t) +readRawData fpath header = unIOBitmap <$> IO.readRawData fpath header++--------------------------------------------------------------------------------++writeBitmap :: PixelComponent t => FilePath -> Bitmap t -> IO ()+writeBitmap fpath bm = IO.writeBitmap fpath (IOBitmap bm)++-- | Saves only the raw pixel data, no resolution etc.+writeRawData :: PixelComponent t => FilePath -> Bitmap t -> IO ()+writeRawData fpath bm = IO.writeRawData fpath (IOBitmap bm)++--------------------------------------------------------------------------------+

@@ -0,0 +1,153 @@++--------------------------------------------------------------------------------+-- Module      : Data.Bitmap.Pure.Pixels+-- Version     : 0.0.2+-- License     : BSD3+-- Copyright   : (c) 2009-2010 Balazs Komuves+-- Author      : Balazs Komuves+-- Maintainer  : bkomuves (plus) hackage (at) gmail (dot) com+-- Stability   : experimental+-- Portability : requires FFI and CPP+-- Tested with : GHC 6.10.1+--------------------------------------------------------------------------------++-- | Access to individual pixels. It isn't very efficient to handle bitmaps this way. ++{-# LANGUAGE CPP #-}+module Data.Bitmap.Pure.Pixels+  ( +    Bitmap1, Bitmap2, Bitmap3, Bitmap4+  , bitmap1, bitmap2, bitmap3, bitmap4 +    --+  , unsafeReadComponent+  , unsafeReadComponents+    --+  , unsafeReadPixel+  , unsafeReadPixel1+  , unsafeReadPixel2+  , unsafeReadPixel3+  , unsafeReadPixel4  +  ) +  where++--------------------------------------------------------------------------------++import Control.Monad+import Control.Applicative++import Data.Word+import Foreign hiding (unsafePerformIO)++import Data.Bitmap.Base+import Data.Bitmap.Internal++import System.IO.Unsafe++--------------------------------------------------------------------------------++-- | Note that the resulting pointer is valid only within a line (because of the padding)+withComponentPtr +  :: PixelComponent t +  => Bitmap t       -- ^ the bitmap+  -> Offset           -- ^ position (x,y)+  -> Int              -- ^ channel index {0,1,...,nchannels-1}+  -> (Ptr t -> IO a)  -- ^ user action+  -> IO a+withComponentPtr 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++--------------------------------------------------------------------------------+        +-- | Newtypes for bitmaps with a fixed number of channels (components per pixel) +newtype Bitmap1 t = Bitmap1 { fromBitmap1 :: Bitmap t } +newtype Bitmap2 t = Bitmap2 { fromBitmap2 :: Bitmap t }+newtype Bitmap3 t = Bitmap3 { fromBitmap3 :: Bitmap t }+newtype Bitmap4 t = Bitmap4 { fromBitmap4 :: Bitmap t } ++bitmap1 :: Bitmap t -> Bitmap1 t+bitmap2 :: Bitmap t -> Bitmap2 t+bitmap3 :: Bitmap t -> Bitmap3 t+bitmap4 :: Bitmap t -> Bitmap4 t++bitmap1 bm = if bitmapNChannels bm == 1 then Bitmap1 bm else error "bitmap/bitmap1: number of channels is not 1"+bitmap2 bm = if bitmapNChannels bm == 2 then Bitmap2 bm else error "bitmap/bitmap2: number of channels is not 2"+bitmap3 bm = if bitmapNChannels bm == 3 then Bitmap3 bm else error "bitmap/bitmap3: number of channels is not 3"+bitmap4 bm = if bitmapNChannels bm == 4 then Bitmap4 bm else error "bitmap/bitmap4: number of channels is not 4"+++instance BitmapClass Bitmap1 where+  underlyingBitmap = fromBitmap1++instance BitmapClass Bitmap2 where+  underlyingBitmap = fromBitmap2++instance BitmapClass Bitmap3 where+  underlyingBitmap = fromBitmap3++instance BitmapClass Bitmap4 where+  underlyingBitmap = fromBitmap4++--------------------------------------------------------------------------------++-- | It is not very efficient to read\/write lots of pixels this way.+unsafeReadComponent +  :: PixelComponent t +  => Bitmap t      -- ^ the bitmap+  -> Offset        -- ^ position (x,y)+  -> Int           -- ^ channel index {0,1,...,nchannels-1}+  -> t+unsafeReadComponent bm xy ofs = unsafePerformIO $ withComponentPtr bm xy ofs $ peek++-- | Please note that the component array to read shouldn't cross +-- the boundary between lines.+unsafeReadComponents+  :: PixelComponent t +  => Bitmap t      -- ^ the bitmap+  -> Offset        -- ^ position (x,y)+  -> Int           -- ^ channel index {0,1,...,nchannels-1}+  -> Int           -- ^ the number of components to read+  -> [t]+unsafeReadComponents bm xy ofs k = unsafePerformIO $ withComponentPtr bm xy ofs $ \p -> peekArray k p+    ++unsafeReadPixel +  :: PixelComponent t +  => Bitmap t      -- ^ the bitmap+  -> Offset        -- ^ position (x,y)+  -> [t]+unsafeReadPixel bm xy = unsafeReadComponents bm xy 0 (bitmapNChannels bm)+   +       +--------------------------------------------------------------------------------++unsafeReadPixel1 :: PixelComponent t => Bitmap1 t -> Offset -> t+unsafeReadPixel2 :: PixelComponent t => Bitmap2 t -> Offset -> (t,t)+unsafeReadPixel3 :: PixelComponent t => Bitmap3 t -> Offset -> (t,t,t)+unsafeReadPixel4 :: PixelComponent t => Bitmap4 t -> Offset -> (t,t,t,t)++unsafeReadPixel1 bm xy = unsafePerformIO $ +  withComponentPtr (fromBitmap1 bm) xy 0 $ \p -> liftM (\[x]       ->  x       ) $ peekArray 1 p+  +unsafeReadPixel2 bm xy = unsafePerformIO $ +  withComponentPtr (fromBitmap2 bm) xy 0 $ \p -> liftM (\[x,y]     -> (x,y)    ) $ peekArray 2 p++unsafeReadPixel3 bm xy = unsafePerformIO $ +  withComponentPtr (fromBitmap3 bm) xy 0 $ \p -> liftM (\[x,y,z]   -> (x,y,z)  ) $ peekArray 3 p++unsafeReadPixel4 bm xy = unsafePerformIO $ +  withComponentPtr (fromBitmap4 bm) xy 0 $ \p -> liftM (\[x,y,z,w] -> (x,y,z,w)) $ peekArray 4 p+  +--------------------------------------------------------------------------------++-- restricted type+{-# SPECIALIZE myPlusPtr :: Ptr Word8 -> Int -> Ptr Word8 #-}+{-# SPECIALIZE myPlusPtr :: Ptr Float -> Int -> Ptr Float #-}+myPlusPtr :: Ptr a -> Int -> Ptr a+myPlusPtr = plusPtr++--------------------------------------------------------------------------------+

@@ -0,0 +1,236 @@++--------------------------------------------------------------------------------+-- Module      : Data.Bitmap.Simple+-- 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+--------------------------------------------------------------------------------++-- | This is the same as the pure API, without the annoying alignment stuff. +-- All functions use the default alignment.++{-# LANGUAGE CPP #-}+module Data.Bitmap.Simple +  ( +    module Data.Bitmap.Base+    +    -- * Creating bitmaps+  , emptyBitmap+  , emptyCloneBitmap+  , createSingleChannelBitmap+    -- * Using bitmaps+  , withBitmap+    -- * Mapping over bitmaps+  , componentMap+  , componentMap'+    -- * Cropping and extending+  , copySubImage+  , copySubImage'  +    -- * Flipping and mirroring+  , flipBitmap+  , mirrorBitmap+    -- * Casting+  , castBitmap+  -- , castChannel+    -- * Manipulating channels+  , combineChannels +  , extractChannels +  , extractSingleChannel +    -- * Bilinear resampling+  , bilinearResample+  , bilinearResampleChannel  +    -- * Blending+  , blendBitmaps  +  , blendChannels  +    -- * Gamma correction+  , powerlawGammaCorrection+  , powerlawGammaCorrectionChannel   +{-  +    -- * Conversion to ByteString+  , bitmapToByteString  +-}  +  ) +  where++--------------------------------------------------------------------------------++import Data.Word++import Foreign++import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as B++import Data.Bitmap.Base+import Data.Bitmap.Internal+import qualified Data.Bitmap.Pure as P++--------------------------------------------------------------------------------++-- | A bitmap filled with zero values.+emptyBitmap +  :: PixelComponent t +  => Size             -- ^ (width,height)+  -> NChn             -- ^ number of channels (components\/pixel)+  -> Bitmap t+emptyBitmap siz nchn = P.emptyBitmap siz nchn Nothing++-- | Creates a single channel bitmap from a function.+-- This is probably a bit slow.+createSingleChannelBitmap+  :: PixelComponent t +  => Size               -- ^ (width,height)+  -> (Int -> Int -> t)  -- ^ the function used to create the bitmap+  -> Bitmap t+createSingleChannelBitmap siz fun = P.createSingleChannelBitmap siz Nothing fun++-- | Creates an empty bitmap with the same properties as the source.+emptyCloneBitmap +  :: PixelComponent t +  => Bitmap t           -- ^ source (only dimensions and such is used)+  -> Bitmap t           -- ^ new empty bitmap+emptyCloneBitmap bm = P.emptyCloneBitmap bm Nothing+  +--------------------------------------------------------------------------------++-- | Warning: this is probably slow.+componentMap :: PixelComponent s => (s -> s) -> Bitmap s -> Bitmap s+componentMap = P.componentMap++-- | Warning: this is probably slow.+componentMap' :: (PixelComponent s, PixelComponent t) => (s -> t) -> Bitmap s -> Bitmap t+componentMap' f bm = P.componentMap' f bm Nothing++--------------------------------------------------------------------------------++-- | Copies a subrectangle of the source image into a new image.  +copySubImage+  :: PixelComponent t +  => Bitmap t         -- ^ source image+  -> Offset           -- ^ source rectangle offset+  -> Size             -- ^ source rectangle size+  -> Bitmap t+copySubImage = P.copySubImage++-- | Copy into a new \"black\" bitmap; common generalization of crop and extend.+copySubImage'+  :: PixelComponent t +  => Bitmap t         -- ^ source image+  -> Offset           -- ^ source rectangle offset+  -> Size             -- ^ source rectangle size+  -> Size             -- ^ target image size+  -> Offset           -- ^ target rectangle offset+  -> Bitmap t+copySubImage' = P.copySubImage'+  +--------------------------------------------------------------------------------++-- | Flips the bitmap vertically.+flipBitmap +  :: PixelComponent t +  => Bitmap t+  -> Bitmap t+flipBitmap bm = P.flipBitmap bm Nothing++-- | Flips the bitmap horizontally.+mirrorBitmap +  :: PixelComponent t +  => Bitmap t+  -> Bitmap t+mirrorBitmap bm = P.mirrorBitmap bm Nothing++--------------------------------------------------------------------------------++-- | Converts between different component types.+castBitmap +  :: (PixelComponent s, PixelComponent t)+  => Bitmap s               -- ^ source image+  -> Bitmap t +castBitmap bm1 = P.castBitmap bm1 Nothing++--------------------------------------------------------------------------------++extractSingleChannel +  :: PixelComponent t +  => Bitmap t               -- ^ source image+  -> Int                    -- ^ source channel index+  -> Bitmap t+extractSingleChannel bm1 j = P.extractSingleChannel bm1 Nothing j++extractChannels :: PixelComponent t => Bitmap t -> [Bitmap t]+extractChannels bm = P.extractChannels bm Nothing++combineChannels :: PixelComponent t => [Bitmap t] -> Bitmap t+combineChannels bms = P.combineChannels bms Nothing++--------------------------------------------------------------------------------++bilinearResample +  :: PixelComponent t +  => Bitmap t           -- ^ source image+  -> Size               -- ^ target image size+  -> Bitmap t  +bilinearResample bm siz = P.bilinearResample bm siz Nothing ++bilinearResampleChannel+  :: PixelComponent t +  => Bitmap t           -- ^ source image+  -> Int                -- ^ source channel indexe+  -> Size               -- ^ target image size+  -> Bitmap t  +bilinearResampleChannel bm j siz = P.bilinearResampleChannel bm j siz Nothing+  +--------------------------------------------------------------------------------++-- | 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           -- ^ weight 1+  -> Float           -- ^ weight 2+  -> Bitmap t        -- ^ source image 1 +  -> Bitmap t        -- ^ source image 2+  -> Bitmap t+blendBitmaps w1 w2 bm1 bm2 = P.blendBitmaps w1 w2 bm1 bm2 Nothing++blendChannels+  :: PixelComponent t +  => Float           -- ^ weight 1+  -> Float           -- ^ weight 2+  -> Bitmap t        -- ^ source image 1 +  -> Int             -- ^ channel index 1+  -> Bitmap t        -- ^ source image 2+  -> Int             -- ^ channel index 2+  -> Bitmap t+blendChannels w1 w2 bm1 ofs1 bm2 ofs2 = P.blendChannels w1 w2 bm1 ofs1 bm2 ofs2 Nothing+  +--------------------------------------------------------------------------------+  +-- | 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+  -> Bitmap t           -- ^ source image+  -> Bitmap t  +powerlawGammaCorrection gamma bm = P.powerlawGammaCorrection gamma bm Nothing++powerlawGammaCorrectionChannel+  :: PixelComponent t +  => Float              -- ^ gamma+  -> Bitmap t           -- ^ source image+  -> Int                -- ^ source channel indexe+  -> Bitmap t  +powerlawGammaCorrectionChannel gamma bm j = P.powerlawGammaCorrectionChannel gamma bm j Nothing+  +--------------------------------------------------------------------------------+

@@ -1,4 +1,4 @@-Copyright (c) 2009, Balazs Komuves+Copyright (c) 2009-2011, Balazs Komuves All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -1,11 +1,11 @@ Name:                bitmap-Version:             0.0.1-Synopsis:            A library for handling and manipulating bitmaps.+Version:             0.0.2+Synopsis:            A library for handling and manipulating bitmaps (rectangular pixel arrays). Description:         A library for handling and manipulating bitmaps (that is,                      rectangular pixel arrays). License:             BSD3 License-file:        LICENSE-Copyright:           (c) 2009 Balazs Komuves+Copyright:           (c) 2009-2011 Balazs Komuves Author:              Balazs Komuves Maintainer:          bkomuves (plus) hackage (at) gmail (dot) com Homepage:            http://code.haskell.org/~bkomuves/@@ -30,14 +30,20 @@        Exposed-Modules:     Data.Bitmap,                        Data.Bitmap.Base,+                       Data.Bitmap.Simple,+                       Data.Bitmap.Pure,+                       Data.Bitmap.Pure.File,+                       Data.Bitmap.Pure.Pixels,                        Data.Bitmap.IO,-                       Data.Bitmap.Pure+                       Data.Bitmap.IO.File,+                       Data.Bitmap.IO.Pixels    Other-Modules:       Data.Bitmap.Internal    Hs-Source-Dirs:      .-  Extensions:          ForeignFunctionInterface, CPP, ScopedTypeVariables+  Extensions:          ForeignFunctionInterface, CPP    C-Sources:           cbits/bm.c    Include-Dirs:        cbits+  cc-options:          -O3                        

@@ -57,8 +57,47 @@ inline word32 fromFloat_word32 (float x) { return ( floor ( 0.5 + 4294967295.0 * CLAMP_01(x) ) ); } inline float  fromFloat_float  (float x) { return x; } + // ----------------------------------------------------------------------------- +// tgt and src can be potentally the same+void c_mirror_line(int width, int bytesperpixel, void *src, void *tgt)+{+  int i,k;+  word8 *p = (word8*)src;+  word8 *q = ((word8*)tgt) + (width-1)*bytesperpixel;++  if (src == tgt)+  {+    word8 *tmp = alloca(bytesperpixel); +    +    k = width / 2;+    for(i=0;i<k;i++)+    { +      memcpy(tmp, p  , bytesperpixel);+      memcpy(p  , q  , bytesperpixel);+      memcpy(q  , tmp, bytesperpixel);++      p += bytesperpixel;+      q -= bytesperpixel;+    }       +  }+  +  else+  +  {+    for(i=0;i<width;i++)+    { +      memcpy(q  , p  , bytesperpixel);+    +      p += bytesperpixel;+      q -= bytesperpixel;+    }+  }+  +}+// -----------------------------------------------------------------------------+ #define C_EXTRACT_CHANNEL(TYP) \ void c_extract_channel_ ## TYP \   ( int width, int height \@@ -100,6 +139,100 @@     case K_WORD16: CALL_EXTRACT_CHANNEL(word16); break;     case K_WORD32: CALL_EXTRACT_CHANNEL(word32); break;     case K_FLOAT:  CALL_EXTRACT_CHANNEL(float ); break;+  }+}++// -----------------------------------------------------------------------------++// nchn1 should be equal to nchn2 !+#define C_CAST_BITMAP(TYP1,TYP2) \+void c_cast_bitmap_ ## TYP1 ## _ ## TYP2 \+  ( int width, int height \+  , TYP1 *p1, int nchn1, int pad1, int ofs1 \+  , TYP2 *p2, int nchn2, int pad2, int ofs2 \+  ) \+{ int x,y;     \+  TYP1 *q1;    \+  TYP2 *q2;    \+  q1 = p1 + ofs1; \+  q2 = p2 + ofs2; \+  for(y=0;y<height;y++)   \+  { for(x=0;x<width*nchn1;x++)  \+    { *q2 = fromFloat_ ## TYP2 ( toFloat_ ## TYP1 (*q1 ));    \+      q1 ++;  \+      q2 ++;  \+    }               \+    q1 = PLUSPTR(q1,TYP1,pad1); \+    q2 = PLUSPTR(q2,TYP2,pad2); \+  }   \+} ++C_CAST_BITMAP(word8,word8 )+C_CAST_BITMAP(word8,word16)+C_CAST_BITMAP(word8,word32)+C_CAST_BITMAP(word8,float )++C_CAST_BITMAP(word16,word8 )+C_CAST_BITMAP(word16,word16)+C_CAST_BITMAP(word16,word32)+C_CAST_BITMAP(word16,float )++C_CAST_BITMAP(word32,word8 )+C_CAST_BITMAP(word32,word16)+C_CAST_BITMAP(word32,word32)+C_CAST_BITMAP(word32,float )++C_CAST_BITMAP(float,word8 )+C_CAST_BITMAP(float,word16)+C_CAST_BITMAP(float,word32)+C_CAST_BITMAP(float,float )++#define CALL_CAST_BITMAP(TYP1,TYP2) \+c_cast_bitmap_ ## TYP1 ## _ ## TYP2 ( width,height, p1,nchn1,pad1,ofs1, p2,nchn2,pad2,ofs2 );++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 +  ) +{ switch(k_type1)+  {+    case K_WORD8:  +      switch(k_type2)+      { case K_WORD8:  CALL_CAST_BITMAP(word8,word8 ); break;+        case K_WORD16: CALL_CAST_BITMAP(word8,word16); break;+        case K_WORD32: CALL_CAST_BITMAP(word8,word32); break;+        case K_FLOAT:  CALL_CAST_BITMAP(word8,float ); break;+      }+      break;+      +    case K_WORD16:  +      switch(k_type2)+      { case K_WORD8:  CALL_CAST_BITMAP(word16,word8 ); break;+        case K_WORD16: CALL_CAST_BITMAP(word16,word16); break;+        case K_WORD32: CALL_CAST_BITMAP(word16,word32); break;+        case K_FLOAT:  CALL_CAST_BITMAP(word16,float ); break;+      }+      break;++    case K_WORD32:  +      switch(k_type2)+      { case K_WORD8:  CALL_CAST_BITMAP(word32,word8 ); break;+        case K_WORD16: CALL_CAST_BITMAP(word32,word16); break;+        case K_WORD32: CALL_CAST_BITMAP(word32,word32); break;+        case K_FLOAT:  CALL_CAST_BITMAP(word32,float ); break;+      }+      break;++   case K_FLOAT:  +      switch(k_type2)+      { case K_WORD8:  CALL_CAST_BITMAP(float,word8 ); break;+        case K_WORD16: CALL_CAST_BITMAP(float,word16); break;+        case K_WORD32: CALL_CAST_BITMAP(float,word32); break;+        case K_FLOAT:  CALL_CAST_BITMAP(float,float ); break;+      }+      break;   } } 

@@ -15,6 +15,20 @@  //------------------------------------------------------------------------------ +// tgt and src can be potentally the same+void c_mirror_line(int width, int bytesperpixel, void *src, void *tgt);++//------------------------------------------------------------------------------++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 +  );++//------------------------------------------------------------------------------+   void c_extract_channel   ( int k_type   , int width, int height