{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# CFILES cbits/bm.c #-}
module Data.Bitmap.IO
(
module Data.Bitmap.Base
, IOBitmap
, IOBitmapChannel
, unsafeFreezeBitmap
, unsafeThawBitmap
, emptyBitmap
, cloneBitmap
, emptyCloneBitmap
, createSingleChannelBitmap
, newIOBitmap
, newIOBitmapUninitialized
, copyBitmapFromPtr
, ioBitmapFromForeignPtrUnsafe
, withIOBitmap
, componentMap
, componentMap'
, componentMapInPlace
, copySubImage
, copySubImage'
, copySubImageInto
, flipBitmap
, flipBitmapInPlace
, mirrorBitmap
, mirrorBitmapInPlace
, castBitmap
, combineChannels
, extractChannels
, extractSingleChannel
, extractChannelInto
, bilinearResample
, bilinearResampleChannel
, bilinearResampleChannelInto
, blendBitmaps
, blendChannels
, blendChannelsInto
, powerlawGammaCorrection
, powerlawGammaCorrectionChannel
, powerlawGammaCorrectionChannelInto
)
where
import Control.Monad
import Control.Applicative
import Data.Word
import Data.List (nub)
import Foreign.C
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable
import Foreign.Marshal
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import Data.Bitmap.Internal
import Data.Bitmap.Base
unsafeFreezeBitmap :: IOBitmap t -> Bitmap t
unsafeFreezeBitmap :: IOBitmap t -> Bitmap t
unsafeFreezeBitmap = IOBitmap t -> Bitmap t
forall t. IOBitmap t -> Bitmap t
unIOBitmap
unsafeThawBitmap :: Bitmap t -> IOBitmap t
unsafeThawBitmap :: Bitmap t -> IOBitmap t
unsafeThawBitmap = Bitmap t -> IOBitmap t
forall t. Bitmap t -> IOBitmap t
IOBitmap
defaultAlignment :: Int
defaultAlignment :: Int
defaultAlignment = Int
4
validateMaybeAlignment :: Maybe Alignment -> Alignment
validateMaybeAlignment :: Maybe Int -> Int
validateMaybeAlignment = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
defaultAlignment Int -> Int
validateAlignment
validateAlignment :: Alignment -> Alignment
validateAlignment :: Int -> Int
validateAlignment Int
k =
if Int -> Bool
forall a. Integral a => a -> Bool
isValidAlignment Int
k
then Int
k
else [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid row alignment (allowed values: 1, 2, 4, and 8)"
allocBitmap :: PixelComponent t => Bitmap t -> IO (Bitmap t)
allocBitmap :: Bitmap t -> IO (Bitmap t)
allocBitmap Bitmap t
bm0 = do
ForeignPtr t
fptr <- Int -> IO (ForeignPtr t)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (Bitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapSizeInBytes Bitmap t
bm0)
Bitmap t -> IO (Bitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bitmap t -> IO (Bitmap t)) -> Bitmap t -> IO (Bitmap t)
forall a b. (a -> b) -> a -> b
$ Bitmap t
bm0 { _bitmapPtr :: ForeignPtr t
_bitmapPtr = ForeignPtr t
fptr }
allocIOBitmap :: PixelComponent t => IOBitmap t -> IO (IOBitmap t)
allocIOBitmap :: IOBitmap t -> IO (IOBitmap t)
allocIOBitmap IOBitmap t
bm = Bitmap t -> IOBitmap t
forall t. Bitmap t -> IOBitmap t
IOBitmap (Bitmap t -> IOBitmap t) -> IO (Bitmap t) -> IO (IOBitmap t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bitmap t -> IO (Bitmap t)
forall t. PixelComponent t => Bitmap t -> IO (Bitmap t)
allocBitmap (Bitmap t -> IO (Bitmap t)) -> Bitmap t -> IO (Bitmap t)
forall a b. (a -> b) -> a -> b
$ IOBitmap t -> Bitmap t
forall t. IOBitmap t -> Bitmap t
unIOBitmap IOBitmap t
bm)
newBitmapRaw :: PixelComponent t => Size -> NChn -> Padding -> Alignment -> IO (IOBitmap t)
newBitmapRaw :: Size -> Int -> Int -> Int -> IO (IOBitmap t)
newBitmapRaw Size
siz Int
nchn Int
pad Int
align = do
let bm0 :: Bitmap t
bm0 = Bitmap :: forall t. Size -> Int -> ForeignPtr t -> Int -> Int -> Bitmap t
Bitmap
{ _bitmapSize :: Size
_bitmapSize = Size
siz
, _bitmapNChannels :: Int
_bitmapNChannels = Int
nchn
, _bitmapPtr :: ForeignPtr t
_bitmapPtr = ForeignPtr t
forall a. HasCallStack => a
undefined
, _bitmapRowPadding :: Int
_bitmapRowPadding = Int
pad
, _bitmapRowAlignment :: Int
_bitmapRowAlignment = Int
align
}
Bitmap t -> IOBitmap t
forall t. Bitmap t -> IOBitmap t
IOBitmap (Bitmap t -> IOBitmap t) -> IO (Bitmap t) -> IO (IOBitmap t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bitmap t -> IO (Bitmap t)
forall t. PixelComponent t => Bitmap t -> IO (Bitmap t)
allocBitmap Bitmap t
forall t. Bitmap t
bm0
newIOBitmap
:: PixelComponent t
=> Size
-> NChn
-> Maybe Alignment
-> IO (IOBitmap t)
newIOBitmap :: Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmap Size
siz Int
nchn Maybe Int
malign = do
IOBitmap t
bm <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
nchn Maybe Int
malign
let fptr :: ForeignPtr t
fptr = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm
len :: Int
len = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapSizeInBytes IOBitmap t
bm
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
p -> Ptr Word8 -> Int -> Word8 -> IO ()
c_memset (Ptr t -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr t
p) Int
len Word8
0
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm
allocBitmapWithRecommendedPadding :: PixelComponent t => Bitmap t -> IO (Bitmap t)
allocBitmapWithRecommendedPadding :: Bitmap t -> IO (Bitmap t)
allocBitmapWithRecommendedPadding Bitmap t
bm0 =
Bitmap t -> IO (Bitmap t)
forall t. PixelComponent t => Bitmap t -> IO (Bitmap t)
allocBitmap (Bitmap t -> IO (Bitmap t)) -> Bitmap t -> IO (Bitmap t)
forall a b. (a -> b) -> a -> b
$
Bitmap t
bm0 { _bitmapRowPadding :: Int
_bitmapRowPadding = Bitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
recommendedPadding Bitmap t
bm0 }
newIOBitmapUninitialized :: PixelComponent t => Size -> NChn -> Maybe Alignment -> IO (IOBitmap t)
newIOBitmapUninitialized :: Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
nchn Maybe Int
malign = do
let align :: Int
align = Maybe Int -> Int
validateMaybeAlignment Maybe Int
malign
bm0 :: Bitmap t
bm0 = Bitmap :: forall t. Size -> Int -> ForeignPtr t -> Int -> Int -> Bitmap t
Bitmap
{ _bitmapSize :: Size
_bitmapSize = Size
siz
, _bitmapNChannels :: Int
_bitmapNChannels = Int
nchn
, _bitmapPtr :: ForeignPtr t
_bitmapPtr = ForeignPtr t
forall a. HasCallStack => a
undefined
, _bitmapRowPadding :: Int
_bitmapRowPadding = Int
forall a. HasCallStack => a
undefined
, _bitmapRowAlignment :: Int
_bitmapRowAlignment = Int
align
}
Bitmap t
bm <- Bitmap t -> IO (Bitmap t)
forall t. PixelComponent t => Bitmap t -> IO (Bitmap t)
allocBitmapWithRecommendedPadding Bitmap t
forall t. Bitmap t
bm0
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bitmap t -> IOBitmap t
forall t. Bitmap t -> IOBitmap t
IOBitmap Bitmap t
bm)
createSingleChannelBitmap
:: PixelComponent t
=> Size
-> Maybe Alignment
-> (Int -> Int -> t)
-> IO (IOBitmap t)
createSingleChannelBitmap :: Size -> Maybe Int -> (Int -> Int -> t) -> IO (IOBitmap t)
createSingleChannelBitmap Size
siz Maybe Int
malign Int -> Int -> t
fun = do
IOBitmap t
bm <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
1 Maybe Int
malign
let fptr :: ForeignPtr t
fptr = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm
len :: Int
len = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapSizeInBytes IOBitmap t
bm
f :: Int -> Int -> p -> t
f Int
x Int
y p
_ = Int -> Int -> t
fun Int
x Int
y
(Int -> Int -> t -> t) -> IOBitmap t -> IOBitmap t -> IO ()
forall s t.
(PixelComponent s, PixelComponent t) =>
(Int -> Int -> s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
genericComponentMapWithPos Int -> Int -> t -> t
forall p. Int -> Int -> p -> t
f IOBitmap t
bm IOBitmap t
bm
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm
copyBitmapFromPtr
:: PixelComponent t
=> Size
-> NChn
-> Padding
-> Ptr t
-> Maybe Alignment
-> IO (IOBitmap t)
copyBitmapFromPtr :: Size -> Int -> Int -> Ptr t -> Maybe Int -> IO (IOBitmap t)
copyBitmapFromPtr siz :: Size
siz@(Int
w,Int
h) Int
nchn Int
srcpad Ptr t
srcptr Maybe Int
tgtmalign = do
IOBitmap t
bm <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
nchn Maybe Int
tgtmalign
IOBitmap t -> (Size -> Int -> Int -> Ptr t -> IO ()) -> IO ()
forall t a.
PixelComponent t =>
IOBitmap t -> (Size -> Int -> Int -> Ptr t -> IO a) -> IO a
withIOBitmap IOBitmap t
bm ((Size -> Int -> Int -> Ptr t -> IO ()) -> IO ())
-> (Size -> Int -> Int -> Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Size
_ Int
_ Int
_ Ptr t
tgtptr -> do
let pure_line :: Int
pure_line = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapUnpaddedRowSizeInBytes IOBitmap t
bm
src_line :: Int
src_line = Int
pure_line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcpad
tgt_line :: Int
tgt_line = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
y -> do
let p :: Ptr t
p = Ptr t
srcptr Ptr t -> Int -> Ptr t
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
src_line)
q :: Ptr t
q = Ptr t
tgtptr Ptr t -> Int -> Ptr t
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
tgt_line)
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
c_memcpy (Ptr t -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr t
p) (Ptr t -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr t
q) Int
pure_line
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm
ioBitmapFromForeignPtrUnsafe
:: PixelComponent t
=> Size -> NChn -> Alignment -> Padding -> ForeignPtr t -> IOBitmap t
ioBitmapFromForeignPtrUnsafe :: Size -> Int -> Int -> Int -> ForeignPtr t -> IOBitmap t
ioBitmapFromForeignPtrUnsafe Size
siz Int
nchn Int
align Int
pad ForeignPtr t
fptr = Bitmap t -> IOBitmap t
forall t. Bitmap t -> IOBitmap t
IOBitmap (Bitmap t -> IOBitmap t) -> Bitmap t -> IOBitmap t
forall a b. (a -> b) -> a -> b
$
Size -> Int -> Int -> Int -> ForeignPtr t -> Bitmap t
forall t.
PixelComponent t =>
Size -> Int -> Int -> Int -> ForeignPtr t -> Bitmap t
bitmapFromForeignPtrUnsafe Size
siz Int
nchn Int
align Int
pad ForeignPtr t
fptr
withIOBitmap :: PixelComponent t => IOBitmap t -> (Size -> NChn -> Padding -> Ptr t -> IO a) -> IO a
withIOBitmap :: IOBitmap t -> (Size -> Int -> Int -> Ptr t -> IO a) -> IO a
withIOBitmap (IOBitmap Bitmap t
bm) Size -> Int -> Int -> Ptr t -> IO a
action =
ForeignPtr t -> (Ptr t -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Bitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr Bitmap t
bm) ((Ptr t -> IO a) -> IO a) -> (Ptr t -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr t
p ->
Size -> Int -> Int -> Ptr t -> IO a
action (Bitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize Bitmap t
bm) (Bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels Bitmap t
bm) (Bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding Bitmap t
bm) Ptr t
p
{-# SPECIALIZE genericComponentRowMap
:: (Int -> Int -> Ptr Word8 -> Ptr Word8 -> IO ()) -> IOBitmap Word8 -> IOBitmap Word8 -> IO () #-}
{-# SPECIALIZE genericComponentRowMap
:: (Int -> Int -> Ptr Word16 -> Ptr Word16 -> IO ()) -> IOBitmap Word16 -> IOBitmap Word16 -> IO () #-}
{-# SPECIALIZE genericComponentRowMap
:: (Int -> Int -> Ptr Word32 -> Ptr Word32 -> IO ()) -> IOBitmap Word32 -> IOBitmap Word32 -> IO () #-}
{-# SPECIALIZE genericComponentRowMap
:: (Int -> Int -> Ptr Float -> Ptr Float -> IO ()) -> IOBitmap Float -> IOBitmap Float -> IO () #-}
{-# SPECIALIZE genericComponentRowMap
:: (Int -> Int -> Ptr Word8 -> Ptr Float -> IO ()) -> IOBitmap Word8 -> IOBitmap Float -> IO () #-}
{-# SPECIALIZE genericComponentRowMap
:: (Int -> Int -> Ptr Float -> Ptr Word8 -> IO ()) -> IOBitmap Float -> IOBitmap Word8 -> IO () #-}
{-# SPECIALIZE genericComponentRowMap
:: (Int -> Int -> Ptr Word16 -> Ptr Float -> IO ()) -> IOBitmap Word16 -> IOBitmap Float -> IO () #-}
{-# SPECIALIZE genericComponentRowMap
:: (Int -> Int -> Ptr Float -> Ptr Word16 -> IO ()) -> IOBitmap Float -> IOBitmap Word16 -> IO () #-}
genericComponentRowMap
:: (PixelComponent s, PixelComponent t)
=> (Int -> Int -> Ptr s -> Ptr t -> IO ())
-> IOBitmap s -> IOBitmap t -> IO ()
genericComponentRowMap :: (Int -> Int -> Ptr s -> Ptr t -> IO ())
-> IOBitmap s -> IOBitmap t -> IO ()
genericComponentRowMap Int -> Int -> Ptr s -> Ptr t -> IO ()
rowAction IOBitmap s
bm1 IOBitmap t
bm2 = do
let (Int
w1,Int
h1) = IOBitmap s -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap s
bm1
pad1 :: Int
pad1 = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap s
bm1
nchn1 :: Int
nchn1 = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap s
bm1
fptr1 :: ForeignPtr s
fptr1 = IOBitmap s -> ForeignPtr s
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap s
bm1
xlen1 :: Int
xlen1 = IOBitmap s -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap s
bm1
let (Int
w2,Int
h2) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
pad2 :: Int
pad2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2
xlen2 :: Int
xlen2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm2
let minw :: Int
minw = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
w1 Int
w2
npc :: Int
npc = Int
nchn1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
minw
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nchn1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/genericRowMap: number of channels disagree"
ForeignPtr s -> (Ptr s -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr s
fptr1 ((Ptr s -> IO ()) -> IO ()) -> (Ptr s -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr s
ptr1 -> ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->
[(Int, Int, Int)] -> ((Int, Int, Int) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0..Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen1) [Int
0..Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])
((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen2) [Int
0..Int
h2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])) (((Int, Int, Int) -> IO ()) -> IO ())
-> ((Int, Int, Int) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
ypos,Int
vo1,Int
vo2) -> do
let p1 :: Ptr s
p1 = Ptr s
ptr1 Ptr s -> Int -> Ptr s
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` Int
vo1
p2 :: Ptr t
p2 = Ptr t
ptr2 Ptr t -> Int -> Ptr t
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` Int
vo2
Int -> Int -> Ptr s -> Ptr t -> IO ()
rowAction Int
ypos Int
npc Ptr s
p1 Ptr t
p2
genericPixelRowMap
:: (PixelComponent s, PixelComponent t)
=> (Int -> Int -> Ptr s -> NChn -> Ptr t -> NChn -> IO ())
-> IOBitmap s -> IOBitmap t -> IO ()
genericPixelRowMap :: (Int -> Int -> Ptr s -> Int -> Ptr t -> Int -> IO ())
-> IOBitmap s -> IOBitmap t -> IO ()
genericPixelRowMap Int -> Int -> Ptr s -> Int -> Ptr t -> Int -> IO ()
rowAction IOBitmap s
bm1 IOBitmap t
bm2 = do
let (Int
w1,Int
h1) = IOBitmap s -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap s
bm1
pad1 :: Int
pad1 = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap s
bm1
nchn1 :: Int
nchn1 = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap s
bm1
fptr1 :: ForeignPtr s
fptr1 = IOBitmap s -> ForeignPtr s
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap s
bm1
xlen1 :: Int
xlen1 = IOBitmap s -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap s
bm1
let (Int
w2,Int
h2) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
pad2 :: Int
pad2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2
xlen2 :: Int
xlen2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm2
let minw :: Int
minw = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
w1 Int
w2
ForeignPtr s -> (Ptr s -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr s
fptr1 ((Ptr s -> IO ()) -> IO ()) -> (Ptr s -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr s
ptr1 -> ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->
[(Int, Int, Int)] -> ((Int, Int, Int) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0..Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen1) [Int
0..Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])
((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen2) [Int
0..Int
h2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])) (((Int, Int, Int) -> IO ()) -> IO ())
-> ((Int, Int, Int) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
ypos,Int
o1,Int
o2) -> do
let p1 :: Ptr s
p1 = Ptr s
ptr1 Ptr s -> Int -> Ptr s
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` Int
o1
p2 :: Ptr t
p2 = Ptr t
ptr2 Ptr t -> Int -> Ptr t
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` Int
o2
Int -> Int -> Ptr s -> Int -> Ptr t -> Int -> IO ()
rowAction Int
ypos Int
minw Ptr s
p1 Int
nchn1 Ptr t
p2 Int
nchn2
{-# SPECIALIZE genericComponentMap :: (Word8 -> Word8 ) -> IOBitmap Word8 -> IOBitmap Word8 -> IO () #-}
{-# SPECIALIZE genericComponentMap :: (Word16 -> Word16) -> IOBitmap Word16 -> IOBitmap Word16 -> IO () #-}
{-# SPECIALIZE genericComponentMap :: (Word32 -> Word32) -> IOBitmap Word32 -> IOBitmap Word32 -> IO () #-}
{-# SPECIALIZE genericComponentMap :: (Float -> Float ) -> IOBitmap Float -> IOBitmap Float -> IO () #-}
{-# SPECIALIZE genericComponentMap :: (Word8 -> Float ) -> IOBitmap Word8 -> IOBitmap Float -> IO () #-}
{-# SPECIALIZE genericComponentMap :: (Float -> Word8 ) -> IOBitmap Float -> IOBitmap Word8 -> IO () #-}
{-# SPECIALIZE genericComponentMap :: (Word16 -> Float ) -> IOBitmap Word16 -> IOBitmap Float -> IO () #-}
{-# SPECIALIZE genericComponentMap :: (Float -> Word16) -> IOBitmap Float -> IOBitmap Word16 -> IO () #-}
genericComponentMap
:: (PixelComponent s, PixelComponent t)
=> (s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
genericComponentMap :: (s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
genericComponentMap s -> t
f IOBitmap s
bm1 IOBitmap t
bm2 = (Int -> Int -> Ptr s -> Ptr t -> IO ())
-> IOBitmap s -> IOBitmap t -> IO ()
forall s t.
(PixelComponent s, PixelComponent t) =>
(Int -> Int -> Ptr s -> Ptr t -> IO ())
-> IOBitmap s -> IOBitmap t -> IO ()
genericComponentRowMap Int -> Int -> Ptr s -> Ptr t -> IO ()
forall p p. (Num p, Enum p) => p -> p -> Ptr s -> Ptr t -> IO ()
g IOBitmap s
bm1 IOBitmap t
bm2 where
h :: (Ptr s, Ptr t) -> p -> IO (Ptr s, Ptr t)
h (Ptr s
q1,Ptr t
q2) p
_ = do
s
x <- Ptr s -> IO s
forall a. Storable a => Ptr a -> IO a
peek Ptr s
q1
Ptr t -> t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr t
q2 (s -> t
f s
x)
(Ptr s, Ptr t) -> IO (Ptr s, Ptr t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr s -> Ptr s
forall a. Storable a => Ptr a -> Ptr a
advancePtr1 Ptr s
q1, Ptr t -> Ptr t
forall a. Storable a => Ptr a -> Ptr a
advancePtr1 Ptr t
q2)
g :: p -> p -> Ptr s -> Ptr t -> IO ()
g p
ypos p
n Ptr s
p1 Ptr t
p2 = do
((Ptr s, Ptr t) -> p -> IO (Ptr s, Ptr t))
-> (Ptr s, Ptr t) -> [p] -> IO ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ (Ptr s, Ptr t) -> p -> IO (Ptr s, Ptr t)
forall p. (Ptr s, Ptr t) -> p -> IO (Ptr s, Ptr t)
h (Ptr s
p1,Ptr t
p2) [p
0..p
np -> p -> p
forall a. Num a => a -> a -> a
-p
1]
{-# SPECIALIZE genericComponentMapWithPos :: (Int -> Int -> Word8 -> Word8 ) -> IOBitmap Word8 -> IOBitmap Word8 -> IO () #-}
{-# SPECIALIZE genericComponentMapWithPos :: (Int -> Int -> Word16 -> Word16) -> IOBitmap Word16 -> IOBitmap Word16 -> IO () #-}
{-# SPECIALIZE genericComponentMapWithPos :: (Int -> Int -> Word32 -> Word32) -> IOBitmap Word32 -> IOBitmap Word32 -> IO () #-}
{-# SPECIALIZE genericComponentMapWithPos :: (Int -> Int -> Float -> Float ) -> IOBitmap Float -> IOBitmap Float -> IO () #-}
genericComponentMapWithPos
:: (PixelComponent s, PixelComponent t)
=> (Int -> Int -> s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
genericComponentMapWithPos :: (Int -> Int -> s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
genericComponentMapWithPos Int -> Int -> s -> t
f IOBitmap s
bm1 IOBitmap t
bm2 = (Int -> Int -> Ptr s -> Ptr t -> IO ())
-> IOBitmap s -> IOBitmap t -> IO ()
forall s t.
(PixelComponent s, PixelComponent t) =>
(Int -> Int -> Ptr s -> Ptr t -> IO ())
-> IOBitmap s -> IOBitmap t -> IO ()
genericComponentRowMap Int -> Int -> Ptr s -> Ptr t -> IO ()
g IOBitmap s
bm1 IOBitmap t
bm2 where
h :: Int -> (Ptr s, Ptr t) -> Int -> IO (Ptr s, Ptr t)
h Int
ypos (Ptr s
q1,Ptr t
q2) Int
xpos = do
s
x <- Ptr s -> IO s
forall a. Storable a => Ptr a -> IO a
peek Ptr s
q1
Ptr t -> t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr t
q2 (Int -> Int -> s -> t
f Int
xpos Int
ypos s
x)
(Ptr s, Ptr t) -> IO (Ptr s, Ptr t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr s -> Ptr s
forall a. Storable a => Ptr a -> Ptr a
advancePtr1 Ptr s
q1, Ptr t -> Ptr t
forall a. Storable a => Ptr a -> Ptr a
advancePtr1 Ptr t
q2)
g :: Int -> Int -> Ptr s -> Ptr t -> IO ()
g Int
ypos Int
n Ptr s
p1 Ptr t
p2 = do
((Ptr s, Ptr t) -> Int -> IO (Ptr s, Ptr t))
-> (Ptr s, Ptr t) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ (Int -> (Ptr s, Ptr t) -> Int -> IO (Ptr s, Ptr t)
h Int
ypos) (Ptr s
p1,Ptr t
p2) [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
componentMap :: PixelComponent s => (s -> s) -> IOBitmap s -> IO (IOBitmap s)
componentMap :: (s -> s) -> IOBitmap s -> IO (IOBitmap s)
componentMap s -> s
f IOBitmap s
bm1 = do
let siz :: Size
siz = IOBitmap s -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap s
bm1
nchn :: Int
nchn = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap s
bm1
align :: Int
align = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowAlignment IOBitmap s
bm1
IOBitmap s
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap s)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
nchn (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
align)
(s -> s) -> IOBitmap s -> IOBitmap s -> IO ()
forall s t.
(PixelComponent s, PixelComponent t) =>
(s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
genericComponentMap s -> s
f IOBitmap s
bm1 IOBitmap s
bm2
IOBitmap s -> IO (IOBitmap s)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap s
bm2
componentMapInPlace :: PixelComponent s => (s -> s) -> IOBitmap s -> IO ()
componentMapInPlace :: (s -> s) -> IOBitmap s -> IO ()
componentMapInPlace s -> s
f IOBitmap s
bm = do
(s -> s) -> IOBitmap s -> IOBitmap s -> IO ()
forall s t.
(PixelComponent s, PixelComponent t) =>
(s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
genericComponentMap s -> s
f IOBitmap s
bm IOBitmap s
bm
componentMap'
:: (PixelComponent s, PixelComponent t)
=> (s -> t)
-> IOBitmap s
-> Maybe Alignment
-> IO (IOBitmap t)
componentMap' :: (s -> t) -> IOBitmap s -> Maybe Int -> IO (IOBitmap t)
componentMap' s -> t
f IOBitmap s
bm1 Maybe Int
malign = do
let siz :: Size
siz = IOBitmap s -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap s
bm1
nchn :: Int
nchn = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap s
bm1
x :: Int
x = IOBitmap s -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap s
bm1
IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
nchn Maybe Int
malign
(s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
forall s t.
(PixelComponent s, PixelComponent t) =>
(s -> t) -> IOBitmap s -> IOBitmap t -> IO ()
genericComponentMap s -> t
f IOBitmap s
bm1 IOBitmap t
bm2
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
cloneBitmap
:: PixelComponent t
=> IOBitmap t
-> Maybe Alignment
-> IO (IOBitmap t)
cloneBitmap :: IOBitmap t -> Maybe Int -> IO (IOBitmap t)
cloneBitmap IOBitmap t
bm1 Maybe Int
malign = do
let siz1 :: Size
siz1@(Int
w1,Int
h1) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
pad1 :: Int
pad1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1
xlen1 :: Int
xlen1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm1
IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz1 Int
nchn1 Maybe Int
malign
let fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2
xlen2 :: Int
xlen2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm2
let len1 :: Int
len1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapUnpaddedRowSizeInBytes IOBitmap t
bm1
len2 :: Int
len2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapUnpaddedRowSizeInBytes IOBitmap t
bm2
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 ->
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
let p :: Ptr b
p = Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr t
ptr1 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen1)
q :: Ptr b
q = Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr t
ptr2 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen2)
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
c_memcpy Ptr Word8
forall b. Ptr b
p Ptr Word8
forall b. Ptr b
q Int
len1
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
emptyCloneBitmap
:: PixelComponent t
=> IOBitmap t
-> Maybe Alignment
-> IO (IOBitmap t)
emptyCloneBitmap :: IOBitmap t -> Maybe Int -> IO (IOBitmap t)
emptyCloneBitmap IOBitmap t
bm1 Maybe Int
malign = do
let siz1 :: Size
siz1 = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz1 Int
nchn1 Maybe Int
malign
let fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2
n :: Int
n = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapSizeInBytes IOBitmap t
bm2
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 -> do
Ptr Word8 -> Int -> Word8 -> IO ()
c_memset (Ptr t -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr t
ptr2 :: Ptr Word8) Int
n Word8
0
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
emptyBitmap
:: PixelComponent t
=> Size
-> NChn
-> Maybe Alignment
-> IO (IOBitmap t)
emptyBitmap :: Size -> Int -> Maybe Int -> IO (IOBitmap t)
emptyBitmap = Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmap
copySubImage
:: PixelComponent t
=> IOBitmap t
-> Offset
-> Size
-> IO (IOBitmap t)
copySubImage :: IOBitmap t -> Size -> Size -> IO (IOBitmap t)
copySubImage IOBitmap t
bm Size
ofs1 Size
siz1 = IOBitmap t -> Size -> Size -> Size -> Size -> IO (IOBitmap t)
forall t.
PixelComponent t =>
IOBitmap t -> Size -> Size -> Size -> Size -> IO (IOBitmap t)
copySubImage' IOBitmap t
bm Size
ofs1 Size
siz1 Size
siz1 (Int
0,Int
0)
copySubImage'
:: PixelComponent t
=> IOBitmap t
-> Offset
-> Size
-> Size
-> Offset
-> IO (IOBitmap t)
copySubImage' :: IOBitmap t -> Size -> Size -> Size -> Size -> IO (IOBitmap t)
copySubImage' IOBitmap t
bm1 Size
ofs1 Size
rsiz Size
tsiz Size
ofs2 = do
let align :: Int
align = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowAlignment IOBitmap t
bm1
nchn :: Int
nchn = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmap Size
tsiz Int
nchn (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
align)
IOBitmap t -> Size -> Size -> IOBitmap t -> Size -> IO ()
forall t.
PixelComponent t =>
IOBitmap t -> Size -> Size -> IOBitmap t -> Size -> IO ()
copySubImageInto IOBitmap t
bm1 Size
ofs1 Size
rsiz IOBitmap t
bm2 Size
ofs2
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
copySubImageInto
:: PixelComponent t
=> IOBitmap t
-> Offset
-> Size
-> IOBitmap t
-> Offset
-> IO ()
copySubImageInto :: IOBitmap t -> Size -> Size -> IOBitmap t -> Size -> IO ()
copySubImageInto IOBitmap t
bm1 ofs1 :: Size
ofs1@(Int
o1x0,Int
o1y0) siz1 :: Size
siz1@(Int
sx0,Int
sy0) IOBitmap t
bm2 ofs2 :: Size
ofs2@(Int
o2x0,Int
o2y0) = do
let (Int
bm1xs,Int
bm1ys) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
pad1 :: Int
pad1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
align1 :: Int
align1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowAlignment IOBitmap t
bm1
nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
pixsiz1 :: Int
pixsiz1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPixelSizeInBytes IOBitmap t
bm1
fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1
xlen1 :: Int
xlen1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm1
let (Int
bm2xs,Int
bm2ys) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
pad2 :: Int
pad2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
align2 :: Int
align2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowAlignment IOBitmap t
bm2
nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
pixsiz2 :: Int
pixsiz2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPixelSizeInBytes IOBitmap t
bm2
fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2
xlen2 :: Int
xlen2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm2
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nchn1Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/copySubImageInto: number of channels disagree"
let (Int
o1x1,Int
sx1,Int
o2x1) = if Int
o1x0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then (Int
o1x0, Int
sx0, Int
o2x0) else (Int
0, Int
sx0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o1x0, Int
o2x0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o1x0)
(Int
o1y1,Int
sy1,Int
o2y1) = if Int
o1y0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then (Int
o1y0, Int
sy0, Int
o2y0) else (Int
0, Int
sy0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o1y0, Int
o2y0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o1y0)
(Int
o1x ,Int
sx ,Int
o2x ) = if Int
o2x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then (Int
o1x1, Int
sx1, Int
o2x1) else (Int
o1x1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o2x1, Int
sx1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o2x1, Int
0)
(Int
o1y ,Int
sy ,Int
o2y ) = if Int
o2y1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then (Int
o1y1, Int
sy1, Int
o2y1) else (Int
o1y1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
o2y1, Int
sy1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o2y1, Int
0)
let xs :: Int
xs = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [ Int
sx , (Int
bm1xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o1x) , (Int
bm2xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o2x) ]
ys :: Int
ys = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [ Int
sy , (Int
bm1ys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o1y) , (Int
bm2ys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o2y) ]
pixsiz :: Int
pixsiz = Int
pixsiz1
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
xsInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 Bool -> Bool -> Bool
&& Int
ysInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1' -> ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2' -> do
let ptr1 :: Ptr t
ptr1 = Ptr t
ptr1' Ptr t -> Int -> Ptr t
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` (Int
pixsizInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
o1x)
ptr2 :: Ptr t
ptr2 = Ptr t
ptr2' Ptr t -> Int -> Ptr t
forall a. Ptr a -> Int -> Ptr a
`myPlusPtr` (Int
pixsizInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
o2x)
nbytes :: Int
nbytes = Int
pixsizInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xs
[Size] -> (Size -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Int] -> [Size]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen1) [Int
o1y..Int
o1yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ysInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])
((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen2) [Int
o2y..Int
o2yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ysInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])) ((Size -> IO ()) -> IO ()) -> (Size -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
vo1,Int
vo2) -> do
let p1 :: Ptr b
p1 = Ptr t
ptr1 Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
vo1
p2 :: Ptr b
p2 = Ptr t
ptr2 Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
vo2
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
c_memcpy Ptr Word8
forall b. Ptr b
p1 Ptr Word8
forall b. Ptr b
p2 Int
nbytes
castBitmap
:: (PixelComponent s, PixelComponent t)
=> IOBitmap s
-> Maybe Alignment
-> IO (IOBitmap t)
castBitmap :: IOBitmap s -> Maybe Int -> IO (IOBitmap t)
castBitmap IOBitmap s
bm1 Maybe Int
malign = do
let nchn1 :: Int
nchn1 = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap s
bm1
siz1 :: Size
siz1@(Int
w,Int
h) = IOBitmap s -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap s
bm1
pad1 :: Int
pad1 = IOBitmap s -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap s
bm1
fptr1 :: ForeignPtr s
fptr1 = IOBitmap s -> ForeignPtr s
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap s
bm1
IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz1 Int
nchn1 Maybe Int
malign
let pad2 :: Int
pad2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2
ForeignPtr s -> (Ptr s -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr s
fptr1 ((Ptr s -> IO ()) -> IO ()) -> (Ptr s -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr s
ptr1 ->
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->
CInt
-> CInt
-> CInt
-> CInt
-> Ptr s
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> IO ()
forall a b.
CInt
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> Ptr b
-> CInt
-> CInt
-> CInt
-> IO ()
c_cast_bitmap
(IOBitmap s -> CInt
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> CInt
bitmapCType IOBitmap s
bm1) (IOBitmap t -> CInt
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> CInt
bitmapCType IOBitmap t
bm2)
(Int -> CInt
ci Int
w) (Int -> CInt
ci Int
h)
Ptr s
ptr1 (Int -> CInt
ci Int
nchn1) (Int -> CInt
ci Int
pad1) CInt
0
Ptr t
ptr2 (Int -> CInt
ci Int
nchn1) (Int -> CInt
ci Int
pad2) CInt
0
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
_flipBitmapInto
:: PixelComponent t
=> IOBitmap t
-> IOBitmap t
-> IO ()
_flipBitmapInto :: IOBitmap t -> IOBitmap t -> IO ()
_flipBitmapInto IOBitmap t
bm1 IOBitmap t
bm2 = do
let siz1 :: Size
siz1@(Int
w1,Int
h1) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
pad1 :: Int
pad1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1
xlen1 :: Int
xlen1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm1
let siz2 :: Size
siz2@(Int
w2,Int
h2) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
pad2 :: Int
pad2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2
xlen2 :: Int
xlen2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm2
let len1 :: Int
len1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapUnpaddedRowSizeInBytes IOBitmap t
bm1
len2 :: Int
len2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapUnpaddedRowSizeInBytes IOBitmap t
bm2
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ( Size
siz1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz2 Bool -> Bool -> Bool
|| Int
nchn1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nchn2 Bool -> Bool -> Bool
|| Int
len1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
len2 ) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"_flipBitmapInto"
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 ->
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->
if Ptr t
ptr1 Ptr t -> Ptr t -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr t
ptr2
then do
Int -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
len1 ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
tmp -> do
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..(Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
h1 Int
2)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
let j :: Int
j = Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i
p1 :: Ptr b
p1 = Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr t
ptr1 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen1)
q1 :: Ptr b
q1 = Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr t
ptr1 (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen1)
p2 :: Ptr b
p2 = Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr t
ptr2 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen2)
q2 :: Ptr b
q2 = Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr t
ptr2 (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen2)
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
c_memcpy Ptr Word8
forall b. Ptr b
p1 Ptr Word8
tmp Int
len1
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
c_memcpy Ptr Word8
forall b. Ptr b
q1 Ptr Word8
forall b. Ptr b
p2 Int
len1
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
c_memcpy Ptr Word8
tmp Ptr Word8
forall b. Ptr b
q2 Int
len1
else do
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
let j :: Int
j = Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i
p :: Ptr b
p = Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr t
ptr1 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen1)
q :: Ptr b
q = Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr t
ptr2 (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen2)
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
c_memcpy Ptr Word8
forall b. Ptr b
p Ptr Word8
forall b. Ptr b
q Int
len1
flipBitmap
:: PixelComponent t
=> IOBitmap t
-> Maybe Alignment
-> IO (IOBitmap t)
flipBitmap :: IOBitmap t -> Maybe Int -> IO (IOBitmap t)
flipBitmap IOBitmap t
bm1 Maybe Int
malign = do
let nchn :: Int
nchn = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
siz :: Size
siz@(Int
w,Int
h) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
nchn Maybe Int
malign
IOBitmap t -> IOBitmap t -> IO ()
forall t. PixelComponent t => IOBitmap t -> IOBitmap t -> IO ()
_flipBitmapInto IOBitmap t
bm1 IOBitmap t
bm2
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
flipBitmapInPlace
:: PixelComponent t
=> IOBitmap t
-> IO ()
flipBitmapInPlace :: IOBitmap t -> IO ()
flipBitmapInPlace IOBitmap t
bm = do
IOBitmap t -> IOBitmap t -> IO ()
forall t. PixelComponent t => IOBitmap t -> IOBitmap t -> IO ()
_flipBitmapInto IOBitmap t
bm IOBitmap t
bm
_mirrorBitmapInto
:: PixelComponent t
=> IOBitmap t
-> IOBitmap t
-> IO ()
_mirrorBitmapInto :: IOBitmap t -> IOBitmap t -> IO ()
_mirrorBitmapInto IOBitmap t
bm1 IOBitmap t
bm2 = do
let siz1 :: Size
siz1@(Int
w1,Int
h1) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
pad1 :: Int
pad1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1
xlen1 :: Int
xlen1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm1
let siz2 :: Size
siz2@(Int
w2,Int
h2) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
pad2 :: Int
pad2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2
xlen2 :: Int
xlen2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes IOBitmap t
bm2
let len1 :: Int
len1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapUnpaddedRowSizeInBytes IOBitmap t
bm1
len2 :: Int
len2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapUnpaddedRowSizeInBytes IOBitmap t
bm2
bpp1 :: Int
bpp1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPixelSizeInBytes IOBitmap t
bm1
bpp2 :: Int
bpp2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPixelSizeInBytes IOBitmap t
bm2
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ( Size
siz1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz2 Bool -> Bool -> Bool
|| Int
nchn1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nchn2 Bool -> Bool -> Bool
|| Int
len1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
len2 Bool -> Bool -> Bool
|| Int
bpp1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
bpp2 ) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"_mirrorBitmapInto"
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 ->
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
let p :: Ptr b
p = Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr t
ptr1 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen1)
q :: Ptr b
q = Ptr t -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr t
ptr2 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
xlen2)
CInt -> CInt -> Ptr Any -> Ptr Any -> IO ()
forall a. CInt -> CInt -> Ptr a -> Ptr a -> IO ()
c_mirror_line (Int -> CInt
ci Int
w1) (Int -> CInt
ci Int
bpp1) Ptr Any
forall b. Ptr b
p Ptr Any
forall b. Ptr b
q
mirrorBitmap
:: PixelComponent t
=> IOBitmap t
-> Maybe Alignment
-> IO (IOBitmap t)
mirrorBitmap :: IOBitmap t -> Maybe Int -> IO (IOBitmap t)
mirrorBitmap IOBitmap t
bm1 Maybe Int
malign = do
let nchn :: Int
nchn = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
siz :: Size
siz@(Int
w,Int
h) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
nchn Maybe Int
malign
IOBitmap t -> IOBitmap t -> IO ()
forall t. PixelComponent t => IOBitmap t -> IOBitmap t -> IO ()
_mirrorBitmapInto IOBitmap t
bm1 IOBitmap t
bm2
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
mirrorBitmapInPlace
:: PixelComponent t
=> IOBitmap t
-> IO ()
mirrorBitmapInPlace :: IOBitmap t -> IO ()
mirrorBitmapInPlace IOBitmap t
bm = do
IOBitmap t -> IOBitmap t -> IO ()
forall t. PixelComponent t => IOBitmap t -> IOBitmap t -> IO ()
_mirrorBitmapInto IOBitmap t
bm IOBitmap t
bm
extractSingleChannel
:: PixelComponent t
=> IOBitmap t
-> Maybe Alignment
-> Int
-> IO (IOBitmap t)
IOBitmap t
bm1 Maybe Int
malign Int
j = do
let nchn :: Int
nchn = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
siz :: Size
siz@(Int
w,Int
h) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/extractSingleChannel: invalid channel index"
IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
1 Maybe Int
malign
IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
forall t.
PixelComponent t =>
IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
extractChannelInto IOBitmap t
bm1 Int
j IOBitmap t
bm2 Int
0
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
extractChannels :: PixelComponent t => IOBitmap t -> Maybe Alignment -> IO [IOBitmap t]
IOBitmap t
bm Maybe Int
malign =
(Int -> IO (IOBitmap t)) -> [Int] -> IO [IOBitmap t]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (IOBitmap t -> Maybe Int -> Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
IOBitmap t -> Maybe Int -> Int -> IO (IOBitmap t)
extractSingleChannel IOBitmap t
bm Maybe Int
malign) [Int
0..Int
nchnInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
where nchn :: Int
nchn = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm
combineChannels :: PixelComponent t => [IOBitmap t] -> Maybe Alignment -> IO (IOBitmap t)
combineChannels :: [IOBitmap t] -> Maybe Int -> IO (IOBitmap t)
combineChannels [] Maybe Int
_ = [Char] -> IO (IOBitmap t)
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/combineChannels: no channel data"
combineChannels [IOBitmap t]
bms Maybe Int
malign = do
let sizes :: [Size]
sizes = (IOBitmap t -> Size) -> [IOBitmap t] -> [Size]
forall a b. (a -> b) -> [a] -> [b]
map IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize [IOBitmap t]
bms
nchns :: [Int]
nchns = (IOBitmap t -> Int) -> [IOBitmap t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels [IOBitmap t]
bms
pixsizs :: [Int]
pixsizs = (IOBitmap t -> Int) -> [IOBitmap t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map IOBitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPixelSizeInBytes [IOBitmap t]
bms
sumchn :: Int
sumchn = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
nchns
siz :: Size
siz@(Int
w,Int
h) = [Size] -> Size
forall a. [a] -> a
head [Size]
sizes
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Size] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Size] -> [Size]
forall a. Eq a => [a] -> [a]
nub [Size]
sizes) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/combineChannels: incompatible sizes"
IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz Int
sumchn Maybe Int
malign
let pad2 :: Int
pad2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2
let loop :: [(IOBitmap t, Int)]
loop = (IOBitmap t -> [(IOBitmap t, Int)])
-> [IOBitmap t] -> [(IOBitmap t, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\IOBitmap t
bm -> [IOBitmap t] -> [Int] -> [(IOBitmap t, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (IOBitmap t -> [IOBitmap t]
forall a. a -> [a]
repeat IOBitmap t
bm) [Int
0..IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]) [IOBitmap t]
bms
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 -> do
[(Int, (IOBitmap t, Int))]
-> ((Int, (IOBitmap t, Int)) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [(IOBitmap t, Int)] -> [(Int, (IOBitmap t, Int))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(IOBitmap t, Int)]
loop) (((Int, (IOBitmap t, Int)) -> IO ()) -> IO ())
-> ((Int, (IOBitmap t, Int)) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
i,(IOBitmap t
bm1,Int
j)) -> do
let pad1 :: Int
pad1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1
nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 ->
CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> IO ()
forall a.
CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> IO ()
c_extract_channel
(IOBitmap t -> CInt
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> CInt
bitmapCType ([IOBitmap t] -> IOBitmap t
forall a. [a] -> a
head [IOBitmap t]
bms))
(Int -> CInt
ci Int
w) (Int -> CInt
ci Int
h)
Ptr t
ptr1 (Int -> CInt
ci Int
nchn1) (Int -> CInt
ci Int
pad1) (Int -> CInt
ci Int
j)
Ptr t
ptr2 (Int -> CInt
ci Int
sumchn) (Int -> CInt
ci Int
pad2) (Int -> CInt
ci Int
i)
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
extractChannelInto
:: PixelComponent t
=> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IO ()
IOBitmap t
bm1 Int
ofs1 IOBitmap t
bm2 Int
ofs2 = do
let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
siz1 :: Size
siz1@(Int
w,Int
h) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
pad1 :: Int
pad1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1
let nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
siz2 :: Size
siz2 = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
pad2 :: Int
pad2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Size
siz1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/extractChannelInto: incompatible dimensions"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/extractChannelInto: invalid source channel index"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/extractChannelInto: invalid target channel index"
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 ->
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->
CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> IO ()
forall a.
CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> IO ()
c_extract_channel
(IOBitmap t -> CInt
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> CInt
bitmapCType IOBitmap t
bm1)
(Int -> CInt
ci Int
w) (Int -> CInt
ci Int
h)
Ptr t
ptr1 (Int -> CInt
ci Int
nchn1) (Int -> CInt
ci Int
pad1) (Int -> CInt
ci Int
ofs1)
Ptr t
ptr2 (Int -> CInt
ci Int
nchn2) (Int -> CInt
ci Int
pad2) (Int -> CInt
ci Int
ofs2)
bilinearResample
:: PixelComponent t
=> IOBitmap t
-> Size
-> Maybe Alignment
-> IO (IOBitmap t)
bilinearResample :: IOBitmap t -> Size -> Maybe Int -> IO (IOBitmap t)
bilinearResample IOBitmap t
bm1 siz2 :: Size
siz2@(Int
w2,Int
h2) Maybe Int
malign = do
let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz2 Int
nchn1 Maybe Int
malign
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
nchn1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
ofs ->
IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
forall t.
PixelComponent t =>
IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
bilinearResampleChannelInto IOBitmap t
bm1 Int
ofs IOBitmap t
bm2 Int
ofs
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
bilinearResampleChannel
:: PixelComponent t
=> IOBitmap t
-> Int
-> Size
-> Maybe Alignment
-> IO (IOBitmap t)
bilinearResampleChannel :: IOBitmap t -> Int -> Size -> Maybe Int -> IO (IOBitmap t)
bilinearResampleChannel IOBitmap t
bm1 Int
ofs1 siz2 :: Size
siz2@(Int
w2,Int
h2) Maybe Int
malign = do
let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/bilinearResampleChannel: invalid channel index"
IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz2 Int
1 Maybe Int
malign
IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
forall t.
PixelComponent t =>
IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
bilinearResampleChannelInto IOBitmap t
bm1 Int
ofs1 IOBitmap t
bm2 Int
0
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
bilinearResampleChannelInto
:: PixelComponent t
=> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IO ()
bilinearResampleChannelInto :: IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
bilinearResampleChannelInto IOBitmap t
bm1 Int
ofs1 IOBitmap t
bm2 Int
ofs2 = do
let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
siz1 :: Size
siz1@(Int
w1,Int
h1) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
pad1 :: Int
pad1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1
let nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
siz2 :: Size
siz2@(Int
w2,Int
h2) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
pad2 :: Int
pad2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/bilinearResampleChannelInto: invalid source channel index"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/bilinearResampleChannelInto: invalid target channel index"
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 ->
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->
CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> IO ()
forall a.
CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> IO ()
c_bilinear_resample_channel
(t -> CInt
forall t. PixelComponent t => t -> CInt
c_type (IOBitmap t -> t
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> t
bitmapUndefined IOBitmap t
bm1))
(Int -> CInt
ci Int
w1) (Int -> CInt
ci Int
h1) Ptr t
ptr1 (Int -> CInt
ci Int
nchn1) (Int -> CInt
ci Int
pad1) (Int -> CInt
ci Int
ofs1)
(Int -> CInt
ci Int
w2) (Int -> CInt
ci Int
h2) Ptr t
ptr2 (Int -> CInt
ci Int
nchn2) (Int -> CInt
ci Int
pad2) (Int -> CInt
ci Int
ofs2)
powerlawGammaCorrection
:: PixelComponent t
=> Float
-> IOBitmap t
-> Maybe Alignment
-> IO (IOBitmap t)
powerlawGammaCorrection :: Float -> IOBitmap t -> Maybe Int -> IO (IOBitmap t)
powerlawGammaCorrection Float
gamma IOBitmap t
bm1 Maybe Int
malign = do
let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
siz1 :: Size
siz1@(Int
w1,Int
h1) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
pad1 :: Int
pad1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1
IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz1 Int
nchn1 Maybe Int
malign
let pad2 :: Int
pad2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 ->
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->
CInt
-> CFloat
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> Ptr t
-> CInt
-> IO ()
forall a.
CInt
-> CFloat
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> Ptr a
-> CInt
-> IO ()
c_gamma_correct_all_channels
(t -> CInt
forall t. PixelComponent t => t -> CInt
c_type (IOBitmap t -> t
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> t
bitmapUndefined IOBitmap t
bm1))
(Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
gamma)
(Int -> CInt
ci Int
w1) (Int -> CInt
ci Int
h1) (Int -> CInt
ci Int
nchn1)
Ptr t
ptr1 (Int -> CInt
ci Int
pad1)
Ptr t
ptr2 (Int -> CInt
ci Int
pad2)
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
powerlawGammaCorrectionChannel
:: PixelComponent t
=> Float
-> IOBitmap t
-> Int
-> Maybe Alignment
-> IO (IOBitmap t)
powerlawGammaCorrectionChannel :: Float -> IOBitmap t -> Int -> Maybe Int -> IO (IOBitmap t)
powerlawGammaCorrectionChannel Float
gamma IOBitmap t
bm1 Int
ofs1 Maybe Int
malign = do
let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
siz1 :: Size
siz1 = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/powerlawGammaCorrectionChannel: invalid channel index"
IOBitmap t
bm2 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz1 Int
1 Maybe Int
malign
Float -> IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
forall t.
PixelComponent t =>
Float -> IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
powerlawGammaCorrectionChannelInto Float
gamma IOBitmap t
bm1 Int
ofs1 IOBitmap t
bm2 Int
0
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm2
powerlawGammaCorrectionChannelInto
:: PixelComponent t
=> Float
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IO ()
powerlawGammaCorrectionChannelInto :: Float -> IOBitmap t -> Int -> IOBitmap t -> Int -> IO ()
powerlawGammaCorrectionChannelInto Float
gamma IOBitmap t
bm1 Int
ofs1 IOBitmap t
bm2 Int
ofs2 = do
let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
siz1 :: Size
siz1@(Int
w1,Int
h1) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
pad1 :: Int
pad1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1
let nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
siz2 :: Size
siz2@(Int
w2,Int
h2) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
pad2 :: Int
pad2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Size
siz1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/powerlawGammaCorrectionChannelInto: incompatible dimensions"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/powerlawGammaCorrectionChannelInto: invalid source channel index"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/powerlawGammaCorrectionChannelInto: invalid target channel index"
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 ->
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->
CInt
-> CFloat
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> IO ()
forall a.
CInt
-> CFloat
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> IO ()
c_gamma_correct_channel
(t -> CInt
forall t. PixelComponent t => t -> CInt
c_type (IOBitmap t -> t
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> t
bitmapUndefined IOBitmap t
bm1))
(Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
gamma)
(Int -> CInt
ci Int
w1) (Int -> CInt
ci Int
h1)
Ptr t
ptr1 (Int -> CInt
ci Int
nchn1) (Int -> CInt
ci Int
pad1) (Int -> CInt
ci Int
ofs1)
Ptr t
ptr2 (Int -> CInt
ci Int
nchn2) (Int -> CInt
ci Int
pad2) (Int -> CInt
ci Int
ofs2)
blendBitmaps
:: PixelComponent t
=> Float
-> Float
-> IOBitmap t
-> IOBitmap t
-> Maybe Alignment
-> IO (IOBitmap t)
blendBitmaps :: Float
-> Float
-> IOBitmap t
-> IOBitmap t
-> Maybe Int
-> IO (IOBitmap t)
blendBitmaps Float
weight1 Float
weight2 IOBitmap t
bm1 IOBitmap t
bm2 Maybe Int
malign = do
let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
siz1 :: Size
siz1 = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
let nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
siz2 :: Size
siz2 = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Size
siz1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz2 ) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blend: incompatible dimensions"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nchn1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blend: incompatible number of channels"
IOBitmap t
bm3 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz1 Int
nchn1 Maybe Int
malign
[Int] -> (Int -> IO ()) -> IO [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..Int
nchn1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO ()) -> IO [()]) -> (Int -> IO ()) -> IO [()]
forall a b. (a -> b) -> a -> b
$ \Int
ofs ->
Float
-> Float
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IO ()
forall t.
PixelComponent t =>
Float
-> Float
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IO ()
blendChannelsInto Float
weight1 Float
weight2 IOBitmap t
bm1 Int
ofs IOBitmap t
bm2 Int
ofs IOBitmap t
bm3 Int
ofs
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm3
blendChannels
:: PixelComponent t
=> Float
-> Float
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> Maybe Alignment
-> IO (IOBitmap t)
blendChannels :: Float
-> Float
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> Maybe Int
-> IO (IOBitmap t)
blendChannels Float
weight1 Float
weight2 IOBitmap t
bm1 Int
ofs1 IOBitmap t
bm2 Int
ofs2 Maybe Int
malign = do
let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
siz1 :: Size
siz1 = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
let nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
siz2 :: Size
siz2 = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Size
siz1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannels: incompatible dimensions"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannels: invalid channel index"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannels: invalid channel index"
IOBitmap t
bm3 <- Size -> Int -> Maybe Int -> IO (IOBitmap t)
forall t.
PixelComponent t =>
Size -> Int -> Maybe Int -> IO (IOBitmap t)
newIOBitmapUninitialized Size
siz1 Int
1 Maybe Int
malign
Float
-> Float
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IO ()
forall t.
PixelComponent t =>
Float
-> Float
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IO ()
blendChannelsInto Float
weight1 Float
weight2 IOBitmap t
bm1 Int
ofs1 IOBitmap t
bm2 Int
ofs2 IOBitmap t
bm3 Int
0
IOBitmap t -> IO (IOBitmap t)
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitmap t
bm3
blendChannelsInto
:: PixelComponent t
=> Float
-> Float
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IO ()
blendChannelsInto :: Float
-> Float
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IOBitmap t
-> Int
-> IO ()
blendChannelsInto Float
weight1 Float
weight2 IOBitmap t
bm1 Int
ofs1 IOBitmap t
bm2 Int
ofs2 IOBitmap t
bm3 Int
ofs3 = do
let nchn1 :: Int
nchn1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm1
siz1 :: Size
siz1@(Int
w1,Int
h1) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm1
pad1 :: Int
pad1 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm1
fptr1 :: ForeignPtr t
fptr1 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm1
let nchn2 :: Int
nchn2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm2
siz2 :: Size
siz2@(Int
w2,Int
h2) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm2
pad2 :: Int
pad2 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm2
fptr2 :: ForeignPtr t
fptr2 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm2
let nchn3 :: Int
nchn3 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels IOBitmap t
bm3
siz3 :: Size
siz3@(Int
w3,Int
h3) = IOBitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize IOBitmap t
bm3
pad3 :: Int
pad3 = IOBitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding IOBitmap t
bm3
fptr3 :: ForeignPtr t
fptr3 = IOBitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr IOBitmap t
bm3
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Size
siz1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannelInto: incompatible dimensions"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Size
siz2 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
/= Size
siz3) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannelInto: incompatible dimensions"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannelInto: invalid source channel index 1"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannelInto: invalid source channel index 2"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ofs3Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
ofs3Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nchn3) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"bitmap/blendChannelInto: invalid target channel index"
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr1 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr1 ->
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr2 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr2 ->
ForeignPtr t -> (Ptr t -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr t
fptr3 ((Ptr t -> IO ()) -> IO ()) -> (Ptr t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr3 ->
CInt
-> CFloat
-> CFloat
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> Ptr t
-> CInt
-> CInt
-> CInt
-> IO ()
forall a.
CInt
-> CFloat
-> CFloat
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> Ptr a
-> CInt
-> CInt
-> CInt
-> IO ()
c_linear_combine_channels
(IOBitmap t -> CInt
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> CInt
bitmapCType IOBitmap t
bm1)
(Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
weight1) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
weight2)
(Int -> CInt
ci Int
w1) (Int -> CInt
ci Int
h1)
Ptr t
ptr1 (Int -> CInt
ci Int
nchn1) (Int -> CInt
ci Int
pad1) (Int -> CInt
ci Int
ofs1)
Ptr t
ptr2 (Int -> CInt
ci Int
nchn2) (Int -> CInt
ci Int
pad2) (Int -> CInt
ci Int
ofs2)
Ptr t
ptr3 (Int -> CInt
ci Int
nchn3) (Int -> CInt
ci Int
pad3) (Int -> CInt
ci Int
ofs3)
ptrUndefined :: Ptr a -> a
ptrUndefined :: Ptr a -> a
ptrUndefined Ptr a
_ = a
forall a. HasCallStack => a
undefined
{-# SPECIALIZE advancePtr1 :: Ptr Word8 -> Ptr Word8 #-}
{-# SPECIALIZE advancePtr1 :: Ptr Float -> Ptr Float #-}
advancePtr1 :: Storable a => Ptr a -> Ptr a
advancePtr1 :: Ptr a -> Ptr a
advancePtr1 Ptr a
p = Ptr a
p Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (a -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr a -> a
forall a. Ptr a -> a
ptrUndefined Ptr a
p))
{-# SPECIALIZE myPlusPtr :: Ptr Word8 -> Int -> Ptr Word8 #-}
{-# SPECIALIZE myPlusPtr :: Ptr Float -> Int -> Ptr Float #-}
myPlusPtr :: Ptr a -> Int -> Ptr a
myPlusPtr :: Ptr a -> Int -> Ptr a
myPlusPtr = Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
plusPtr
ci :: Int -> CInt
ci :: Int -> CInt
ci = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral
foreign import ccall unsafe "bm.h c_memset"
c_memset :: Ptr Word8 -> Int -> Word8 -> IO ()
foreign import ccall unsafe "bm.h c_memcpy"
c_memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
foreign import ccall unsafe "bm.h c_mirror_line"
c_mirror_line
:: CInt
-> CInt
-> Ptr a
-> Ptr a
-> IO ()
foreign import ccall unsafe "bm.h c_cast_bitmap"
c_cast_bitmap
:: CInt -> CInt
-> CInt -> CInt
-> Ptr a -> CInt -> CInt -> CInt
-> Ptr b -> CInt -> CInt -> CInt
-> IO ()
foreign import ccall unsafe "bm.h c_extract_channel"
:: CInt
-> CInt -> CInt
-> Ptr a -> CInt -> CInt -> CInt
-> Ptr a -> CInt -> CInt -> CInt
-> IO ()
foreign import ccall unsafe "bm.h c_bilinear_resample_channel"
c_bilinear_resample_channel
:: CInt
-> CInt -> CInt -> Ptr a -> CInt -> CInt -> CInt
-> CInt -> CInt -> Ptr a -> CInt -> CInt -> CInt
-> IO ()
foreign import ccall unsafe "bm.h c_gamma_correct_channel"
c_gamma_correct_channel
:: CInt
-> CFloat
-> CInt -> CInt
-> Ptr a -> CInt -> CInt -> CInt
-> Ptr a -> CInt -> CInt -> CInt
-> IO ()
foreign import ccall unsafe "bm.h c_gamma_correct_all_channels"
c_gamma_correct_all_channels
:: CInt
-> CFloat
-> CInt -> CInt -> CInt
-> Ptr a -> CInt
-> Ptr a -> CInt
-> IO ()
foreign import ccall unsafe "bm.h c_linear_combine_channels"
c_linear_combine_channels
:: CInt
-> CFloat -> CFloat
-> CInt -> CInt
-> Ptr a -> CInt -> CInt -> CInt
-> Ptr a -> CInt -> CInt -> CInt
-> Ptr a -> CInt -> CInt -> CInt
-> IO ()