bitmap 0.0.0 → 0.0.1

raw patch · 8 files changed

+1074/−79 lines, 8 filesdep −arraydep −containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: array, containers

API changes (from Hackage documentation)

Files

• Data/Bitmap.hs +7/−4
• Data/Bitmap/Base.hs +4/−2
• Data/Bitmap/IO.hs +561/−41
• Data/Bitmap/Internal.hs +52/−7
• Data/Bitmap/Pure.hs +102/−4
• bitmap.cabal +3/−3
• cbits/bm.c +302/−18
• cbits/bm.h +43/−0

@@ -1,7 +1,7 @@  -------------------------------------------------------------------------------- -- Module      : Data.Bitmap--- Version     : 0.0.0+-- Version     : 0.0.1 -- License     : BSD3 -- Copyright   : (c) 2009 Balazs Komuves -- Author      : Balazs Komuves@@ -14,7 +14,10 @@ -- | A library to handle bitmaps (uncompressed pixel rectangles). -- The smallest storage unit is 1 byte (thus /bit/maps, in the literal sense -- of the word, are not supported).--- You may want to import this module qualified.+--+-- For loading JPEG/PNG images into 'Bitmap's, see the @stb-image@ +-- library (version 0.2 or newer):+-- <http://hackage.haskell.org/package/stb-image>. --  -- Terminology:  -- Pixels are made out of one or more \"components\". These components @@ -23,7 +26,7 @@ -- bytes, words, dwords, or floats. The pixels are stored in horizontal order, -- and the channels are interleaved: That is, the structure of an RGB image is  -- @R0 G0 B0 R1 G1 B1 ...@. --- Most of the library is agnostic to the meaning of different channels.+-- Most of the library is indifferent to the meaning of different channels. -- -- \"Padding\" refers to unused bytes at the end of each row. This is sometimes -- necessary because other software components want the rows aligned to machine@@ -31,7 +34,7 @@ -- -- The library should be relatively fast (except where noted), but  -- performance is not the primary goal (thus there is no inline assembly,--- no SSE, etc).+-- 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.

@@ -1,7 +1,7 @@  -------------------------------------------------------------------------------- -- Module      : Data.Bitmap.Base--- Version     : 0.0.0+-- Version     : 0.0.1 -- License     : BSD3 -- Copyright   : (c) 2009 Balazs Komuves -- Author      : Balazs Komuves@@ -19,7 +19,7 @@ -- bytes, words, dwords, or floats. The pixels are stored in horizontal order, -- and the channels are interleaved: That is, the structure of an RGB image is  -- @R0 G0 B0 R1 G1 B1 ...@. --- Most of the library is agnostic to the meaning of different channels.+-- Most of the library is indifferent to the meaning of different channels. -- The fixed point types (byte, word and dword) are interpreted as numbers -- between 0 and 1; the floating point type can exceed the [0..1] interval. --@@ -34,6 +34,7 @@     -- * Types     PixelComponent   , PixelComponentType(..)+  , pixelComponentSize   , pixelComponentType     --   , Word8@@ -51,6 +52,7 @@   , bitmapNChannels   , bitmapRowPadding    , bitmapRowAlignment +  , bitmapAspect     --   , bitmapComponentSizeInBytes   , bitmapPixelSizeInBytes

