module Data.Bitmap.Internal where
import Control.Monad
import Data.Word
import Foreign
import Foreign.C
data PixelComponentType
= PctWord8
| PctWord16
| PctWord32
| PctFloat
deriving Show
pixelComponentSize :: PixelComponentType -> Int
pixelComponentSize pct = case pct of
PctWord8 -> 1
PctWord16 -> 2
PctWord32 -> 4
PctFloat -> 4
class (Num t, Storable t) => PixelComponent t where
c_type :: t -> CInt
toFloat :: t -> Float
fromFloat :: Float -> t
pixelComponentType :: PixelComponent t => t -> PixelComponentType
pixelComponentType t = case c_type t of
1 -> PctWord8
2 -> PctWord16
3 -> PctWord32
4 -> PctFloat
clamp :: Float -> Float
clamp = min 1 . max 0
instance PixelComponent Word8 where
c_type _ = 1
fromFloat = floor . (+0.5) . (*255) . min 1 . max 0
toFloat = (*3.92156862745098e-3) . fromIntegral
instance PixelComponent Word16 where
c_type _ = 2
fromFloat = floor . (+0.5) . (*65535) . min 1 . max 0
toFloat = (*1.5259021896696422e-5) . fromIntegral
instance PixelComponent Word32 where
c_type _ = 3
fromFloat = floor . (+0.5) . (*4294967295) . min 1 . max 0
toFloat = (*2.3283064370807974e-10) . fromIntegral
instance PixelComponent Float where
c_type _ = 4
fromFloat = id
toFloat = id
isValidAlignment :: Integral a => a -> Bool
isValidAlignment a = elem a [1,2,4,8,16]
type Size = (Int,Int)
type Offset = (Int,Int)
type NChn = Int
type Padding = Int
type Alignment = Int
data Bitmap t = Bitmap
{ bitmapSize :: Size
, bitmapNChannels :: NChn
, bitmapPtr :: ForeignPtr t
, bitmapRowPadding :: Padding
, bitmapRowAlignment :: Alignment
}
deriving Show
bitmapComponentSizeInBytes :: forall t. PixelComponent t => Bitmap t -> Int
bitmapComponentSizeInBytes _ = sizeOf (undefined::t)
bitmapPixelSizeInBytes :: PixelComponent t => Bitmap t -> Int
bitmapPixelSizeInBytes bm = bitmapNChannels bm * bitmapComponentSizeInBytes bm
bitmapUnpaddedRowSizeInBytes :: forall t. PixelComponent t => Bitmap t -> Int
bitmapUnpaddedRowSizeInBytes bm = w * sizeOf (undefined::t) * nchn where
(w,h) = bitmapSize bm
nchn = bitmapNChannels bm
bitmapPaddedRowSizeInBytes :: PixelComponent t => Bitmap t -> Int
bitmapPaddedRowSizeInBytes bm = bitmapUnpaddedRowSizeInBytes bm + bitmapRowPadding bm
bitmapSizeInBytes :: PixelComponent t => Bitmap t -> Int
bitmapSizeInBytes bm = h*x where
x = bitmapPaddedRowSizeInBytes bm
(_,h) = bitmapSize bm
bitmapAspect :: Fractional a => Bitmap t -> a
bitmapAspect bm = (fromIntegral x / fromIntegral y) where
(x,y) = bitmapSize bm
recommendedPadding :: forall t. PixelComponent t => Bitmap t -> Int
recommendedPadding bm = pad where
(w,_) = bitmapSize bm
n = bitmapNChannels bm
b = bitmapRowAlignment bm
s = sizeOf (undefined::t)
a = if b<s then s else b
k = case divMod a s of (q,r) -> if r==0 then q else error "recommendedPadding: should not happen"
pad = s * ( k * div (n*w + k1) k n*w )