@@ -1,7 +1,7 @@  -------------------------------------------------------------------------------- -- Module      : Data.Bitmap.IO--- Version     : 0.0.0+-- Version     : 0.0.1 -- License     : BSD3 -- Copyright   : (c) 2009 Balazs Komuves -- Author      : Balazs Komuves@@ -21,6 +21,7 @@     -- * Creating and accessing bitmaps   , newBitmap   , newBitmapUninitialized+  , createSingleChannelBitmap   , copyBitmapFromPtr   , bitmapFromForeignPtrUnsafe   , withBitmap@@ -37,9 +38,36 @@   , extractChannels    , extractSingleChannel    , extractChannelInto+    -- * Bilinear resampling+  , bilinearResample+  , bilinearResampleChannel+  , bilinearResampleChannelInto+    -- * Blending+  , blendBitmaps+  , blendChannels+  , blendChannelsInto+    -- * Gamma correction+  , powerlawGammaCorrection+  , powerlawGammaCorrectionChannel  +  , powerlawGammaCorrectionChannelInto       -- * Conversion to\/from ByteString   , copyBitmapToByteString   , copyBitmapFromByteString+    -- * Reading and writing pixels+  , withComponentPtr+  , unsafeReadComponent+  , unsafeWriteComponent+  , unsafeReadComponents+  , unsafeWriteComponents+  , unsafeReadPixel+  , unsafeReadPixel1+  , unsafeReadPixel2+  , unsafeReadPixel3+  , unsafeReadPixel4+  , unsafeWritePixel1+  , unsafeWritePixel2+  , unsafeWritePixel3+  , unsafeWritePixel4   )    where   @@ -63,8 +91,22 @@ import Data.Bitmap.Base  --------------------------------------------------------------------------------++defaultAlignment :: Int+defaultAlignment = 4++validateMaybeAlignment :: Maybe Alignment -> Alignment+validateMaybeAlignment = maybe defaultAlignment validateAlignment++validateAlignment :: Alignment -> Alignment+validateAlignment k = +  if isValidAlignment k +    then k +    else error "invalid row alignment (allowed values: 1, 2, 4 and 8)"   --- @newBitmapRaw (width,row) nchannels padding@. We do not initialize the new bitmap!+--------------------------------------------------------------------------------+  +-- we do not initialize the new bitmap! newBitmapRaw :: forall t. PixelComponent t => Size -> NChn -> Padding -> Alignment -> IO (Bitmap t)    newBitmapRaw siz nchn pad align = do   let bm0 = Bitmap @@ -81,6 +123,10 @@ -- | Note: we /cannot/ guarantee the alignment -- of the memory block (but typically it is aligned at least to machine word boundary), -- but what we /can/ guarantee is that the rows are properly padded.+--+-- At the moment, the default alignment is 4, valid alignments are 1, 2, 4, 8 and 16,+-- and the padding method is compatible with the OpenGL one (that is, the padding is the+-- smallest multiple of a component size such that the next row is aligned). --  -- The resulting new bitmap is filled with zeros. newBitmap @@ -106,11 +152,52 @@         , 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   +-- | 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 +  => 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)+createSingleChannelBitmap siz malign fun = do  +  bm <- newBitmapUninitialized siz 1 malign +  let fptr = bitmapPtr bm+      len  = bitmapSizeInBytes bm+      f :: Int -> Int -> t -> t+      f x y _ = fun x y +  genericComponentMapWithPos f bm bm+  return bm++{-    +createBitmap    +  :: forall 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 +  let fptr = bitmapPtr bm+      len  = bitmapSizeInBytes bm+      f :: Int -> Int -> t -> t+      f x y _ = fun x y +  genericComponentMapWithPos f bm bm+  return bm+-}+     copyBitmapFromPtr    :: forall t. PixelComponent t    => Size       -- ^ (width,height) of the source@@ -150,29 +237,120 @@  -------------------------------------------------------------------------------- +-- | 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+  -> 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 (undefined::t) + y * rowsize ) +    action q+    +-- | 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}+  -> IO t+unsafeReadComponent bm xy ofs = withComponentPtr bm xy ofs $ peek+    +unsafeWriteComponent+  :: PixelComponent t +  => Bitmap 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 +  => Bitmap 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 +  => Bitmap 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 +  => Bitmap 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 ()++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++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]++--------------------------------------------------------------------------------+ {-# SPECIALIZE genericComponentRowMap -      :: (Int -> Ptr Word8  -> Ptr Word8  -> IO ()) -> Bitmap Word8  -> Bitmap Word8  -> IO () #-}+      :: (Int -> Int -> Ptr Word8  -> Ptr Word8  -> IO ()) -> Bitmap Word8  -> Bitmap Word8  -> IO () #-} {-# SPECIALIZE genericComponentRowMap -      :: (Int -> Ptr Word16 -> Ptr Word16 -> IO ()) -> Bitmap Word16 -> Bitmap Word16 -> IO () #-}+      :: (Int -> Int -> Ptr Word16 -> Ptr Word16 -> IO ()) -> Bitmap Word16 -> Bitmap Word16 -> IO () #-} {-# SPECIALIZE genericComponentRowMap -      :: (Int -> Ptr Word32 -> Ptr Word32 -> IO ()) -> Bitmap Word32 -> Bitmap Word32 -> IO () #-}+      :: (Int -> Int -> Ptr Word32 -> Ptr Word32 -> IO ()) -> Bitmap Word32 -> Bitmap Word32 -> IO () #-} {-# SPECIALIZE genericComponentRowMap -      :: (Int -> Ptr Float  -> Ptr Float  -> IO ()) -> Bitmap Float  -> Bitmap Float  -> IO () #-}+      :: (Int -> Int -> Ptr Float  -> Ptr Float  -> IO ()) -> Bitmap Float  -> Bitmap Float  -> IO () #-}  {-# SPECIALIZE genericComponentRowMap -      :: (Int -> Ptr Word8  -> Ptr Float  -> IO ()) -> Bitmap Word8  -> Bitmap Float  -> IO () #-}+      :: (Int -> Int -> Ptr Word8  -> Ptr Float  -> IO ()) -> Bitmap Word8  -> Bitmap Float  -> IO () #-} {-# SPECIALIZE genericComponentRowMap -      :: (Int -> Ptr Float  -> Ptr Word8  -> IO ()) -> Bitmap Float  -> Bitmap Word8  -> IO () #-}+      :: (Int -> Int -> Ptr Float  -> Ptr Word8  -> IO ()) -> Bitmap Float  -> Bitmap Word8  -> IO () #-}  {-# SPECIALIZE genericComponentRowMap -      :: (Int -> Ptr Word16 -> Ptr Float  -> IO ()) -> Bitmap Word16 -> Bitmap Float  -> IO () #-}+      :: (Int -> Int -> Ptr Word16 -> Ptr Float  -> IO ()) -> Bitmap Word16 -> Bitmap Float  -> IO () #-} {-# SPECIALIZE genericComponentRowMap -      :: (Int -> Ptr Float  -> Ptr Word16 -> IO ()) -> Bitmap Float  -> Bitmap Word16 -> IO () #-}+      :: (Int -> Int -> Ptr Float  -> Ptr Word16 -> IO ()) -> Bitmap Float  -> Bitmap Word16 -> IO () #-} --- the @Int@ is the number of pixel components (nchn*width)+-- the first Int is the y position+-- the second Int is the number of pixel components (nchn*width) genericComponentRowMap    :: (PixelComponent s, PixelComponent t) -  => (Int -> Ptr s -> Ptr t -> IO ()) +  => (Int -> Int -> Ptr s -> Ptr t -> IO ())        -- ^ ypos totalNumberOfComps src tgt   -> Bitmap s -> Bitmap t -> IO () genericComponentRowMap rowAction bm1 bm2 = do @@ -195,18 +373,19 @@     error "bitmap/genericRowMap: number of channels disagree"         withForeignPtr fptr1 $ \ptr1 -> withForeignPtr fptr2 $ \ptr2 -> -    forM_ (zip (map (*xlen1) [0..h1-1]) -               (map (*xlen2) [0..h2-1])) $ \(vo1,vo2) -> do+    forM_ (zip3 [0..h1-1]+               (map (*xlen1) [0..h1-1]) +               (map (*xlen2) [0..h2-1])) $ \(ypos,vo1,vo2) -> do       let p1 = ptr1 `myPlusPtr` vo1                p2 = ptr2 `myPlusPtr` vo2     -      rowAction npc p1 p2 +      rowAction ypos npc p1 p2   ------- --- the @Int@ is the number of pixels (width)+-- userAction ypos width ptr1 nchn1 ptr2 nchn2  genericPixelRowMap    :: (PixelComponent s, PixelComponent t) -  => (Int -> Ptr s -> NChn -> Ptr t -> NChn -> IO ())    -- width ptr1 nchn1 ptr2 nchn2 +  => (Int -> Int -> Ptr s -> NChn -> Ptr t -> NChn -> IO ())    -- ^ ypos width ptr1 nchn1 ptr2 nchn2    -> Bitmap s -> Bitmap t -> IO () genericPixelRowMap rowAction bm1 bm2 = do @@ -225,10 +404,12 @@   let minw = min w1 w2     withForeignPtr fptr1 $ \ptr1 -> withForeignPtr fptr2 $ \ptr2 -> -    forM_ (zip (map (*xlen1) [0..h1-1]) (map (*xlen2) [0..h2-1])) $ \(o1,o2) -> do-      let p1 = ptr1 `plusPtr` o1     -          p2 = ptr2 `plusPtr` o2     -      rowAction minw p1 nchn1 p2 nchn2+    forM_ (zip3 [0..h1-1] +                (map (*xlen1) [0..h1-1]) +                (map (*xlen2) [0..h2-1])) $ \(ypos,o1,o2) -> do+      let p1 = ptr1 `myPlusPtr` o1     +          p2 = ptr2 `myPlusPtr` o2     +      rowAction ypos minw p1 nchn1 p2 nchn2  --------------------------------------------------------------------------------       @@ -252,22 +433,41 @@     x <- peek q1     poke q2 (f x)     return (advancePtr1 q1, advancePtr1 q2)-  g :: Int -> Ptr s -> Ptr t -> IO ()-  g n p1 p2 = do+  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 () #-}       --- | Maps a function over each component of each pixel. Warning: this is slow!+genericComponentMapWithPos +  :: forall s t . (PixelComponent s, PixelComponent t) +  => (Int -> Int -> s -> t) -> Bitmap s -> Bitmap t -> IO ()  +genericComponentMapWithPos f bm1 bm2 = genericComponentRowMap g bm1 bm2 where+  h :: Int -> (Ptr s, Ptr t) -> Int -> IO (Ptr s, Ptr t)+  h ypos (q1,q2) xpos = do+    x <- peek q1+    poke q2 (f xpos ypos x)+    return (advancePtr1 q1, advancePtr1 q2)+  g :: Int -> Int -> Ptr s -> Ptr t -> IO ()+  g ypos n p1 p2 = do+    foldM_ (h ypos) (p1,p2) [0..n-1]++--------------------------------------------------------------------------------++-- | Maps a function over each component of each pixel. Warning: this is probably slow! -- Use a specialized function if there is one for your task.--- +{-  -- Note: We don't do the more general (s->t) here, because then we would have no idea  -- about the padding in the new bitmap. See `componentMap'` for that.+-} componentMap :: PixelComponent s => (s -> s) -> Bitmap s -> IO (Bitmap s) componentMap f bm1 = do   let siz   = bitmapSize bm1       nchn  = bitmapNChannels bm1       align = bitmapRowAlignment bm1---      x = bitmapPaddedRowSizeInBytes bm1    bm2 <- newBitmapUninitialized siz nchn (Just align)    genericComponentMap f bm1 bm2    return bm2@@ -276,7 +476,7 @@ componentMapInPlace f bm = do   genericComponentMap f bm bm     --- | See the comments at 'componentMap'.+-- See the comments at 'componentMap'. componentMap'    :: (PixelComponent s, PixelComponent t)    => (s -> t) @@ -384,13 +584,8 @@ extractSingleChannel bm1 malign j = do   let nchn = bitmapNChannels bm1       siz@(w,h) = bitmapSize bm1- --     pad1 = bitmapRowPadding bm1- --     fptr1 = bitmapPtr bm1-   when (j<0 || j>=nchn) $ error "bitmap/extractSingleChannel: invalid channel index"-   bm2 <- newBitmapUninitialized siz 1 malign-   extractChannelInto bm1 j bm2 0   return bm2   @@ -400,6 +595,7 @@   mapM (extractSingleChannel bm malign) [0..nchn-1]      where nchn = bitmapNChannels bm + combineChannels :: forall t. PixelComponent t => [Bitmap t] -> Maybe Alignment -> IO (Bitmap t) combineChannels [] _ = error "bitmap/combineChannels: no channel data" combineChannels bms malign = do@@ -450,8 +646,10 @@       pad2  = bitmapRowPadding bm2       fptr2 = bitmapPtr bm2 -  when (siz1 /= siz2) $ error "bitmap/extractChannelInto: incompatible dimensions"-+  when (siz1 /= siz2)          $ error "bitmap/extractChannelInto: incompatible dimensions"+  when (ofs1<0 || ofs1>=nchn1) $ error "bitmap/extractChannelInto: invalid source channel index"+  when (ofs2<0 || ofs2>=nchn2) $ error "bitmap/extractChannelInto: invalid target channel index"+     withForeignPtr fptr1 $ \ptr1 ->      withForeignPtr fptr2 $ \ptr2 ->            c_extract_channel @@ -462,7 +660,241 @@  -------------------------------------------------------------------------------- --- | The data is copied, not shared.+bilinearResample+  :: PixelComponent t +  => Bitmap t        -- ^ source image+  -> Size            -- ^ target image size+  -> Maybe Alignment -- ^ target image alignment+  -> IO (Bitmap t)   +bilinearResample bm1 siz2@(w2,h2) malign = do+  let nchn1 = bitmapNChannels bm1+  bm2 <- newBitmapUninitialized siz2 nchn1 malign+  forM_ [0..nchn1-1] $ \ofs ->+    bilinearResampleChannelInto bm1 ofs bm2 ofs+  return bm2+++bilinearResampleChannel+  :: PixelComponent t +  => Bitmap t        -- ^ source image+  -> Int             -- ^ source channel index +  -> Size            -- ^ target image size+  -> Maybe Alignment -- ^ target image alignment+  -> IO (Bitmap 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+  bilinearResampleChannelInto bm1 ofs1 bm2 0+  return bm2+++bilinearResampleChannelInto +  :: forall t. PixelComponent t +  => Bitmap t     -- ^ source image+  -> Int          -- ^ source channel index +  -> Bitmap t     -- ^ target image+  -> Int          -- ^ target channel index+  -> IO ()+bilinearResampleChannelInto bm1 ofs1 bm2 ofs2 = do++  let nchn1 = bitmapNChannels bm1+      siz1@(w1,h1) = bitmapSize bm1+      pad1  = bitmapRowPadding bm1+      fptr1 = bitmapPtr bm1++  let nchn2 = bitmapNChannels bm2+      siz2@(w2,h2) = bitmapSize bm2+      pad2  = bitmapRowPadding bm2+      fptr2 = bitmapPtr bm2++  when (ofs1<0 || ofs1>=nchn1) $ error "bitmap/bilinearResampleChannelInto: invalid source channel index"+  when (ofs2<0 || ofs2>=nchn2) $ error "bitmap/bilinearResampleChannelInto: invalid target channel index"+  +  withForeignPtr fptr1 $ \ptr1 -> +    withForeignPtr fptr2 $ \ptr2 ->     +      c_bilinear_resample_channel +        (c_type (undefined::t))+        (ci w1) (ci h1) ptr1 (ci nchn1) (ci pad1) (ci ofs1)+        (ci w2) (ci h2) ptr2 (ci nchn2) (ci pad2) (ci ofs2)++--------------------------------------------------------------------------------++-- | This is equivalent to @componentMap (\c -> c^gamma)@, except that+-- @(^)@ is defined only for integral exponents; but should be faster anyway.+powerlawGammaCorrection +  :: forall t. PixelComponent t +  => Float             -- ^ gamma+  -> Bitmap t          -- ^ source bitmap+  -> Maybe Alignment   -- ^ target alignment+  -> IO (Bitmap 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+  let pad2 = bitmapRowPadding bm2+      fptr2 = bitmapPtr bm2+  withForeignPtr fptr1 $ \ptr1 -> +    withForeignPtr fptr2 $ \ptr2 ->     +      c_gamma_correct_all_channels +        (c_type (undefined::t))+        (realToFrac gamma) +        (ci w1) (ci h1) (ci nchn1) +        ptr1 (ci pad1) +        ptr2 (ci pad2) +  return bm2+  ++powerlawGammaCorrectionChannel+  :: PixelComponent t +  => Float           -- ^ gamma+  -> Bitmap t        -- ^ source image+  -> Int             -- ^ source channel index +  -> Maybe Alignment -- ^ target image alignment+  -> IO (Bitmap 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+  powerlawGammaCorrectionChannelInto gamma bm1 ofs1 bm2 0+  return bm2+  +powerlawGammaCorrectionChannelInto+  :: forall t. PixelComponent t +  => Float        -- ^ gamma+  -> Bitmap t     -- ^ source image+  -> Int          -- ^ source channel index +  -> Bitmap t     -- ^ target image+  -> Int          -- ^ target channel index+  -> IO ()+powerlawGammaCorrectionChannelInto gamma bm1 ofs1 bm2 ofs2 = do++  let nchn1 = bitmapNChannels bm1+      siz1@(w1,h1) = bitmapSize bm1+      pad1  = bitmapRowPadding bm1+      fptr1 = bitmapPtr bm1++  let nchn2 = bitmapNChannels bm2+      siz2@(w2,h2) = bitmapSize bm2+      pad2  = bitmapRowPadding bm2+      fptr2 = bitmapPtr bm2++  when (siz1 /= siz2)          $ error "bitmap/powerlawGammaCorrectionChannelInto: incompatible dimensions"+  when (ofs1<0 || ofs1>=nchn1) $ error "bitmap/powerlawGammaCorrectionChannelInto: invalid source channel index"+  when (ofs2<0 || ofs2>=nchn2) $ error "bitmap/powerlawGammaCorrectionChannelInto: invalid target channel index"+  +  withForeignPtr fptr1 $ \ptr1 -> +    withForeignPtr fptr2 $ \ptr2 ->     +      c_gamma_correct_channel +        (c_type (undefined::t))+        (realToFrac gamma) +        (ci w1) (ci h1) +        ptr1 (ci nchn1) (ci pad1) (ci ofs1)+        ptr2 (ci nchn2) (ci pad2) (ci ofs2)++--------------------------------------------------------------------------------++-- | Blends two bitmaps with the given weights; that is, the result is+-- the specified linear combination. If the values are outside the allowed+-- range (this can happen with the Word8, Word16, Word32 types and weights+-- whose sum is bigger than 1, or with a negative weight), then they are+-- clipped. The clipping /does not/ happen with the Float component type.+blendBitmaps+  :: PixelComponent t +  => Float           -- ^ weight1+  -> Float           -- ^ weight2+  -> Bitmap t        -- ^ source1 image +  -> Bitmap t        -- ^ source2 image +  -> Maybe Alignment -- ^ target alignment+  -> IO (Bitmap t)+-- this could be implemented more effectively by a specialized c routine+blendBitmaps weight1 weight2 bm1 bm2 malign = do +  let nchn1 = bitmapNChannels bm1+      siz1  = bitmapSize bm1+  let nchn2 = bitmapNChannels bm2+      siz2  = bitmapSize bm2+  when (siz1  /= siz2 ) $ error "bitmap/blend: incompatible dimensions"    +  when (nchn1 /= nchn2) $ error "bitmap/blend: incompatible number of channels"+  bm3 <- newBitmapUninitialized siz1 nchn1 malign+  forM [0..nchn1-1] $ \ofs -> +    blendChannelsInto weight1 weight2 bm1 ofs bm2 ofs bm3 ofs+  return bm3  +  +blendChannels+  :: PixelComponent t +  => Float        -- ^ weight1+  -> Float        -- ^ weight2+  -> Bitmap t     -- ^ source1 image +  -> Int          -- ^ source1 channel index  +  -> Bitmap t     -- ^ source2 image +  -> Int          -- ^ source2 channel index  +  -> Maybe Alignment -- ^ target alignment+  -> IO (Bitmap t)+blendChannels weight1 weight2 bm1 ofs1 bm2 ofs2 malign = do+  let nchn1 = bitmapNChannels bm1+      siz1  = bitmapSize bm1+  let nchn2 = bitmapNChannels bm2+      siz2  = bitmapSize bm2+  when (siz1 /= siz2)          $ error "bitmap/blendChannels: incompatible dimensions"    +  when (ofs1<0 || ofs1>=nchn1) $ error "bitmap/blendChannels: invalid channel index"+  when (ofs2<0 || ofs2>=nchn2) $ error "bitmap/blendChannels: invalid channel index"+  bm3 <- newBitmapUninitialized siz1 1 malign+  blendChannelsInto weight1 weight2 bm1 ofs1 bm2 ofs2 bm3 0+  return bm3  +  +blendChannelsInto+  :: forall t. PixelComponent t +  => Float        -- ^ weight1+  -> Float        -- ^ weight2+  -> Bitmap t     -- ^ source1 image +  -> Int          -- ^ source1 channel index  +  -> Bitmap t     -- ^ source2 image +  -> Int          -- ^ source2 channel index  +  -> Bitmap t     -- ^ target image+  -> Int          -- ^ target channel index+  -> IO ()+blendChannelsInto weight1 weight2 bm1 ofs1 bm2 ofs2 bm3 ofs3 = do++  let nchn1 = bitmapNChannels bm1+      siz1@(w1,h1) = bitmapSize bm1+      pad1  = bitmapRowPadding bm1+      fptr1 = bitmapPtr bm1++  let nchn2 = bitmapNChannels bm2+      siz2@(w2,h2) = bitmapSize bm2+      pad2  = bitmapRowPadding bm2+      fptr2 = bitmapPtr bm2++  let nchn3 = bitmapNChannels bm3+      siz3@(w3,h3) = bitmapSize bm3+      pad3  = bitmapRowPadding bm3+      fptr3 = bitmapPtr bm3++  when (siz1 /= siz2)          $ error "bitmap/blendChannelInto: incompatible dimensions"+  when (siz2 /= siz3)          $ error "bitmap/blendChannelInto: incompatible dimensions"+  when (ofs1<0 || ofs1>=nchn1) $ error "bitmap/blendChannelInto: invalid source channel index 1"+  when (ofs2<0 || ofs2>=nchn2) $ error "bitmap/blendChannelInto: invalid source channel index 2"+  when (ofs3<0 || ofs3>=nchn3) $ error "bitmap/blendChannelInto: invalid target channel index"+  +  withForeignPtr fptr1 $ \ptr1 -> +    withForeignPtr fptr2 $ \ptr2 ->     +      withForeignPtr fptr3 $ \ptr3 ->     +        c_linear_combine_channels +          (c_type (undefined::t))+          (realToFrac weight1) (realToFrac weight2) +          (ci w1) (ci h1) +          ptr1 (ci nchn1) (ci pad1) (ci ofs1)+          ptr2 (ci nchn2) (ci pad2) (ci ofs2)+          ptr3 (ci nchn3) (ci pad3) (ci ofs3)+        +--------------------------------------------------------------------------------++-- | The data is copied, not shared. Note that the resulting ByteString is+-- encoded using the host machine's endianness, so it may be not compatible+-- across different architectures! copyBitmapToByteString :: PixelComponent t => Bitmap t -> IO ByteString copyBitmapToByteString bm = do   let n = bitmapSizeInBytes bm@@ -473,6 +905,8 @@   return $ B.fromForeignPtr (castForeignPtr newfp) 0 n  -- | The data is copied, not shared.+-- Note that we expect the ByteString to be encoded+-- encoded using the host machine's endianness. copyBitmapFromByteString :: forall t. PixelComponent t => ByteString -> Size -> NChn -> Padding -> IO (Bitmap t) copyBitmapFromByteString bs siz nchn pad = do   let (bsfptr0,ofs,len) = B.toForeignPtr bs@@ -489,7 +923,7 @@     else do       newfptr <- mallocForeignPtrBytes n       withForeignPtr bsfptr0 $ \src0 -> do-        let src = src0 `plusPtr` ofs+        let src = src0 `myPlusPtr` ofs         withForeignPtr newfptr $ \tgt ->           c_memcpy src tgt n       return $ bm { bitmapPtr = castForeignPtr newfptr } @@ -511,6 +945,8 @@ ci :: Int -> CInt ci = fromIntegral +-- @c_memset target count fill@.+-- Note that we use /nonstandard/ argument order! foreign import ccall unsafe "bm.h c_memset"    c_memset :: Ptr Word8 -> Int -> Word8 -> IO () @@ -519,6 +955,8 @@ foreign import ccall unsafe "bm.h c_memcpy"    c_memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO () +--------------------+ {- void c_extract_channel(   ( int k_type@@ -528,12 +966,94 @@   ); -} +-- offset is measured in components, not bytes! foreign import ccall unsafe "bm.h c_extract_channel"   c_extract_channel -    :: CInt -    -> CInt -> CInt -    -> Ptr a -> CInt -> CInt -> CInt-    -> Ptr a -> CInt -> CInt -> CInt+    :: CInt              -- ^ component type+    -> CInt -> CInt      -- ^ width, height+    -> Ptr a -> CInt -> CInt -> CInt  -- ^ source, nchn, pad, offset+    -> Ptr a -> CInt -> CInt -> CInt  -- ^ target, nchn, pad, offset     -> IO ()-        ++--------------------+ +{-+void c_bilinear_resample_channel+  ( int k_type+  , int width1, int height1, void *p1, int nchn1, int pad1, int ofs1 +  , int width2, int height2, void *p2, int nchn2, int pad2, int ofs2 +  );       +-}++-- offset is measured in components, not bytes!+foreign import ccall unsafe "bm.h c_bilinear_resample_channel"+  c_bilinear_resample_channel +    :: CInt                                           -- ^ component type+    -> CInt -> CInt -> Ptr a -> CInt -> CInt -> CInt  -- ^ width, height, source, nchn, pad, offset+    -> CInt -> CInt -> Ptr a -> CInt -> CInt -> CInt  -- ^ width, height, target, nchn, pad, offset+    -> IO ()++--------------------++{-+void c_gamma_correct_channel+  ( int k_type+  , float gamma+  , int width, int height+  , void *p1, int nchn1, int pad1, int ofs1 +  , void *p2, int nchn2, int pad2, int ofs2 +  );+  +void c_gamma_correct_all_channels+  ( int k_type+  , float gamma+  , int width, int height, int nchn+  , void *p1, int pad1 +  , void *p2, int pad2 +  );+-}+ +-- offset is measured in components, not bytes!+foreign import ccall unsafe "bm.h c_gamma_correct_channel"+  c_gamma_correct_channel +    :: CInt              -- ^ component type+    -> CFloat            -- ^ gamma+    -> CInt -> CInt      -- ^ width, height+    -> Ptr a -> CInt -> CInt -> CInt  -- ^ source, nchn, pad, offset+    -> Ptr a -> CInt -> CInt -> CInt  -- ^ target, nchn, pad, offset+    -> IO ()++foreign import ccall unsafe "bm.h c_gamma_correct_all_channels"+  c_gamma_correct_all_channels +    :: CInt                 -- ^ component type+    -> CFloat               -- ^ gamma+    -> CInt -> CInt -> CInt -- ^ width, height, nchn+    -> Ptr a -> CInt        -- ^ source, pad+    -> Ptr a -> CInt        -- ^ target, pad+    -> IO ()++--------------------+    +{-+void c_linear_combine_channels+  ( int k_type+  , float weight1, float weight2+  , int width, int height+  , void *p1, int nchn1, int pad1, int ofs1 +  , void *p2, int nchn2, int pad2, int ofs2 +  , void *p3, int nchn3, int pad3, int ofs3 +  );    +-}++-- offset is measured in components, not bytes!+foreign import ccall unsafe "bm.h c_linear_combine_channels"+  c_linear_combine_channels +    :: CInt              -- ^ component type+    -> CFloat -> CFloat  -- ^ weight1, weight2 +    -> CInt -> CInt      -- ^ width, height+    -> Ptr a -> CInt -> CInt -> CInt  -- ^ source1, nchn, pad, offset+    -> Ptr a -> CInt -> CInt -> CInt  -- ^ source2, nchn, pad, offset+    -> Ptr a -> CInt -> CInt -> CInt  -- ^ target,  nchn, pad, offset+    -> IO ()+ --------------------------------------------------------------------------------

@@ -1,7 +1,7 @@  -------------------------------------------------------------------------------- -- Module      : Data.Bitmap.Internal--- Version     : 0.0.0+-- Version     : 0.0.1 -- License     : BSD3 -- Copyright   : (c) 2009 Balazs Komuves -- Author      : Balazs Komuves@@ -33,10 +33,19 @@   | PctFloat   deriving Show   +pixelComponentSize :: PixelComponentType -> Int+pixelComponentSize pct = case pct of+  PctWord8  -> 1 +  PctWord16 -> 2 +  PctWord32 -> 4 +  PctFloat  -> 4 +  +--------------------------------------------------------------------------------+ class (Num t, Storable t) => PixelComponent t where   c_type :: t -> CInt-  nbytes :: t -> Int-  nbytes x = sizeOf x+--  nbytes :: t -> Int+--  nbytes x = sizeOf x   toFloat   :: t -> Float   fromFloat :: Float -> t   @@ -46,26 +55,44 @@   2 -> PctWord16   3 -> PctWord32   4 -> PctFloat++-- hmm hmm let's hope ghc will inline this into an +-- inlined function if i explicitely ask for it... +{-# INLINE clamp #-}+clamp :: Float -> Float+clamp = min 1 . max 0   instance PixelComponent Word8 where +  {-# SPECIALIZE instance PixelComponent Word8  #-}   c_type _ = 1-  fromFloat = floor . (*255.99999)+  fromFloat = floor . (+0.5) . (*255) . min 1 . max 0   toFloat = (*3.92156862745098e-3) . fromIntegral     -- 1/255  instance PixelComponent Word16 where +  {-# SPECIALIZE instance PixelComponent Word16 #-}   c_type _ = 2-  fromFloat = floor . (*65535.99999)+  fromFloat = floor . (+0.5) . (*65535) . min 1 . max 0   toFloat = (*1.5259021896696422e-5) . fromIntegral   -- 1/65535  instance PixelComponent Word32 where +  {-# SPECIALIZE instance PixelComponent Word32 #-}   c_type _ = 3-  fromFloat = floor . (*4294967295.99999)+  fromFloat = floor . (+0.5) . (*4294967295) . min 1 . max 0   toFloat = (*2.3283064370807974e-10) . fromIntegral  -- 1/(2^32-1)    instance PixelComponent Float where +  {-# SPECIALIZE instance PixelComponent Float  #-}   c_type _ = 4-  toFloat = id   fromFloat = id+  toFloat = id++--------------------------------------------------------------------------------++{-# SPECIALIZE isValidAlignment :: Int -> Bool #-}+isValidAlignment :: Integral a => a -> Bool+isValidAlignment a = elem a [1,2,4,8,16]++--------------------------------------------------------------------------------    -- to provide better documentation type Size   = (Int,Int)@@ -101,5 +128,23 @@ bitmapSizeInBytes bm = h*x where   x = bitmapPaddedRowSizeInBytes bm   (_,h) = bitmapSize bm  + +-- | The width divided by the height.+bitmapAspect :: Fractional a => Bitmap t -> a+bitmapAspect bm = (fromIntegral x / fromIntegral y) where+  (x,y) = bitmapSize bm +--------------------------------------------------------------------------------++-- we mimic the OpenGL padding at the moment+recommendedPadding :: forall t. PixelComponent t => Bitmap t -> Int+recommendedPadding bm = pad where+  (w,_) = bitmapSize bm+  n = bitmapNChannels bm+  b = bitmapRowAlignment bm+  s = sizeOf (undefined::t)+  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 )    +   --------------------------------------------------------------------------------

@@ -1,7 +1,7 @@  -------------------------------------------------------------------------------- -- Module      : Data.Bitmap.Pure--- Version     : 0.0.0+-- Version     : 0.0.1 -- License     : BSD3 -- Copyright   : (c) 2009 Balazs Komuves -- Author      : Balazs Komuves@@ -16,7 +16,9 @@   (      module Data.Bitmap.Base     +    -- * Creating bitmaps   , emptyBitmap+  , createSingleChannelBitmap     -- * Mapping over bitmaps   , componentMap   , componentMap'@@ -27,6 +29,15 @@   , combineChannels    , extractChannels    , extractSingleChannel +    -- * Bilinear resampling+  , bilinearResample+  , bilinearResampleChannel  +    -- * Blending+  , blendBitmaps  +  , blendChannels  +    -- * Gamma correction+  , powerlawGammaCorrection+  , powerlawGammaCorrectionChannel        -- * Conversion to ByteString   , bitmapToByteString     ) @@ -62,13 +73,24 @@   -> Bitmap t emptyBitmap siz nchn malign = unsafePerformIO $ IO.newBitmap siz nchn malign +-- | Creates a single channel bitmap from a function.+-- This is probably a bit slow.+createSingleChannelBitmap+  :: forall 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 $ +  IO.createSingleChannelBitmap siz maling fun + -------------------------------------------------------------------------------- --- | Warning: this is probably slow+-- | Warning: this is probably slow. componentMap :: PixelComponent s => (s -> s) -> Bitmap s -> Bitmap s componentMap f bm = unsafePerformIO $ IO.componentMap f bm --- | Warning: this is probably slow+-- | 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 @@ -113,10 +135,86 @@ combineChannels :: forall t. PixelComponent t => [Bitmap t] -> Maybe Alignment -> Bitmap t combineChannels bms malign = unsafePerformIO $   IO.combineChannels bms malign++--------------------------------------------------------------------------------++bilinearResample +  :: PixelComponent t +  => Bitmap t           -- ^ source image+  -> Size               -- ^ target image size+  -> Maybe Alignment    -- ^ target image row alignment+  -> Bitmap t  +bilinearResample bm siz malign = unsafePerformIO $ +  IO.bilinearResample bm siz malign++bilinearResampleChannel+  :: PixelComponent t +  => Bitmap t           -- ^ source image+  -> Int                -- ^ source channel indexe+  -> Size               -- ^ target image size+  -> Maybe Alignment    -- ^ target image row alignment+  -> Bitmap t  +bilinearResampleChannel bm j siz malign = unsafePerformIO $ +  IO.bilinearResampleChannel bm j siz malign    -------------------------------------------------------------------------------- --- | Note that the data is /shared/.+-- | 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+  -> Maybe Alignment -- ^ target alignment+  -> Bitmap t+blendBitmaps w1 w2 bm1 bm2 malign = unsafePerformIO $ +  IO.blendBitmaps w1 w2 bm1 bm2 malign++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+  -> Maybe Alignment -- ^ target alignment+  -> Bitmap t+blendChannels w1 w2 bm1 ofs1 bm2 ofs2 malign = unsafePerformIO $ +  IO.blendChannels w1 w2 bm1 ofs1 bm2 ofs2 malign+  +--------------------------------------------------------------------------------+  +-- | 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+  -> Maybe Alignment    -- ^ target image row alignment+  -> Bitmap t  +powerlawGammaCorrection gamma bm malign = unsafePerformIO $ +  IO.powerlawGammaCorrection gamma bm malign++powerlawGammaCorrectionChannel+  :: PixelComponent t +  => Float              -- ^ gamma+  -> Bitmap t           -- ^ source image+  -> Int                -- ^ source channel indexe+  -> Maybe Alignment    -- ^ target image row alignment+  -> Bitmap t  +powerlawGammaCorrectionChannel gamma bm j malign = unsafePerformIO $ +  IO.powerlawGammaCorrectionChannel gamma 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

@@ -1,5 +1,5 @@ Name:                bitmap-Version:             0.0.0+Version:             0.0.1 Synopsis:            A library for handling and manipulating bitmaps. Description:         A library for handling and manipulating bitmaps (that is,                      rectangular pixel arrays).@@ -22,10 +22,10 @@  Library   if flag(base4)-    Build-Depends:   base >= 4 && < 5, array, containers, bytestring >= 0.9+    Build-Depends:   base >= 4 && < 5, bytestring >= 0.9     cpp-options:     -DBASE_VERSION=4   else-    Build-Depends:   base >= 3 && < 4, array, containers, bytestring >= 0.9+    Build-Depends:   base >= 3 && < 4, bytestring >= 0.9     cpp-options:     -DBASE_VERSION=3        Exposed-Modules:     Data.Bitmap,

@@ -2,18 +2,31 @@ /* the C part of the Data.Bitmap library (c) 2009 Balazs Komuves+license: BSD3 */ +#include <stdlib.h> #include <string.h>+#include <math.h>+ #include "bm.h"  // -----------------------------------------------------------------------------++#if __STDC_VERSION__ >= 199901L+/* "inline" is a keyword */+#else+#define inline /* nothing */+#endif++// -----------------------------------------------------------------------------  +// (to, count, fill) !!!  void c_memset(word8 *q, int count, word8 x) { memset(q,x,count); } -// (from, to, count)+// (from, to, count) !!! void c_memcpy(word8 *p, word8 *q, int count) { memcpy(q,p,count); }@@ -25,10 +38,27 @@ #define K_WORD32 3 #define K_FLOAT  4 -#define PLUSPTR(P,TYP,K) P=(TYP*)(((word8*)P)+K);+#define PLUSPTR(P,TYP,K) (TYP*)(((word8*)(P))+(K)); +#define MAX(A,B) (((A)>(B))?(A):(B))+#define MIN(A,B) (((A)<(B))?(A):(B))+#define CLAMP(X,A,B) MIN(MAX(X,A),B)+#define CLAMP_01(X) MIN(MAX(X,0),1)+ // ----------------------------------------------------------------------------- +inline float toFloat_word8  (word8  x) { return ( (float)x * (3.92156862745098e-3   ) ); }+inline float toFloat_word16 (word16 x) { return ( (float)x * (1.5259021896696422e-5 ) ); }+inline float toFloat_word32 (word32 x) { return ( (float)x * (2.3283064370807974e-10) ); }+inline float toFloat_float  (float  x) { return x; }++inline word8  fromFloat_word8  (float x) { return ( floor ( 0.5 + 255.0        * CLAMP_01(x) ) ); }+inline word16 fromFloat_word16 (float x) { return ( floor ( 0.5 + 65535.0      * CLAMP_01(x) ) ); }+inline word32 fromFloat_word32 (float x) { return ( floor ( 0.5 + 4294967295.0 * CLAMP_01(x) ) ); }+inline float  fromFloat_float  (float x) { return x; }++// -----------------------------------------------------------------------------+ #define C_EXTRACT_CHANNEL(TYP) \ void c_extract_channel_ ## TYP \   ( int width, int height \@@ -45,8 +75,8 @@       q1 += nchn1;  \       q2 += nchn2;  \     }               \-    PLUSPTR(q1,TYP,pad1); \-    PLUSPTR(q2,TYP,pad2); \+    q1 = PLUSPTR(q1,TYP,pad1); \+    q2 = PLUSPTR(q2,TYP,pad2); \   }   \ }  @@ -55,25 +85,279 @@ C_EXTRACT_CHANNEL(word32) C_EXTRACT_CHANNEL(float ) +#define CALL_EXTRACT_CHANNEL(TYP) \+c_extract_channel_ ## TYP ( width,height, p1,nchn1,pad1,ofs1, p2,nchn2,pad2,ofs2 );++// offset is measured in components, not bytes! void c_extract_channel   ( int k_type-  , int width, int height +  , int width, int height   , void *p1, int nchn1, int pad1, int ofs1    , void *p2, int nchn2, int pad2, int ofs2    )  { switch(k_type)-  { case K_WORD8: -      c_extract_channel_word8 ( width,height, p1,nchn1,pad1,ofs1, p2,nchn2,pad2,ofs2 );-      break;-    case K_WORD16: -      c_extract_channel_word16( width,height, p1,nchn1,pad1,ofs1, p2,nchn2,pad2,ofs2 );-      break;-    case K_WORD32: -      c_extract_channel_word32( width,height, p1,nchn1,pad1,ofs1, p2,nchn2,pad2,ofs2 );-      break;-    case K_FLOAT: -      c_extract_channel_float ( width,height, p1,nchn1,pad1,ofs1, p2,nchn2,pad2,ofs2 );-      break;+  { case K_WORD8:  CALL_EXTRACT_CHANNEL(word8 ); break;+    case K_WORD16: CALL_EXTRACT_CHANNEL(word16); break;+    case K_WORD32: CALL_EXTRACT_CHANNEL(word32); break;+    case K_FLOAT:  CALL_EXTRACT_CHANNEL(float ); break;   } }-     ++// -----------------------------------------------------------------------------++// hmm hmm nem jo meg, tullogunk a sorok vegen meg alul is :(++// it's a little bit hackish, but i think that's ok +void interpolate_hack(int width1,int width2, int x, float *fx, int *ix)+{ float t,f;+  int j;+  t = ((float)x+0.5) * ((float)width1) / ((float)width2) - 0.5;  +  j = floor(t);+  f = t-j;+  if ( j < 0 )+  { *ix = 0;+    *fx = 0.0;+  }+  else+  { if ( j > (width1-2) )+    { *ix = width1-2;+      *fx = 1.0;+    }+    else+    { *ix = j;+      *fx = f;+    }+  }+}++// should we ask haskell for allocating the memory for the tables instead of malloc?+#define C_BILINEAR_RESAMPLE_CHANNEL(TYP) \+void c_bilinear_resample_channel_ ## TYP  \+  ( int width1, int height1, TYP *p1, int nchn1, int pad1, int ofs1 \+  , int width2, int height2, TYP *p2, int nchn2, int pad2, int ofs2 \+  )                        \+{ int x,y;                 \+  TYP *q2,*s1,*s2,*r1,*r2; \+  float fx,fy;             \+  int ix,iy;               \+  int linesize1;           \+  float *fhoriztable;      \+  int   *ihoriztable;      \+  float a,b,c;             \+                  \+  q2 = p2 + ofs2; \+  linesize1 = nchn1 * width1 * sizeof(TYP) + pad1; \+                                                   \+  fhoriztable = malloc(sizeof(float)*width2);      \+  ihoriztable = malloc(sizeof(int  )*width2);      \+  for(x=0;x<width2;x++)    \+  { interpolate_hack( width1,width2, x, fhoriztable+x, ihoriztable+x); \+    ihoriztable[x] *= sizeof(TYP) * nchn1; /* !!! */                   \+  }                        \+                           \+  for(y=0;y<height2;y++)   \+  { interpolate_hack( height1,height2, y, &fy, &iy );   \+    s1 = PLUSPTR ( p1 + ofs1 , TYP , iy * linesize1 );  \+    s2 = PLUSPTR ( s1        , TYP ,      linesize1 );  \+    for(x=0;x<width2;x++)      \+    { fx = fhoriztable[x];     \+      ix = ihoriztable[x];     \+      r1 = PLUSPTR ( s1, TYP, ix ); /* we multiplied up during precalc! */ \+      r2 = PLUSPTR ( s2, TYP, ix ); \+      a = (1-fx) * (float)(r1[0]) + fx * (float)(r1[nchn1]); \+      b = (1-fx) * (float)(r2[0]) + fx * (float)(r2[nchn1]); \+      c = (1-fy)*a + fy*b;   \+      *q2 = (TYP)c;   /* round? but what about the floats? */ \+      q2 += nchn2;        \+    }                     \+    q2 = PLUSPTR(q2,TYP,pad2); \+  }                  \+  free(ihoriztable); \+  free(fhoriztable); \+} ++C_BILINEAR_RESAMPLE_CHANNEL(word8 )+C_BILINEAR_RESAMPLE_CHANNEL(word16)+C_BILINEAR_RESAMPLE_CHANNEL(word32)+C_BILINEAR_RESAMPLE_CHANNEL(float )++#define CALL_BILINEAR_RESAMPLE_CHANNEL(TYP) \+c_bilinear_resample_channel_ ## TYP ( width1,height1,p1,nchn1,pad1,ofs1, width2,height2,p2,nchn2,pad2,ofs2 );++// offset is measured in components, not bytes!+void c_bilinear_resample_channel+  ( int k_type+  , int width1, int height1, void *p1, int nchn1, int pad1, int ofs1 +  , int width2, int height2, void *p2, int nchn2, int pad2, int ofs2 +  ) +{ switch(k_type)+  { case K_WORD8:  CALL_BILINEAR_RESAMPLE_CHANNEL(word8 ); break; +    case K_WORD16: CALL_BILINEAR_RESAMPLE_CHANNEL(word16); break;  +    case K_WORD32: CALL_BILINEAR_RESAMPLE_CHANNEL(word32); break; +    case K_FLOAT:  CALL_BILINEAR_RESAMPLE_CHANNEL(float ); break; +  }+}++// -----------------------------------------------------------------------------++#define GAMMA_CORRECT_COMPONENT(TYP,value,gamma) \+  fromFloat_ ## TYP ( exp ( (gamma) * log ( 0.0000001 + toFloat_ ## TYP ( (value) ) ) ) )++#define C_GAMMA_CORRECT_CHANNEL(TYP) \+void c_gamma_correct_channel_ ## TYP \+  ( float gamma           \+  , int width, int height \+  , TYP *p1, int nchn1, int pad1, int ofs1 \+  , TYP *p2, int nchn2, int pad2, int ofs2 \+  ) \+{ int x,y;        \+  TYP *q1,*q2;    \+  q1 = p1 + ofs1; \+  q2 = p2 + ofs2; \+  for(y=0;y<height;y++)   \+  { for(x=0;x<width;x++)  \+    { *q2 = GAMMA_CORRECT_COMPONENT (TYP , *q1 , gamma);    \+      q1 += nchn1;  \+      q2 += nchn2;  \+    }               \+    q1 = PLUSPTR(q1,TYP,pad1); \+    q2 = PLUSPTR(q2,TYP,pad2); \+  }   \+} ++C_GAMMA_CORRECT_CHANNEL(word8 )+C_GAMMA_CORRECT_CHANNEL(word16)+C_GAMMA_CORRECT_CHANNEL(word32)+C_GAMMA_CORRECT_CHANNEL(float )++#define C_GAMMA_CORRECT_ALL_CHANNELS(TYP) \+void c_gamma_correct_all_channels_ ## TYP \+  ( float gamma                     \+  , int width, int height, int nchn \+  , TYP *p1, int pad1 \+  , TYP *p2, int pad2 \+  ) \+{ int x,y;          \+  int compsPerLine; \+  TYP *q1,*q2;      \+  q1 = p1;   \+  q2 = p2;   \+  compsPerLine = width * nchn; \+  for(y=0;y<height;y++)   \+  { for(x=0;x<compsPerLine;x++)  \+    { *q2 = GAMMA_CORRECT_COMPONENT (TYP , *q1 , gamma);    \+      q1 ++ ;  \+      q2 ++ ;  \+    }               \+    q1 = PLUSPTR(q1,TYP,pad1); \+    q2 = PLUSPTR(q2,TYP,pad2); \+  }   \+} ++C_GAMMA_CORRECT_ALL_CHANNELS(word8 )+C_GAMMA_CORRECT_ALL_CHANNELS(word16)+C_GAMMA_CORRECT_ALL_CHANNELS(word32)+C_GAMMA_CORRECT_ALL_CHANNELS(float )++#define CALL_GAMMA_CORRECT_CHANNEL(TYP) \+c_gamma_correct_channel_ ## TYP ( gamma, width,height, p1,nchn1,pad1,ofs1, p2,nchn2,pad2,ofs2 );++// offset is measured in components, not bytes!+void c_gamma_correct_channel+  ( int k_type+  , float gamma+  , int width, int height+  , void *p1, int nchn1, int pad1, int ofs1 +  , void *p2, int nchn2, int pad2, int ofs2 +  ) +{ switch(k_type)+  { case K_WORD8:  CALL_GAMMA_CORRECT_CHANNEL(word8 ); break; +    case K_WORD16: CALL_GAMMA_CORRECT_CHANNEL(word16); break;  +    case K_WORD32: CALL_GAMMA_CORRECT_CHANNEL(word32); break; +    case K_FLOAT:  CALL_GAMMA_CORRECT_CHANNEL(float ); break; +  }+}++#define CALL_GAMMA_CORRECT_ALL_CHANNELS(TYP) \+c_gamma_correct_all_channels_ ## TYP ( gamma, width,height, nchn, p1,pad1, p2,pad2 );++// offset is measured in components, not bytes!+void c_gamma_correct_all_channels+  ( int k_type+  , float gamma+  , int width, int height, int nchn+  , void *p1, int pad1 +  , void *p2, int pad2 +  ) +{ switch(k_type)+  { case K_WORD8:  CALL_GAMMA_CORRECT_ALL_CHANNELS(word8 ); break; +    case K_WORD16: CALL_GAMMA_CORRECT_ALL_CHANNELS(word16); break;  +    case K_WORD32: CALL_GAMMA_CORRECT_ALL_CHANNELS(word32); break; +    case K_FLOAT:  CALL_GAMMA_CORRECT_ALL_CHANNELS(float ); break; +  }+}++// -----------------------------------------------------------------------------+++#define LINEAR_COMBINE_COMPONENT(TYP,value1,value2,weight1,weight2) \+  fromFloat_ ## TYP ( weight1 * toFloat_ ## TYP (value1) +  weight2 * toFloat_ ## TYP (value2) ) +  +#define C_LINEAR_COMBINE_CHANNELS(TYP) \+void c_linear_combine_channels_ ## TYP \+  ( float weight1, float weight2       \+  , int width, int height \+  , TYP *p1, int nchn1, int pad1, int ofs1 \+  , TYP *p2, int nchn2, int pad2, int ofs2 \+  , TYP *p3, int nchn3, int pad3, int ofs3 \+  ) \+{ int x,y;         \+  TYP *q1,*q2,*q3; \+  q1 = p1 + ofs1;  \+  q2 = p2 + ofs2;  \+  q3 = p3 + ofs3;  \+  for(y=0;y<height;y++)   \+  { for(x=0;x<width;x++)  \+    { *q3 = LINEAR_COMBINE_COMPONENT (TYP , *q1 , *q2 , weight1 , weight2);    \+      q1 += nchn1;  \+      q2 += nchn2;  \+      q3 += nchn3;  \+    }               \+    q1 = PLUSPTR(q1,TYP,pad1); \+    q2 = PLUSPTR(q2,TYP,pad2); \+    q3 = PLUSPTR(q3,TYP,pad3); \+  }   \+} ++C_LINEAR_COMBINE_CHANNELS(word8 )+C_LINEAR_COMBINE_CHANNELS(word16)+C_LINEAR_COMBINE_CHANNELS(word32)+C_LINEAR_COMBINE_CHANNELS(float )++#define CALL_LINEAR_COMBINE_CHANNELS(TYP) \+c_linear_combine_channels_ ## TYP         \+  ( weight1,weight2, width,height,        \+    p1,nchn1,pad1,ofs1,      \+    p2,nchn2,pad2,ofs2,      \+    p3,nchn3,pad3,ofs3 );++// offset is measured in components, not bytes!+void c_linear_combine_channels+  ( int k_type+  , float weight1, float weight2+  , int width, int height+  , void *p1, int nchn1, int pad1, int ofs1 +  , void *p2, int nchn2, int pad2, int ofs2 +  , void *p3, int nchn3, int pad3, int ofs3 +  ) +{ switch(k_type)+  { case K_WORD8:  CALL_LINEAR_COMBINE_CHANNELS(word8 ); break; +    case K_WORD16: CALL_LINEAR_COMBINE_CHANNELS(word16); break;  +    case K_WORD32: CALL_LINEAR_COMBINE_CHANNELS(word32); break; +    case K_FLOAT:  CALL_LINEAR_COMBINE_CHANNELS(float ); break; +  }+}++// -----------------------------------------------------------------------------++

@@ -7,6 +7,7 @@  //------------------------------------------------------------------------------ +// (target, count, fill) void c_memset(word8 *q, int count, word8 x);  // (from, to, count)@@ -20,3 +21,45 @@   , void *p1, int nchn1, int pad1, int ofs1    , void *p2, int nchn2, int pad2, int ofs2    );++//------------------------------------------------------------------------------++// offset is measured in components, not bytes!+void c_bilinear_resample_channel+  ( int k_type+  , int width1, int height1, void *p1, int nchn1, int pad1, int ofs1 +  , int width2, int height2, void *p2, int nchn2, int pad2, int ofs2 +  );++//------------------------------------------------------------------------------++void c_gamma_correct_channel+  ( int k_type+  , float gamma+  , int width, int height+  , void *p1, int nchn1, int pad1, int ofs1 +  , void *p2, int nchn2, int pad2, int ofs2 +  );+  +void c_gamma_correct_all_channels+  ( int k_type+  , float gamma+  , int width, int height, int nchn+  , void *p1, int pad1 +  , void *p2, int pad2 +  );++//------------------------------------------------------------------------------++// offset is measured in components, not bytes!+void c_linear_combine_channels+  ( int k_type+  , float weight1, float weight2+  , int width, int height+  , void *p1, int nchn1, int pad1, int ofs1 +  , void *p2, int nchn2, int pad2, int ofs2 +  , void *p3, int nchn3, int pad3, int ofs3 +  );+  +//------------------------------------------------------------------------------+