{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE CPP #-}
module Codec.Picture.Tiff( decodeTiff
, decodeTiffWithMetadata
, decodeTiffWithPaletteAndMetadata
, TiffSaveable
, encodeTiff
, writeTiff
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative( (<$>), (<*>), pure )
import Data.Monoid( mempty )
#endif
import Control.Arrow( first )
import Control.Monad( when, foldM_, unless, forM_ )
import Control.Monad.ST( ST, runST )
import Control.Monad.Writer.Strict( execWriter, tell, Writer )
import Data.Int( Int8 )
import Data.Word( Word8, Word16, Word32 )
import Data.Bits( (.&.), (.|.), unsafeShiftL, unsafeShiftR )
import Data.Binary.Get( Get )
import Data.Binary.Put( runPut )
import qualified Data.Vector as V
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Storable.Mutable as M
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as Lb
import qualified Data.ByteString.Unsafe as BU
import Foreign.Storable( sizeOf )
import Codec.Picture.Metadata.Exif
import Codec.Picture.Metadata( Metadatas )
import Codec.Picture.InternalHelper
import Codec.Picture.BitWriter
import Codec.Picture.Types
import Codec.Picture.Gif.Internal.LZW
import Codec.Picture.Tiff.Internal.Types
import Codec.Picture.Tiff.Internal.Metadata
import Codec.Picture.VectorByteConversion( toByteString )
data TiffInfo = TiffInfo
{ :: TiffHeader
, TiffInfo -> Word32
tiffWidth :: Word32
, TiffInfo -> Word32
tiffHeight :: Word32
, TiffInfo -> TiffColorspace
tiffColorspace :: TiffColorspace
, TiffInfo -> Word32
tiffSampleCount :: Word32
, TiffInfo -> Word32
tiffRowPerStrip :: Word32
, TiffInfo -> TiffPlanarConfiguration
tiffPlaneConfiguration :: TiffPlanarConfiguration
, TiffInfo -> [TiffSampleFormat]
tiffSampleFormat :: [TiffSampleFormat]
, TiffInfo -> Vector Word32
tiffBitsPerSample :: V.Vector Word32
, TiffInfo -> TiffCompression
tiffCompression :: TiffCompression
, TiffInfo -> Vector Word32
tiffStripSize :: V.Vector Word32
, TiffInfo -> Vector Word32
tiffOffsets :: V.Vector Word32
, TiffInfo -> Maybe (Image PixelRGB16)
tiffPalette :: Maybe (Image PixelRGB16)
, TiffInfo -> Vector Word32
tiffYCbCrSubsampling :: V.Vector Word32
, :: Maybe ExtraSample
, TiffInfo -> Predictor
tiffPredictor :: Predictor
, TiffInfo -> Metadatas
tiffMetadatas :: Metadatas
}
unLong :: String -> ExifData -> Get (V.Vector Word32)
unLong :: String -> ExifData -> Get (Vector Word32)
unLong _ (ExifLong v :: Word32
v) = Vector Word32 -> Get (Vector Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector Word32 -> Get (Vector Word32))
-> Vector Word32 -> Get (Vector Word32)
forall a b. (a -> b) -> a -> b
$ Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton Word32
v
unLong _ (ExifShort v :: Word16
v) = Vector Word32 -> Get (Vector Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector Word32 -> Get (Vector Word32))
-> Vector Word32 -> Get (Vector Word32)
forall a b. (a -> b) -> a -> b
$ Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton (Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v)
unLong _ (ExifShorts v :: Vector Word16
v) = Vector Word32 -> Get (Vector Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector Word32 -> Get (Vector Word32))
-> Vector Word32 -> Get (Vector Word32)
forall a b. (a -> b) -> a -> b
$ (Word16 -> Word32) -> Vector Word16 -> Vector Word32
forall a b. (a -> b) -> Vector a -> Vector b
V.map Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Vector Word16
v
unLong _ (ExifLongs v :: Vector Word32
v) = Vector Word32 -> Get (Vector Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector Word32
v
unLong errMessage :: String
errMessage _ = String -> Get (Vector Word32)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errMessage
findIFD :: String -> ExifTag -> [ImageFileDirectory]
-> Get ImageFileDirectory
findIFD :: String -> ExifTag -> [ImageFileDirectory] -> Get ImageFileDirectory
findIFD errorMessage :: String
errorMessage tag :: ExifTag
tag lst :: [ImageFileDirectory]
lst =
case [ImageFileDirectory
v | ImageFileDirectory
v <- [ImageFileDirectory]
lst, ImageFileDirectory -> ExifTag
ifdIdentifier ImageFileDirectory
v ExifTag -> ExifTag -> Bool
forall a. Eq a => a -> a -> Bool
== ExifTag
tag] of
[] -> String -> Get ImageFileDirectory
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errorMessage
(x :: ImageFileDirectory
x:_) -> ImageFileDirectory -> Get ImageFileDirectory
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImageFileDirectory
x
findPalette :: [ImageFileDirectory] -> Get (Maybe (Image PixelRGB16))
findPalette :: [ImageFileDirectory] -> Get (Maybe (Image PixelRGB16))
findPalette ifds :: [ImageFileDirectory]
ifds =
case [ImageFileDirectory
v | ImageFileDirectory
v <- [ImageFileDirectory]
ifds, ImageFileDirectory -> ExifTag
ifdIdentifier ImageFileDirectory
v ExifTag -> ExifTag -> Bool
forall a. Eq a => a -> a -> Bool
== ExifTag
TagColorMap] of
(ImageFileDirectory { ifdExtended :: ImageFileDirectory -> ExifData
ifdExtended = ExifShorts vec :: Vector Word16
vec }:_) ->
Maybe (Image PixelRGB16) -> Get (Maybe (Image PixelRGB16))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Image PixelRGB16) -> Get (Maybe (Image PixelRGB16)))
-> (Vector Word16 -> Maybe (Image PixelRGB16))
-> Vector Word16
-> Get (Maybe (Image PixelRGB16))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB16 -> Maybe (Image PixelRGB16)
forall a. a -> Maybe a
Just (Image PixelRGB16 -> Maybe (Image PixelRGB16))
-> (Vector Word16 -> Image PixelRGB16)
-> Vector Word16
-> Maybe (Image PixelRGB16)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Int
-> Vector (PixelBaseComponent PixelRGB16)
-> Image PixelRGB16
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
pixelCount 1 (Vector Word16 -> Get (Maybe (Image PixelRGB16)))
-> Vector Word16 -> Get (Maybe (Image PixelRGB16))
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Word16) -> Vector Word16
forall a. Storable a => Int -> (Int -> a) -> Vector a
VS.generate (Vector Word16 -> Int
forall a. Vector a -> Int
V.length Vector Word16
vec) Int -> Word16
axx
where pixelCount :: Int
pixelCount = Vector Word16 -> Int
forall a. Vector a -> Int
V.length Vector Word16
vec Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 3
axx :: Int -> Word16
axx v :: Int
v = Vector Word16
vec Vector Word16 -> Int -> Word16
forall a. Vector a -> Int -> a
`V.unsafeIndex` (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
color Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pixelCount)
where (idx :: Int
idx, color :: Int
color) = Int
v Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` 3
_ -> Maybe (Image PixelRGB16) -> Get (Maybe (Image PixelRGB16))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Image PixelRGB16)
forall a. Maybe a
Nothing
findIFDData :: String -> ExifTag -> [ImageFileDirectory] -> Get Word32
findIFDData :: String -> ExifTag -> [ImageFileDirectory] -> Get Word32
findIFDData msg :: String
msg tag :: ExifTag
tag lst :: [ImageFileDirectory]
lst = ImageFileDirectory -> Word32
ifdOffset (ImageFileDirectory -> Word32)
-> Get ImageFileDirectory -> Get Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExifTag -> [ImageFileDirectory] -> Get ImageFileDirectory
findIFD String
msg ExifTag
tag [ImageFileDirectory]
lst
findIFDDefaultData :: Word32 -> ExifTag -> [ImageFileDirectory] -> Get Word32
findIFDDefaultData :: Word32 -> ExifTag -> [ImageFileDirectory] -> Get Word32
findIFDDefaultData d :: Word32
d tag :: ExifTag
tag lst :: [ImageFileDirectory]
lst =
case [ImageFileDirectory
v | ImageFileDirectory
v <- [ImageFileDirectory]
lst, ImageFileDirectory -> ExifTag
ifdIdentifier ImageFileDirectory
v ExifTag -> ExifTag -> Bool
forall a. Eq a => a -> a -> Bool
== ExifTag
tag] of
[] -> Word32 -> Get Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
d
(x :: ImageFileDirectory
x:_) -> Word32 -> Get Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> Get Word32) -> Word32 -> Get Word32
forall a b. (a -> b) -> a -> b
$ ImageFileDirectory -> Word32
ifdOffset ImageFileDirectory
x
findIFDExt :: String -> ExifTag -> [ImageFileDirectory] -> Get ExifData
findIFDExt :: String -> ExifTag -> [ImageFileDirectory] -> Get ExifData
findIFDExt msg :: String
msg tag :: ExifTag
tag lst :: [ImageFileDirectory]
lst = do
ImageFileDirectory
val <- String -> ExifTag -> [ImageFileDirectory] -> Get ImageFileDirectory
findIFD String
msg ExifTag
tag [ImageFileDirectory]
lst
case ImageFileDirectory
val of
ImageFileDirectory
{ ifdCount :: ImageFileDirectory -> Word32
ifdCount = Word32
1, ifdOffset :: ImageFileDirectory -> Word32
ifdOffset = Word32
ofs, ifdType :: ImageFileDirectory -> IfdType
ifdType = IfdType
TypeShort } ->
ExifData -> Get ExifData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExifData -> Get ExifData)
-> (Word16 -> ExifData) -> Word16 -> Get ExifData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word16 -> ExifData
ExifShorts (Vector Word16 -> ExifData)
-> (Word16 -> Vector Word16) -> Word16 -> ExifData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Vector Word16
forall a. a -> Vector a
V.singleton (Word16 -> Get ExifData) -> Word16 -> Get ExifData
forall a b. (a -> b) -> a -> b
$ Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ofs
ImageFileDirectory
{ ifdCount :: ImageFileDirectory -> Word32
ifdCount = Word32
1, ifdOffset :: ImageFileDirectory -> Word32
ifdOffset = Word32
ofs, ifdType :: ImageFileDirectory -> IfdType
ifdType = IfdType
TypeLong } ->
ExifData -> Get ExifData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExifData -> Get ExifData)
-> (Word32 -> ExifData) -> Word32 -> Get ExifData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word32 -> ExifData
ExifLongs (Vector Word32 -> ExifData)
-> (Word32 -> Vector Word32) -> Word32 -> ExifData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton (Word32 -> Get ExifData) -> Word32 -> Get ExifData
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ofs
ImageFileDirectory { ifdExtended :: ImageFileDirectory -> ExifData
ifdExtended = ExifData
v } -> ExifData -> Get ExifData
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExifData
v
findIFDExtDefaultData :: [Word32] -> ExifTag -> [ImageFileDirectory]
-> Get [Word32]
findIFDExtDefaultData :: [Word32] -> ExifTag -> [ImageFileDirectory] -> Get [Word32]
findIFDExtDefaultData d :: [Word32]
d tag :: ExifTag
tag lst :: [ImageFileDirectory]
lst =
case [ImageFileDirectory
v | ImageFileDirectory
v <- [ImageFileDirectory]
lst, ImageFileDirectory -> ExifTag
ifdIdentifier ImageFileDirectory
v ExifTag -> ExifTag -> Bool
forall a. Eq a => a -> a -> Bool
== ExifTag
tag] of
[] -> [Word32] -> Get [Word32]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Word32]
d
(ImageFileDirectory { ifdExtended :: ImageFileDirectory -> ExifData
ifdExtended = ExifData
ExifNone }:_) -> [Word32] -> Get [Word32]
forall (m :: * -> *) a. Monad m => a -> m a
return [Word32]
d
(x :: ImageFileDirectory
x:_) -> Vector Word32 -> [Word32]
forall a. Vector a -> [a]
V.toList (Vector Word32 -> [Word32]) -> Get (Vector Word32) -> Get [Word32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExifData -> Get (Vector Word32)
unLong String
errorMessage (ImageFileDirectory -> ExifData
ifdExtended ImageFileDirectory
x)
where errorMessage :: String
errorMessage =
"Can't parse tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExifTag -> String
forall a. Show a => a -> String
show ExifTag
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExifData -> String
forall a. Show a => a -> String
show (ImageFileDirectory -> ExifData
ifdExtended ImageFileDirectory
x)
copyByteString :: B.ByteString -> M.STVector s Word8 -> Int -> Int -> (Word32, Word32)
-> ST s Int
copyByteString :: ByteString
-> STVector s Word8 -> Int -> Int -> (Word32, Word32) -> ST s Int
copyByteString str :: ByteString
str vec :: STVector s Word8
vec stride :: Int
stride startWrite :: Int
startWrite (from :: Word32
from, count :: Word32
count) = Int -> Int -> ST s Int
inner Int
startWrite Int
fromi
where fromi :: Int
fromi = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
from
maxi :: Int
maxi = Int
fromi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
count
inner :: Int -> Int -> ST s Int
inner writeIdx :: Int
writeIdx i :: Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxi = Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
writeIdx
inner writeIdx :: Int
writeIdx i :: Int
i = do
let v :: Word8
v = ByteString
str ByteString -> Int -> Word8
`BU.unsafeIndex` Int
i
(STVector s Word8
MVector (PrimState (ST s)) Word8
vec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` Int
writeIdx) Word8
v
Int -> Int -> ST s Int
inner (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stride) (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
unpackPackBit :: B.ByteString -> M.STVector s Word8 -> Int -> Int
-> (Word32, Word32)
-> ST s Int
unpackPackBit :: ByteString
-> STVector s Word8 -> Int -> Int -> (Word32, Word32) -> ST s Int
unpackPackBit str :: ByteString
str outVec :: STVector s Word8
outVec stride :: Int
stride writeIndex :: Int
writeIndex (offset :: Word32
offset, size :: Word32
size) = Int -> Int -> ST s Int
loop Int
fromi Int
writeIndex
where fromi :: Int
fromi = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
offset
maxi :: Int
maxi = Int
fromi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size
replicateByte :: Int -> Word8 -> Int -> ST s Int
replicateByte writeIdx :: Int
writeIdx _ 0 = Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
writeIdx
replicateByte writeIdx :: Int
writeIdx v :: Word8
v count :: Int
count = do
(STVector s Word8
MVector (PrimState (ST s)) Word8
outVec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` Int
writeIdx) Word8
v
Int -> Word8 -> Int -> ST s Int
replicateByte (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stride) Word8
v (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
loop :: Int -> Int -> ST s Int
loop i :: Int
i writeIdx :: Int
writeIdx | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxi = Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
writeIdx
loop i :: Int
i writeIdx :: Int
writeIdx = ST s Int
choice
where v :: Int8
v = Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
str ByteString -> Int -> Word8
`B.index` Int
i) :: Int8
choice :: ST s Int
choice
| 0 Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int8
v =
ByteString
-> STVector s Word8 -> Int -> Int -> (Word32, Word32) -> ST s Int
forall s.
ByteString
-> STVector s Word8 -> Int -> Int -> (Word32, Word32) -> ST s Int
copyByteString ByteString
str STVector s Word8
outVec Int
stride Int
writeIdx
(Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, Int8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
v Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 1)
ST s Int -> (Int -> ST s Int) -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Int -> ST s Int
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
v)
| -127 Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int8
v = do
let nextByte :: Word8
nextByte = ByteString
str ByteString -> Int -> Word8
`B.index` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
count :: Int
count = Int -> Int
forall a. Num a => a -> a
negate (Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
v) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 :: Int
Int -> Word8 -> Int -> ST s Int
replicateByte Int
writeIdx Word8
nextByte Int
count
ST s Int -> (Int -> ST s Int) -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Int -> ST s Int
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
| Bool
otherwise = Int -> Int -> ST s Int
loop Int
writeIdx (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
uncompressAt :: TiffCompression
-> B.ByteString -> M.STVector s Word8 -> Int -> Int -> (Word32, Word32)
-> ST s Int
uncompressAt :: TiffCompression
-> ByteString
-> STVector s Word8
-> Int
-> Int
-> (Word32, Word32)
-> ST s Int
uncompressAt CompressionNone = ByteString
-> STVector s Word8 -> Int -> Int -> (Word32, Word32) -> ST s Int
forall s.
ByteString
-> STVector s Word8 -> Int -> Int -> (Word32, Word32) -> ST s Int
copyByteString
uncompressAt CompressionPackBit = ByteString
-> STVector s Word8 -> Int -> Int -> (Word32, Word32) -> ST s Int
forall s.
ByteString
-> STVector s Word8 -> Int -> Int -> (Word32, Word32) -> ST s Int
unpackPackBit
uncompressAt CompressionLZW = \str :: ByteString
str outVec :: STVector s Word8
outVec _stride :: Int
_stride writeIndex :: Int
writeIndex (offset :: Word32
offset, size :: Word32
size) -> do
let toDecode :: ByteString
toDecode = Int -> ByteString -> ByteString
B.take (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
offset) ByteString
str
BoolReader s () -> ST s ()
forall s a. BoolReader s a -> ST s a
runBoolReader (BoolReader s () -> ST s ()) -> BoolReader s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ ByteString -> STVector s Word8 -> Int -> BoolReader s ()
forall s. ByteString -> STVector s Word8 -> Int -> BoolReader s ()
decodeLzwTiff ByteString
toDecode STVector s Word8
outVec Int
writeIndex
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return 0
uncompressAt _ = String
-> ByteString
-> STVector s Word8
-> Int
-> Int
-> (Word32, Word32)
-> ST s Int
forall a. HasCallStack => String -> a
error "Unhandled compression"
class Unpackable a where
type StorageType a :: *
outAlloc :: a -> Int -> ST s (M.STVector s (StorageType a))
allocTempBuffer :: a -> M.STVector s (StorageType a) -> Int
-> ST s (M.STVector s Word8)
offsetStride :: a -> Int -> Int -> (Int, Int)
mergeBackTempBuffer :: a
-> Endianness
-> M.STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> M.STVector s (StorageType a)
-> ST s ()
instance Unpackable Word8 where
type StorageType Word8 = Word8
offsetStride :: Word8 -> Int -> Int -> (Int, Int)
offsetStride _ i :: Int
i stride :: Int
stride = (Int
i, Int
stride)
allocTempBuffer :: Word8
-> STVector s (StorageType Word8) -> Int -> ST s (STVector s Word8)
allocTempBuffer _ buff :: STVector s (StorageType Word8)
buff _ = STVector s Word8 -> ST s (STVector s Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure STVector s Word8
STVector s (StorageType Word8)
buff
mergeBackTempBuffer :: Word8
-> Endianness
-> STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> STVector s (StorageType Word8)
-> ST s ()
mergeBackTempBuffer _ _ _ _ _ _ _ _ = () -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
outAlloc :: Word8 -> Int -> ST s (STVector s (StorageType Word8))
outAlloc _ count :: Int
count = Int -> Word8 -> ST s (MVector (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> a -> m (MVector (PrimState m) a)
M.replicate Int
count 0
instance Unpackable Word16 where
type StorageType Word16 = Word16
offsetStride :: Word16 -> Int -> Int -> (Int, Int)
offsetStride _ _ _ = (0, 1)
outAlloc :: Word16 -> Int -> ST s (STVector s (StorageType Word16))
outAlloc _ = Int -> ST s (STVector s (StorageType Word16))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new
allocTempBuffer :: Word16
-> STVector s (StorageType Word16)
-> Int
-> ST s (STVector s Word8)
allocTempBuffer _ _ s :: Int
s = Int -> ST s (STVector s Word8)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new (Int -> ST s (STVector s Word8)) -> Int -> ST s (STVector s Word8)
forall a b. (a -> b) -> a -> b
$ Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* 2
mergeBackTempBuffer :: Word16
-> Endianness
-> STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> STVector s (StorageType Word16)
-> ST s ()
mergeBackTempBuffer _ EndianLittle tempVec :: STVector s Word8
tempVec _ index :: Int
index size :: Word32
size stride :: Int
stride outVec :: STVector s (StorageType Word16)
outVec =
Int -> Int -> ST s ()
looperLe Int
index 0
where looperLe :: Int -> Int -> ST s ()
looperLe _ readIndex :: Int
readIndex | Int
readIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size = () -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
looperLe writeIndex :: Int
writeIndex readIndex :: Int
readIndex = do
Word8
v1 <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
readIndex
Word8
v2 <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
let finalValue :: Word16
finalValue =
(Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v2 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 8) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v1
(STVector s (StorageType Word16)
MVector (PrimState (ST s)) Word16
outVec MVector (PrimState (ST s)) Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` Int
writeIndex) Word16
finalValue
Int -> Int -> ST s ()
looperLe (Int
writeIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stride) (Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
mergeBackTempBuffer _ EndianBig tempVec :: STVector s Word8
tempVec _ index :: Int
index size :: Word32
size stride :: Int
stride outVec :: STVector s (StorageType Word16)
outVec =
Int -> Int -> ST s ()
looperBe Int
index 0
where looperBe :: Int -> Int -> ST s ()
looperBe _ readIndex :: Int
readIndex | Int
readIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size = () -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
looperBe writeIndex :: Int
writeIndex readIndex :: Int
readIndex = do
Word8
v1 <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
readIndex
Word8
v2 <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
let finalValue :: Word16
finalValue =
(Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v1 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 8) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v2
(STVector s (StorageType Word16)
MVector (PrimState (ST s)) Word16
outVec MVector (PrimState (ST s)) Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` Int
writeIndex) Word16
finalValue
Int -> Int -> ST s ()
looperBe (Int
writeIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stride) (Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
instance Unpackable Word32 where
type StorageType Word32 = Word32
offsetStride :: Word32 -> Int -> Int -> (Int, Int)
offsetStride _ _ _ = (0, 1)
outAlloc :: Word32 -> Int -> ST s (STVector s (StorageType Word32))
outAlloc _ = Int -> ST s (STVector s (StorageType Word32))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new
allocTempBuffer :: Word32
-> STVector s (StorageType Word32)
-> Int
-> ST s (STVector s Word8)
allocTempBuffer _ _ s :: Int
s = Int -> ST s (STVector s Word8)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new (Int -> ST s (STVector s Word8)) -> Int -> ST s (STVector s Word8)
forall a b. (a -> b) -> a -> b
$ Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4
mergeBackTempBuffer :: Word32
-> Endianness
-> STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> STVector s (StorageType Word32)
-> ST s ()
mergeBackTempBuffer _ EndianLittle tempVec :: STVector s Word8
tempVec _ index :: Int
index size :: Word32
size stride :: Int
stride outVec :: STVector s (StorageType Word32)
outVec =
Int -> Int -> ST s ()
looperLe Int
index 0
where looperLe :: Int -> Int -> ST s ()
looperLe _ readIndex :: Int
readIndex | Int
readIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size = () -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
looperLe writeIndex :: Int
writeIndex readIndex :: Int
readIndex = do
Word8
v1 <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
readIndex
Word8
v2 <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
Word8
v3 <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
Word8
v4 <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3)
let finalValue :: Word32
finalValue =
(Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v4 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v3 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v1
(STVector s (StorageType Word32)
MVector (PrimState (ST s)) Word32
outVec MVector (PrimState (ST s)) Word32 -> Int -> Word32 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` Int
writeIndex) Word32
finalValue
Int -> Int -> ST s ()
looperLe (Int
writeIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stride) (Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4)
mergeBackTempBuffer _ EndianBig tempVec :: STVector s Word8
tempVec _ index :: Int
index size :: Word32
size stride :: Int
stride outVec :: STVector s (StorageType Word32)
outVec =
Int -> Int -> ST s ()
looperBe Int
index 0
where looperBe :: Int -> Int -> ST s ()
looperBe _ readIndex :: Int
readIndex | Int
readIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size = () -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
looperBe writeIndex :: Int
writeIndex readIndex :: Int
readIndex = do
Word8
v1 <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
readIndex
Word8
v2 <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
Word8
v3 <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
Word8
v4 <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3)
let finalValue :: Word32
finalValue =
(Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v3 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v4
(STVector s (StorageType Word32)
MVector (PrimState (ST s)) Word32
outVec MVector (PrimState (ST s)) Word32 -> Int -> Word32 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` Int
writeIndex) Word32
finalValue
Int -> Int -> ST s ()
looperBe (Int
writeIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stride) (Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4)
instance Unpackable Float where
type StorageType Float = Float
offsetStride :: Float -> Int -> Int -> (Int, Int)
offsetStride _ _ _ = (0, 1)
outAlloc :: Float -> Int -> ST s (STVector s (StorageType Float))
outAlloc _ = Int -> ST s (STVector s (StorageType Float))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new
allocTempBuffer :: Float
-> STVector s (StorageType Float) -> Int -> ST s (STVector s Word8)
allocTempBuffer _ _ s :: Int
s = Int -> ST s (STVector s Word8)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new (Int -> ST s (STVector s Word8)) -> Int -> ST s (STVector s Word8)
forall a b. (a -> b) -> a -> b
$ Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4
mergeBackTempBuffer :: forall s. Float
-> Endianness
-> M.STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> M.STVector s (StorageType Float)
-> ST s ()
mergeBackTempBuffer :: Float
-> Endianness
-> STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> STVector s (StorageType Float)
-> ST s ()
mergeBackTempBuffer _ endianness :: Endianness
endianness tempVec :: STVector s Word8
tempVec lineSize :: Int
lineSize index :: Int
index size :: Word32
size stride :: Int
stride outVec :: STVector s (StorageType Float)
outVec =
let outVecWord32 :: M.STVector s Word32
outVecWord32 :: STVector s Word32
outVecWord32 = MVector s Float -> STVector s Word32
forall a b s.
(Storable a, Storable b) =>
MVector s a -> MVector s b
M.unsafeCast MVector s Float
STVector s (StorageType Float)
outVec
in Word32
-> Endianness
-> STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> STVector s (StorageType Word32)
-> ST s ()
forall a s.
Unpackable a =>
a
-> Endianness
-> STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> STVector s (StorageType a)
-> ST s ()
mergeBackTempBuffer (0 :: Word32)
Endianness
endianness
STVector s Word8
tempVec
Int
lineSize
Int
index
Word32
size
Int
stride
STVector s Word32
STVector s (StorageType Word32)
outVecWord32
data Pack4 = Pack4
instance Unpackable Pack4 where
type StorageType Pack4 = Word8
allocTempBuffer :: Pack4
-> STVector s (StorageType Pack4) -> Int -> ST s (STVector s Word8)
allocTempBuffer _ _ = Int -> ST s (STVector s Word8)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new
offsetStride :: Pack4 -> Int -> Int -> (Int, Int)
offsetStride _ _ _ = (0, 1)
outAlloc :: Pack4 -> Int -> ST s (STVector s (StorageType Pack4))
outAlloc _ = Int -> ST s (STVector s (StorageType Pack4))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new
mergeBackTempBuffer :: Pack4
-> Endianness
-> STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> STVector s (StorageType Pack4)
-> ST s ()
mergeBackTempBuffer _ _ tempVec :: STVector s Word8
tempVec lineSize :: Int
lineSize index :: Int
index size :: Word32
size stride :: Int
stride outVec :: STVector s (StorageType Pack4)
outVec =
Int -> Int -> Int -> ST s ()
inner 0 Int
index Int
pxCount
where pxCount :: Int
pxCount = Int
lineSize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
stride
maxWrite :: Int
maxWrite = STVector s Word8 -> Int
forall a s. Storable a => MVector s a -> Int
M.length STVector s Word8
STVector s (StorageType Pack4)
outVec
inner :: Int -> Int -> Int -> ST s ()
inner readIdx :: Int
readIdx writeIdx :: Int
writeIdx _
| Int
readIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size Bool -> Bool -> Bool
|| Int
writeIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxWrite = () -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
inner readIdx :: Int
readIdx writeIdx :: Int
writeIdx line :: Int
line
| Int
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Int -> Int -> Int -> ST s ()
inner Int
readIdx (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
stride) Int
pxCount
inner readIdx :: Int
readIdx writeIdx :: Int
writeIdx line :: Int
line = do
Word8
v <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
readIdx
let high :: Word8
high = (Word8
v Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` 4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0xF
low :: Word8
low = Word8
v Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0xF
(STVector s (StorageType Pack4)
MVector (PrimState (ST s)) Word8
outVec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` Int
writeIdx) Word8
high
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stride Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxWrite) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
(STVector s (StorageType Pack4)
MVector (PrimState (ST s)) Word8
outVec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stride)) Word8
low
Int -> Int -> Int -> ST s ()
inner (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
stride) (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)
data Pack2 = Pack2
instance Unpackable Pack2 where
type StorageType Pack2 = Word8
allocTempBuffer :: Pack2
-> STVector s (StorageType Pack2) -> Int -> ST s (STVector s Word8)
allocTempBuffer _ _ = Int -> ST s (STVector s Word8)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new
offsetStride :: Pack2 -> Int -> Int -> (Int, Int)
offsetStride _ _ _ = (0, 1)
outAlloc :: Pack2 -> Int -> ST s (STVector s (StorageType Pack2))
outAlloc _ = Int -> ST s (STVector s (StorageType Pack2))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new
mergeBackTempBuffer :: Pack2
-> Endianness
-> STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> STVector s (StorageType Pack2)
-> ST s ()
mergeBackTempBuffer _ _ tempVec :: STVector s Word8
tempVec lineSize :: Int
lineSize index :: Int
index size :: Word32
size stride :: Int
stride outVec :: STVector s (StorageType Pack2)
outVec =
Int -> Int -> Int -> ST s ()
inner 0 Int
index Int
pxCount
where pxCount :: Int
pxCount = Int
lineSize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
stride
maxWrite :: Int
maxWrite = STVector s Word8 -> Int
forall a s. Storable a => MVector s a -> Int
M.length STVector s Word8
STVector s (StorageType Pack2)
outVec
inner :: Int -> Int -> Int -> ST s ()
inner readIdx :: Int
readIdx writeIdx :: Int
writeIdx _
| Int
readIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size Bool -> Bool -> Bool
|| Int
writeIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxWrite = () -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
inner readIdx :: Int
readIdx writeIdx :: Int
writeIdx line :: Int
line
| Int
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Int -> Int -> Int -> ST s ()
inner Int
readIdx (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
stride) Int
pxCount
inner readIdx :: Int
readIdx writeIdx :: Int
writeIdx line :: Int
line = do
Word8
v <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
readIdx
let v0 :: Word8
v0 = (Word8
v Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` 6) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x3
v1 :: Word8
v1 = (Word8
v Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` 4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x3
v2 :: Word8
v2 = (Word8
v Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` 2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x3
v3 :: Word8
v3 = Word8
v Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x3
(STVector s (StorageType Pack2)
MVector (PrimState (ST s)) Word8
outVec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` Int
writeIdx) Word8
v0
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
stride Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxWrite) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
(STVector s (StorageType Pack2)
MVector (PrimState (ST s)) Word8
outVec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stride)) Word8
v1
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
stride Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxWrite) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
(STVector s (StorageType Pack2)
MVector (PrimState (ST s)) Word8
outVec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stride Int -> Int -> Int
forall a. Num a => a -> a -> a
* 2)) Word8
v2
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
stride Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxWrite) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
(STVector s (StorageType Pack2)
MVector (PrimState (ST s)) Word8
outVec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stride Int -> Int -> Int
forall a. Num a => a -> a -> a
* 3)) Word8
v3
Int -> Int -> Int -> ST s ()
inner (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
stride) (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- 4)
data Pack12 = Pack12
instance Unpackable Pack12 where
type StorageType Pack12 = Word16
allocTempBuffer :: Pack12
-> STVector s (StorageType Pack12)
-> Int
-> ST s (STVector s Word8)
allocTempBuffer _ _ = Int -> ST s (STVector s Word8)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new
offsetStride :: Pack12 -> Int -> Int -> (Int, Int)
offsetStride _ _ _ = (0, 1)
outAlloc :: Pack12 -> Int -> ST s (STVector s (StorageType Pack12))
outAlloc _ = Int -> ST s (STVector s (StorageType Pack12))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new
mergeBackTempBuffer :: Pack12
-> Endianness
-> STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> STVector s (StorageType Pack12)
-> ST s ()
mergeBackTempBuffer _ _ tempVec :: STVector s Word8
tempVec lineSize :: Int
lineSize index :: Int
index size :: Word32
size stride :: Int
stride outVec :: STVector s (StorageType Pack12)
outVec =
Int -> Int -> Int -> ST s ()
inner 0 Int
index Int
pxCount
where pxCount :: Int
pxCount = Int
lineSize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
stride
maxWrite :: Int
maxWrite = MVector s Word16 -> Int
forall a s. Storable a => MVector s a -> Int
M.length MVector s Word16
STVector s (StorageType Pack12)
outVec
inner :: Int -> Int -> Int -> ST s ()
inner readIdx :: Int
readIdx writeIdx :: Int
writeIdx _
| Int
readIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size Bool -> Bool -> Bool
|| Int
writeIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxWrite = () -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
inner readIdx :: Int
readIdx writeIdx :: Int
writeIdx line :: Int
line
| Int
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Int -> Int -> Int -> ST s ()
inner Int
readIdx (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
stride) Int
pxCount
inner readIdx :: Int
readIdx writeIdx :: Int
writeIdx line :: Int
line = do
Word8
v0 <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
readIdx
Word8
v1 <- if Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size
then STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
else Word8 -> ST s Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0
Word8
v2 <- if Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size
then STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
else Word8 -> ST s Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0
let high0 :: Word16
high0 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v0 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 4
low0 :: Word16
low0 = (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v1 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftR` 4) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 0xF
p0 :: Word16
p0 = Word16
high0 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
low0
high1 :: Word16
high1 = (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v1 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 0xF) Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 8
low1 :: Word16
low1 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v2
p1 :: Word16
p1 = Word16
high1 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
low1
(STVector s (StorageType Pack12)
MVector (PrimState (ST s)) Word16
outVec MVector (PrimState (ST s)) Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` Int
writeIdx) Word16
p0
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
stride Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxWrite) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
(STVector s (StorageType Pack12)
MVector (PrimState (ST s)) Word16
outVec MVector (PrimState (ST s)) Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stride)) Word16
p1
Int -> Int -> Int -> ST s ()
inner (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3) (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
stride) (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)
data YCbCrSubsampling = YCbCrSubsampling
{ YCbCrSubsampling -> Int
ycbcrWidth :: !Int
, YCbCrSubsampling -> Int
ycbcrHeight :: !Int
, YCbCrSubsampling -> Int
ycbcrImageWidth :: !Int
, YCbCrSubsampling -> Int
ycbcrStripHeight :: !Int
}
instance Unpackable YCbCrSubsampling where
type StorageType YCbCrSubsampling = Word8
offsetStride :: YCbCrSubsampling -> Int -> Int -> (Int, Int)
offsetStride _ _ _ = (0, 1)
outAlloc :: YCbCrSubsampling
-> Int -> ST s (STVector s (StorageType YCbCrSubsampling))
outAlloc _ = Int -> ST s (STVector s (StorageType YCbCrSubsampling))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new
allocTempBuffer :: YCbCrSubsampling
-> STVector s (StorageType YCbCrSubsampling)
-> Int
-> ST s (STVector s Word8)
allocTempBuffer _ _ = Int -> ST s (STVector s Word8)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new
mergeBackTempBuffer :: YCbCrSubsampling
-> Endianness
-> STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> STVector s (StorageType YCbCrSubsampling)
-> ST s ()
mergeBackTempBuffer subSampling :: YCbCrSubsampling
subSampling _ tempVec :: STVector s Word8
tempVec _ index :: Int
index size :: Word32
size _ outVec :: STVector s (StorageType YCbCrSubsampling)
outVec =
(Int -> (Int, Int) -> ST s Int) -> Int -> [(Int, Int)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ Int -> (Int, Int) -> ST s Int
unpacker 0 [(Int
bx, Int
by) | Int
by <- [0, Int
h .. Int
lineCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
, Int
bx <- [0, Int
w .. Int
imgWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]]
where w :: Int
w = YCbCrSubsampling -> Int
ycbcrWidth YCbCrSubsampling
subSampling
h :: Int
h = YCbCrSubsampling -> Int
ycbcrHeight YCbCrSubsampling
subSampling
imgWidth :: Int
imgWidth = YCbCrSubsampling -> Int
ycbcrImageWidth YCbCrSubsampling
subSampling
lineCount :: Int
lineCount = YCbCrSubsampling -> Int
ycbcrStripHeight YCbCrSubsampling
subSampling
lumaCount :: Int
lumaCount = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h
blockSize :: Int
blockSize = Int
lumaCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
maxOut :: Int
maxOut = STVector s Word8 -> Int
forall a s. Storable a => MVector s a -> Int
M.length STVector s Word8
STVector s (StorageType YCbCrSubsampling)
outVec
unpacker :: Int -> (Int, Int) -> ST s Int
unpacker readIdx :: Int
readIdx _ | Int
readIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* 3 = Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
readIdx
unpacker readIdx :: Int
readIdx (bx :: Int
bx, by :: Int
by) = do
Word8
cb <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lumaCount)
Word8
cr <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` (Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lumaCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
let pixelIndices :: [Int]
pixelIndices =
[Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Int
by Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
imgWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 3 | Int
y <- [0 .. Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1], Int
x <- [0 .. Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]]
writer :: Int -> Int -> ST s Int
writer readIndex :: Int
readIndex writeIdx :: Int
writeIdx | Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxOut = Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
readIndex
writer readIndex :: Int
readIndex writeIdx :: Int
writeIdx = do
Word8
y <- STVector s Word8
MVector (PrimState (ST s)) Word8
tempVec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.read` Int
readIndex
(STVector s (StorageType YCbCrSubsampling)
MVector (PrimState (ST s)) Word8
outVec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` Int
writeIdx) Word8
y
(STVector s (StorageType YCbCrSubsampling)
MVector (PrimState (ST s)) Word8
outVec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)) Word8
cb
(STVector s (StorageType YCbCrSubsampling)
MVector (PrimState (ST s)) Word8
outVec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.write` (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)) Word8
cr
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
(Int -> Int -> ST s Int) -> Int -> [Int] -> ST s ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ Int -> Int -> ST s Int
writer Int
readIdx [Int]
pixelIndices
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
readIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
blockSize
gatherStrips :: ( Unpackable comp
, Pixel pixel
, StorageType comp ~ PixelBaseComponent pixel
)
=> comp -> B.ByteString -> TiffInfo -> Image pixel
gatherStrips :: comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips comp :: comp
comp str :: ByteString
str nfo :: TiffInfo
nfo = (forall s. ST s (Image pixel)) -> Image pixel
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Image pixel)) -> Image pixel)
-> (forall s. ST s (Image pixel)) -> Image pixel
forall a b. (a -> b) -> a -> b
$ do
let width :: Int
width = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Word32
tiffWidth TiffInfo
nfo
height :: Int
height = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Word32
tiffHeight TiffInfo
nfo
sampleCount :: Int
sampleCount = if TiffInfo -> Word32
tiffSampleCount TiffInfo
nfo Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
then Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Word32
tiffSampleCount TiffInfo
nfo
else Vector Word32 -> Int
forall a. Vector a -> Int
V.length (Vector Word32 -> Int) -> Vector Word32 -> Int
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Vector Word32
tiffBitsPerSample TiffInfo
nfo
rowPerStrip :: Int
rowPerStrip = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Word32
tiffRowPerStrip TiffInfo
nfo
endianness :: Endianness
endianness = TiffHeader -> Endianness
hdrEndianness (TiffHeader -> Endianness) -> TiffHeader -> Endianness
forall a b. (a -> b) -> a -> b
$ TiffInfo -> TiffHeader
tiffHeader TiffInfo
nfo
stripCount :: Int
stripCount = Vector Word32 -> Int
forall a. Vector a -> Int
V.length (Vector Word32 -> Int) -> Vector Word32 -> Int
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Vector Word32
tiffOffsets TiffInfo
nfo
compression :: TiffCompression
compression = TiffInfo -> TiffCompression
tiffCompression TiffInfo
nfo
MVector s (PixelBaseComponent pixel)
outVec <- comp -> Int -> ST s (STVector s (StorageType comp))
forall a s.
Unpackable a =>
a -> Int -> ST s (STVector s (StorageType a))
outAlloc comp
comp (Int -> ST s (MVector s (PixelBaseComponent pixel)))
-> Int -> ST s (MVector s (PixelBaseComponent pixel))
forall a b. (a -> b) -> a -> b
$ Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sampleCount
STVector s Word8
tempVec <- comp
-> STVector s (StorageType comp) -> Int -> ST s (STVector s Word8)
forall a s.
Unpackable a =>
a -> STVector s (StorageType a) -> Int -> ST s (STVector s Word8)
allocTempBuffer comp
comp MVector s (PixelBaseComponent pixel)
STVector s (StorageType comp)
outVec
(Int
rowPerStrip Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sampleCount)
let mutableImage :: MutableImage s pixel
mutableImage = $WMutableImage :: forall s a.
Int -> Int -> STVector s (PixelBaseComponent a) -> MutableImage s a
MutableImage
{ mutableImageWidth :: Int
mutableImageWidth = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width
, mutableImageHeight :: Int
mutableImageHeight = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height
, mutableImageData :: MVector s (PixelBaseComponent pixel)
mutableImageData = MVector s (PixelBaseComponent pixel)
outVec
}
case TiffInfo -> TiffPlanarConfiguration
tiffPlaneConfiguration TiffInfo
nfo of
PlanarConfigContig -> ((Int, Int, Word32, Word32) -> ST s ())
-> Vector (Int, Int, Word32, Word32) -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (Int, Int, Word32, Word32) -> ST s ()
unpacker Vector (Int, Int, Word32, Word32)
sizes
where unpacker :: (Int, Int, Word32, Word32) -> ST s ()
unpacker (idx :: Int
idx, stripSampleCount :: Int
stripSampleCount, offset :: Word32
offset, packedSize :: Word32
packedSize) = do
let (writeIdx :: Int
writeIdx, tempStride :: Int
tempStride) = comp -> Int -> Int -> (Int, Int)
forall a. Unpackable a => a -> Int -> Int -> (Int, Int)
offsetStride comp
comp Int
idx 1
Int
_ <- TiffCompression
-> ByteString
-> STVector s Word8
-> Int
-> Int
-> (Word32, Word32)
-> ST s Int
forall s.
TiffCompression
-> ByteString
-> STVector s Word8
-> Int
-> Int
-> (Word32, Word32)
-> ST s Int
uncompressAt TiffCompression
compression ByteString
str STVector s Word8
tempVec Int
tempStride
Int
writeIdx (Word32
offset, Word32
packedSize)
let typ :: M.MVector s a -> a
typ :: MVector s a -> a
typ = a -> MVector s a -> a
forall a b. a -> b -> a
const a
forall a. HasCallStack => a
undefined
sampleSize :: Int
sampleSize = PixelBaseComponent pixel -> Int
forall a. Storable a => a -> Int
sizeOf (MVector s (PixelBaseComponent pixel) -> PixelBaseComponent pixel
forall s a. MVector s a -> a
typ MVector s (PixelBaseComponent pixel)
outVec)
comp
-> Endianness
-> STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> STVector s (StorageType comp)
-> ST s ()
forall a s.
Unpackable a =>
a
-> Endianness
-> STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> STVector s (StorageType a)
-> ST s ()
mergeBackTempBuffer comp
comp Endianness
endianness STVector s Word8
tempVec (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sampleCount)
Int
idx (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Int
stripSampleCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sampleSize) 1 MVector s (PixelBaseComponent pixel)
STVector s (StorageType comp)
outVec
fullStripSampleCount :: Int
fullStripSampleCount = Int
rowPerStrip Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sampleCount
startWriteOffset :: Vector Int
startWriteOffset = Int -> (Int -> Int) -> Vector Int
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
stripCount (Int
fullStripSampleCount Int -> Int -> Int
forall a. Num a => a -> a -> a
*)
stripSampleCounts :: Vector Int
stripSampleCounts = (Int -> Int) -> Vector Int -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
V.map Int -> Int
strip Vector Int
startWriteOffset
where
strip :: Int -> Int
strip start :: Int
start = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
fullStripSampleCount (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sampleCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start)
sizes :: Vector (Int, Int, Word32, Word32)
sizes = Vector Int
-> Vector Int
-> Vector Word32
-> Vector Word32
-> Vector (Int, Int, Word32, Word32)
forall a b c d.
Vector a -> Vector b -> Vector c -> Vector d -> Vector (a, b, c, d)
V.zip4 Vector Int
startWriteOffset Vector Int
stripSampleCounts
(TiffInfo -> Vector Word32
tiffOffsets TiffInfo
nfo) (TiffInfo -> Vector Word32
tiffStripSize TiffInfo
nfo)
PlanarConfigSeparate -> ((Int, Word32, Word32) -> ST s ())
-> Vector (Int, Word32, Word32) -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (Int, Word32, Word32) -> ST s ()
unpacker Vector (Int, Word32, Word32)
sizes
where unpacker :: (Int, Word32, Word32) -> ST s ()
unpacker (idx :: Int
idx, offset :: Word32
offset, size :: Word32
size) = do
let (writeIdx :: Int
writeIdx, tempStride :: Int
tempStride) = comp -> Int -> Int -> (Int, Int)
forall a. Unpackable a => a -> Int -> Int -> (Int, Int)
offsetStride comp
comp Int
idx Int
stride
Int
_ <- TiffCompression
-> ByteString
-> STVector s Word8
-> Int
-> Int
-> (Word32, Word32)
-> ST s Int
forall s.
TiffCompression
-> ByteString
-> STVector s Word8
-> Int
-> Int
-> (Word32, Word32)
-> ST s Int
uncompressAt TiffCompression
compression ByteString
str STVector s Word8
tempVec Int
tempStride
Int
writeIdx (Word32
offset, Word32
size)
comp
-> Endianness
-> STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> STVector s (StorageType comp)
-> ST s ()
forall a s.
Unpackable a =>
a
-> Endianness
-> STVector s Word8
-> Int
-> Int
-> Word32
-> Int
-> STVector s (StorageType a)
-> ST s ()
mergeBackTempBuffer comp
comp Endianness
endianness STVector s Word8
tempVec (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sampleCount)
Int
idx Word32
size Int
stride MVector s (PixelBaseComponent pixel)
STVector s (StorageType comp)
outVec
stride :: Int
stride = Vector Word32 -> Int
forall a. Vector a -> Int
V.length (Vector Word32 -> Int) -> Vector Word32 -> Int
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Vector Word32
tiffOffsets TiffInfo
nfo
idxVector :: Vector Int
idxVector = Int -> Int -> Vector Int
forall a. Num a => a -> Int -> Vector a
V.enumFromN 0 Int
stride
sizes :: Vector (Int, Word32, Word32)
sizes = Vector Int
-> Vector Word32 -> Vector Word32 -> Vector (Int, Word32, Word32)
forall a b c. Vector a -> Vector b -> Vector c -> Vector (a, b, c)
V.zip3 Vector Int
idxVector (TiffInfo -> Vector Word32
tiffOffsets TiffInfo
nfo) (TiffInfo -> Vector Word32
tiffStripSize TiffInfo
nfo)
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TiffInfo -> Predictor
tiffPredictor TiffInfo
nfo Predictor -> Predictor -> Bool
forall a. Eq a => a -> a -> Bool
== Predictor
PredictorHorizontalDifferencing) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
let f :: p -> a -> a -> a
f _ c1 :: a
c1 c2 :: a
c2 = a
c1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
c2
[Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [0 .. Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \y :: Int
y ->
[Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [1 .. Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \x :: Int
x -> do
pixel
p <- MutableImage (PrimState (ST s)) pixel -> Int -> Int -> ST s pixel
forall a (m :: * -> *).
(Pixel a, PrimMonad m) =>
MutableImage (PrimState m) a -> Int -> Int -> m a
readPixel MutableImage s pixel
MutableImage (PrimState (ST s)) pixel
mutableImage (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int
y
pixel
q <- MutableImage (PrimState (ST s)) pixel -> Int -> Int -> ST s pixel
forall a (m :: * -> *).
(Pixel a, PrimMonad m) =>
MutableImage (PrimState m) a -> Int -> Int -> m a
readPixel MutableImage s pixel
MutableImage (PrimState (ST s)) pixel
mutableImage Int
x Int
y
MutableImage (PrimState (ST s)) pixel
-> Int -> Int -> pixel -> ST s ()
forall a (m :: * -> *).
(Pixel a, PrimMonad m) =>
MutableImage (PrimState m) a -> Int -> Int -> a -> m ()
writePixel MutableImage s pixel
MutableImage (PrimState (ST s)) pixel
mutableImage Int
x Int
y (pixel -> ST s ()) -> pixel -> ST s ()
forall a b. (a -> b) -> a -> b
$ (Int
-> PixelBaseComponent pixel
-> PixelBaseComponent pixel
-> PixelBaseComponent pixel)
-> pixel -> pixel -> pixel
forall a.
Pixel a =>
(Int
-> PixelBaseComponent a
-> PixelBaseComponent a
-> PixelBaseComponent a)
-> a -> a -> a
mixWith Int
-> PixelBaseComponent pixel
-> PixelBaseComponent pixel
-> PixelBaseComponent pixel
forall a p. Num a => p -> a -> a -> a
f pixel
p pixel
q
MutableImage (PrimState (ST s)) pixel -> ST s (Image pixel)
forall a (m :: * -> *).
(Storable (PixelBaseComponent a), PrimMonad m) =>
MutableImage (PrimState m) a -> m (Image a)
unsafeFreezeImage MutableImage s pixel
MutableImage (PrimState (ST s)) pixel
mutableImage
ifdSingleLong :: ExifTag -> Word32 -> Writer [ImageFileDirectory] ()
ifdSingleLong :: ExifTag -> Word32 -> Writer [ImageFileDirectory] ()
ifdSingleLong tag :: ExifTag
tag = ExifTag -> Vector Word32 -> Writer [ImageFileDirectory] ()
ifdMultiLong ExifTag
tag (Vector Word32 -> Writer [ImageFileDirectory] ())
-> (Word32 -> Vector Word32)
-> Word32
-> Writer [ImageFileDirectory] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton
ifdSingleShort :: Endianness -> ExifTag -> Word16
-> Writer [ImageFileDirectory] ()
ifdSingleShort :: Endianness -> ExifTag -> Word16 -> Writer [ImageFileDirectory] ()
ifdSingleShort endian :: Endianness
endian tag :: ExifTag
tag = Endianness
-> ExifTag -> Vector Word32 -> Writer [ImageFileDirectory] ()
ifdMultiShort Endianness
endian ExifTag
tag (Vector Word32 -> Writer [ImageFileDirectory] ())
-> (Word16 -> Vector Word32)
-> Word16
-> Writer [ImageFileDirectory] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton (Word32 -> Vector Word32)
-> (Word16 -> Word32) -> Word16 -> Vector Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
ifdMultiLong :: ExifTag -> V.Vector Word32 -> Writer [ImageFileDirectory] ()
ifdMultiLong :: ExifTag -> Vector Word32 -> Writer [ImageFileDirectory] ()
ifdMultiLong tag :: ExifTag
tag v :: Vector Word32
v = [ImageFileDirectory] -> Writer [ImageFileDirectory] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([ImageFileDirectory] -> Writer [ImageFileDirectory] ())
-> (ImageFileDirectory -> [ImageFileDirectory])
-> ImageFileDirectory
-> Writer [ImageFileDirectory] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImageFileDirectory -> [ImageFileDirectory]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageFileDirectory -> Writer [ImageFileDirectory] ())
-> ImageFileDirectory -> Writer [ImageFileDirectory] ()
forall a b. (a -> b) -> a -> b
$ $WImageFileDirectory :: ExifTag
-> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory
ImageFileDirectory
{ ifdIdentifier :: ExifTag
ifdIdentifier = ExifTag
tag
, ifdType :: IfdType
ifdType = IfdType
TypeLong
, ifdCount :: Word32
ifdCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Vector Word32 -> Int
forall a. Vector a -> Int
V.length Vector Word32
v
, ifdOffset :: Word32
ifdOffset = Word32
offset
, ifdExtended :: ExifData
ifdExtended = ExifData
extended
}
where (offset :: Word32
offset, extended :: ExifData
extended)
| Vector Word32 -> Int
forall a. Vector a -> Int
V.length Vector Word32
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 = (0, Vector Word32 -> ExifData
ExifLongs Vector Word32
v)
| Bool
otherwise = (Vector Word32 -> Word32
forall a. Vector a -> a
V.head Vector Word32
v, ExifData
ExifNone)
ifdMultiShort :: Endianness -> ExifTag -> V.Vector Word32
-> Writer [ImageFileDirectory] ()
ifdMultiShort :: Endianness
-> ExifTag -> Vector Word32 -> Writer [ImageFileDirectory] ()
ifdMultiShort endian :: Endianness
endian tag :: ExifTag
tag v :: Vector Word32
v = [ImageFileDirectory] -> Writer [ImageFileDirectory] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([ImageFileDirectory] -> Writer [ImageFileDirectory] ())
-> (ImageFileDirectory -> [ImageFileDirectory])
-> ImageFileDirectory
-> Writer [ImageFileDirectory] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImageFileDirectory -> [ImageFileDirectory]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageFileDirectory -> Writer [ImageFileDirectory] ())
-> ImageFileDirectory -> Writer [ImageFileDirectory] ()
forall a b. (a -> b) -> a -> b
$ $WImageFileDirectory :: ExifTag
-> IfdType -> Word32 -> Word32 -> ExifData -> ImageFileDirectory
ImageFileDirectory
{ ifdIdentifier :: ExifTag
ifdIdentifier = ExifTag
tag
, ifdType :: IfdType
ifdType = IfdType
TypeShort
, ifdCount :: Word32
ifdCount = Word32
size
, ifdOffset :: Word32
ifdOffset = Word32
offset
, ifdExtended :: ExifData
ifdExtended = ExifData
extended
}
where size :: Word32
size = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Vector Word32 -> Int
forall a. Vector a -> Int
V.length Vector Word32
v
(offset :: Word32
offset, extended :: ExifData
extended)
| Word32
size Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> 2 = (0, Vector Word16 -> ExifData
ExifShorts (Vector Word16 -> ExifData) -> Vector Word16 -> ExifData
forall a b. (a -> b) -> a -> b
$ (Word32 -> Word16) -> Vector Word32 -> Vector Word16
forall a b. (a -> b) -> Vector a -> Vector b
V.map Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Vector Word32
v)
| Word32
size Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 2 =
let v1 :: Word32
v1 = Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Vector Word32 -> Word32
forall a. Vector a -> a
V.head Vector Word32
v
v2 :: Word32
v2 = Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Vector Word32
v Vector Word32 -> Int -> Word32
forall a. Vector a -> Int -> a
`V.unsafeIndex` 1
in
case Endianness
endian of
EndianLittle -> (Word32
v2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
v1, ExifData
ExifNone)
EndianBig -> (Word32
v1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
v2, ExifData
ExifNone)
| Bool
otherwise = case Endianness
endian of
EndianLittle -> (Vector Word32 -> Word32
forall a. Vector a -> a
V.head Vector Word32
v, ExifData
ExifNone)
EndianBig -> (Vector Word32 -> Word32
forall a. Vector a -> a
V.head Vector Word32
v Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 16, ExifData
ExifNone)
instance BinaryParam B.ByteString TiffInfo where
putP :: ByteString -> TiffInfo -> Put
putP rawData :: ByteString
rawData nfo :: TiffInfo
nfo = ByteString -> (TiffHeader, [[ImageFileDirectory]]) -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP ByteString
rawData (TiffInfo -> TiffHeader
tiffHeader TiffInfo
nfo, [[ImageFileDirectory]
list]) where
endianness :: Endianness
endianness = TiffHeader -> Endianness
hdrEndianness (TiffHeader -> Endianness) -> TiffHeader -> Endianness
forall a b. (a -> b) -> a -> b
$ TiffInfo -> TiffHeader
tiffHeader TiffInfo
nfo
ifdShort :: ExifTag -> Word16 -> Writer [ImageFileDirectory] ()
ifdShort = Endianness -> ExifTag -> Word16 -> Writer [ImageFileDirectory] ()
ifdSingleShort Endianness
endianness
ifdShorts :: ExifTag -> Vector Word32 -> Writer [ImageFileDirectory] ()
ifdShorts = Endianness
-> ExifTag -> Vector Word32 -> Writer [ImageFileDirectory] ()
ifdMultiShort Endianness
endianness
list :: [ImageFileDirectory]
list = Writer [ImageFileDirectory] () -> [ImageFileDirectory]
forall w a. Writer w a -> w
execWriter (Writer [ImageFileDirectory] () -> [ImageFileDirectory])
-> Writer [ImageFileDirectory] () -> [ImageFileDirectory]
forall a b. (a -> b) -> a -> b
$ do
ExifTag -> Word32 -> Writer [ImageFileDirectory] ()
ifdSingleLong ExifTag
TagImageWidth (Word32 -> Writer [ImageFileDirectory] ())
-> Word32 -> Writer [ImageFileDirectory] ()
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Word32
tiffWidth TiffInfo
nfo
ExifTag -> Word32 -> Writer [ImageFileDirectory] ()
ifdSingleLong ExifTag
TagImageLength (Word32 -> Writer [ImageFileDirectory] ())
-> Word32 -> Writer [ImageFileDirectory] ()
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Word32
tiffHeight TiffInfo
nfo
ExifTag -> Vector Word32 -> Writer [ImageFileDirectory] ()
ifdShorts ExifTag
TagBitsPerSample (Vector Word32 -> Writer [ImageFileDirectory] ())
-> Vector Word32 -> Writer [ImageFileDirectory] ()
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Vector Word32
tiffBitsPerSample TiffInfo
nfo
ExifTag -> Word32 -> Writer [ImageFileDirectory] ()
ifdSingleLong ExifTag
TagSamplesPerPixel (Word32 -> Writer [ImageFileDirectory] ())
-> Word32 -> Writer [ImageFileDirectory] ()
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Word32
tiffSampleCount TiffInfo
nfo
ExifTag -> Word32 -> Writer [ImageFileDirectory] ()
ifdSingleLong ExifTag
TagRowPerStrip (Word32 -> Writer [ImageFileDirectory] ())
-> Word32 -> Writer [ImageFileDirectory] ()
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Word32
tiffRowPerStrip TiffInfo
nfo
ExifTag -> Word16 -> Writer [ImageFileDirectory] ()
ifdShort ExifTag
TagPhotometricInterpretation
(Word16 -> Writer [ImageFileDirectory] ())
-> (TiffColorspace -> Word16)
-> TiffColorspace
-> Writer [ImageFileDirectory] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TiffColorspace -> Word16
packPhotometricInterpretation
(TiffColorspace -> Writer [ImageFileDirectory] ())
-> TiffColorspace -> Writer [ImageFileDirectory] ()
forall a b. (a -> b) -> a -> b
$ TiffInfo -> TiffColorspace
tiffColorspace TiffInfo
nfo
ExifTag -> Word16 -> Writer [ImageFileDirectory] ()
ifdShort ExifTag
TagPlanarConfiguration
(Word16 -> Writer [ImageFileDirectory] ())
-> (TiffPlanarConfiguration -> Word16)
-> TiffPlanarConfiguration
-> Writer [ImageFileDirectory] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TiffPlanarConfiguration -> Word16
constantToPlaneConfiguration (TiffPlanarConfiguration -> Writer [ImageFileDirectory] ())
-> TiffPlanarConfiguration -> Writer [ImageFileDirectory] ()
forall a b. (a -> b) -> a -> b
$ TiffInfo -> TiffPlanarConfiguration
tiffPlaneConfiguration TiffInfo
nfo
ExifTag -> Vector Word32 -> Writer [ImageFileDirectory] ()
ifdMultiLong ExifTag
TagSampleFormat
(Vector Word32 -> Writer [ImageFileDirectory] ())
-> ([TiffSampleFormat] -> Vector Word32)
-> [TiffSampleFormat]
-> Writer [ImageFileDirectory] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList
([Word32] -> Vector Word32)
-> ([TiffSampleFormat] -> [Word32])
-> [TiffSampleFormat]
-> Vector Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TiffSampleFormat -> Word32) -> [TiffSampleFormat] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map TiffSampleFormat -> Word32
packSampleFormat
([TiffSampleFormat] -> Writer [ImageFileDirectory] ())
-> [TiffSampleFormat] -> Writer [ImageFileDirectory] ()
forall a b. (a -> b) -> a -> b
$ TiffInfo -> [TiffSampleFormat]
tiffSampleFormat TiffInfo
nfo
ExifTag -> Word16 -> Writer [ImageFileDirectory] ()
ifdShort ExifTag
TagCompression (Word16 -> Writer [ImageFileDirectory] ())
-> (TiffCompression -> Word16)
-> TiffCompression
-> Writer [ImageFileDirectory] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TiffCompression -> Word16
packCompression
(TiffCompression -> Writer [ImageFileDirectory] ())
-> TiffCompression -> Writer [ImageFileDirectory] ()
forall a b. (a -> b) -> a -> b
$ TiffInfo -> TiffCompression
tiffCompression TiffInfo
nfo
ExifTag -> Vector Word32 -> Writer [ImageFileDirectory] ()
ifdMultiLong ExifTag
TagStripOffsets (Vector Word32 -> Writer [ImageFileDirectory] ())
-> Vector Word32 -> Writer [ImageFileDirectory] ()
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Vector Word32
tiffOffsets TiffInfo
nfo
ExifTag -> Vector Word32 -> Writer [ImageFileDirectory] ()
ifdMultiLong ExifTag
TagStripByteCounts (Vector Word32 -> Writer [ImageFileDirectory] ())
-> Vector Word32 -> Writer [ImageFileDirectory] ()
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Vector Word32
tiffStripSize TiffInfo
nfo
Writer [ImageFileDirectory] ()
-> (ExtraSample -> Writer [ImageFileDirectory] ())
-> Maybe ExtraSample
-> Writer [ImageFileDirectory] ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Writer [ImageFileDirectory] ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
(ExifTag -> Word16 -> Writer [ImageFileDirectory] ()
ifdShort ExifTag
TagExtraSample (Word16 -> Writer [ImageFileDirectory] ())
-> (ExtraSample -> Word16)
-> ExtraSample
-> Writer [ImageFileDirectory] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtraSample -> Word16
codeOfExtraSample)
(Maybe ExtraSample -> Writer [ImageFileDirectory] ())
-> Maybe ExtraSample -> Writer [ImageFileDirectory] ()
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Maybe ExtraSample
tiffExtraSample TiffInfo
nfo
let subSampling :: Vector Word32
subSampling = TiffInfo -> Vector Word32
tiffYCbCrSubsampling TiffInfo
nfo
Bool
-> Writer [ImageFileDirectory] () -> Writer [ImageFileDirectory] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Vector Word32 -> Bool
forall a. Vector a -> Bool
V.null Vector Word32
subSampling) (Writer [ImageFileDirectory] () -> Writer [ImageFileDirectory] ())
-> Writer [ImageFileDirectory] () -> Writer [ImageFileDirectory] ()
forall a b. (a -> b) -> a -> b
$
ExifTag -> Vector Word32 -> Writer [ImageFileDirectory] ()
ifdShorts ExifTag
TagYCbCrSubsampling Vector Word32
subSampling
getP :: ByteString -> Get TiffInfo
getP rawData :: ByteString
rawData = do
(hdr :: TiffHeader
hdr, [[ImageFileDirectory]]
cleanedFull :: [[ImageFileDirectory]]) <- ByteString -> Get (TiffHeader, [[ImageFileDirectory]])
forall a b. BinaryParam a b => a -> Get b
getP ByteString
rawData
let cleaned :: [ImageFileDirectory]
cleaned = [[ImageFileDirectory]] -> [ImageFileDirectory]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ImageFileDirectory]]
cleanedFull
dataFind :: String -> ExifTag -> Get Word32
dataFind str :: String
str tag :: ExifTag
tag = String -> ExifTag -> [ImageFileDirectory] -> Get Word32
findIFDData String
str ExifTag
tag [ImageFileDirectory]
cleaned
dataDefault :: Word32 -> ExifTag -> Get Word32
dataDefault def :: Word32
def tag :: ExifTag
tag = Word32 -> ExifTag -> [ImageFileDirectory] -> Get Word32
findIFDDefaultData Word32
def ExifTag
tag [ImageFileDirectory]
cleaned
extFind :: String -> ExifTag -> Get ExifData
extFind str :: String
str tag :: ExifTag
tag = String -> ExifTag -> [ImageFileDirectory] -> Get ExifData
findIFDExt String
str ExifTag
tag [ImageFileDirectory]
cleaned
extDefault :: [Word32] -> ExifTag -> Get [Word32]
extDefault def :: [Word32]
def tag :: ExifTag
tag = [Word32] -> ExifTag -> [ImageFileDirectory] -> Get [Word32]
findIFDExtDefaultData [Word32]
def ExifTag
tag [ImageFileDirectory]
cleaned
TiffHeader
-> Word32
-> Word32
-> TiffColorspace
-> Word32
-> Word32
-> TiffPlanarConfiguration
-> [TiffSampleFormat]
-> Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo
TiffInfo TiffHeader
hdr
(Word32
-> Word32
-> TiffColorspace
-> Word32
-> Word32
-> TiffPlanarConfiguration
-> [TiffSampleFormat]
-> Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
-> Get Word32
-> Get
(Word32
-> TiffColorspace
-> Word32
-> Word32
-> TiffPlanarConfiguration
-> [TiffSampleFormat]
-> Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExifTag -> Get Word32
dataFind "Can't find width" ExifTag
TagImageWidth
Get
(Word32
-> TiffColorspace
-> Word32
-> Word32
-> TiffPlanarConfiguration
-> [TiffSampleFormat]
-> Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
-> Get Word32
-> Get
(TiffColorspace
-> Word32
-> Word32
-> TiffPlanarConfiguration
-> [TiffSampleFormat]
-> Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> ExifTag -> Get Word32
dataFind "Can't find height" ExifTag
TagImageLength
Get
(TiffColorspace
-> Word32
-> Word32
-> TiffPlanarConfiguration
-> [TiffSampleFormat]
-> Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
-> Get TiffColorspace
-> Get
(Word32
-> Word32
-> TiffPlanarConfiguration
-> [TiffSampleFormat]
-> Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ExifTag -> Get Word32
dataFind "Can't find color space" ExifTag
TagPhotometricInterpretation
Get Word32 -> (Word32 -> Get TiffColorspace) -> Get TiffColorspace
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32 -> Get TiffColorspace
unpackPhotometricInterpretation)
Get
(Word32
-> Word32
-> TiffPlanarConfiguration
-> [TiffSampleFormat]
-> Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
-> Get Word32
-> Get
(Word32
-> TiffPlanarConfiguration
-> [TiffSampleFormat]
-> Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> ExifTag -> Get Word32
dataFind "Can't find sample per pixel" ExifTag
TagSamplesPerPixel
Get
(Word32
-> TiffPlanarConfiguration
-> [TiffSampleFormat]
-> Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
-> Get Word32
-> Get
(TiffPlanarConfiguration
-> [TiffSampleFormat]
-> Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> ExifTag -> Get Word32
dataFind "Can't find row per strip" ExifTag
TagRowPerStrip
Get
(TiffPlanarConfiguration
-> [TiffSampleFormat]
-> Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
-> Get TiffPlanarConfiguration
-> Get
([TiffSampleFormat]
-> Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word32 -> ExifTag -> Get Word32
dataDefault 1 ExifTag
TagPlanarConfiguration
Get Word32
-> (Word32 -> Get TiffPlanarConfiguration)
-> Get TiffPlanarConfiguration
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32 -> Get TiffPlanarConfiguration
planarConfgOfConstant)
Get
([TiffSampleFormat]
-> Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
-> Get [TiffSampleFormat]
-> Get
(Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Word32] -> ExifTag -> Get [Word32]
extDefault [1] ExifTag
TagSampleFormat
Get [Word32]
-> ([Word32] -> Get [TiffSampleFormat]) -> Get [TiffSampleFormat]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word32 -> Get TiffSampleFormat)
-> [Word32] -> Get [TiffSampleFormat]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Word32 -> Get TiffSampleFormat
unpackSampleFormat)
Get
(Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
-> Get (Vector Word32)
-> Get
(TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ExifTag -> Get ExifData
extFind "Can't find bit per sample" ExifTag
TagBitsPerSample
Get ExifData
-> (ExifData -> Get (Vector Word32)) -> Get (Vector Word32)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExifData -> Get (Vector Word32)
unLong "Can't find bit depth")
Get
(TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
-> Get TiffCompression
-> Get
(Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ExifTag -> Get Word32
dataFind "Can't find Compression" ExifTag
TagCompression
Get Word32
-> (Word32 -> Get TiffCompression) -> Get TiffCompression
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32 -> Get TiffCompression
unPackCompression)
Get
(Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
-> Get (Vector Word32)
-> Get
(Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ExifTag -> Get ExifData
extFind "Can't find byte counts" ExifTag
TagStripByteCounts
Get ExifData
-> (ExifData -> Get (Vector Word32)) -> Get (Vector Word32)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExifData -> Get (Vector Word32)
unLong "Can't find bit per sample")
Get
(Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
-> Get (Vector Word32)
-> Get
(Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> ExifTag -> Get ExifData
extFind "Strip offsets missing" ExifTag
TagStripOffsets
Get ExifData
-> (ExifData -> Get (Vector Word32)) -> Get (Vector Word32)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExifData -> Get (Vector Word32)
unLong "Can't find strip offsets")
Get
(Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo)
-> Get (Maybe (Image PixelRGB16))
-> Get
(Vector Word32
-> Maybe ExtraSample -> Predictor -> Metadatas -> TiffInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ImageFileDirectory] -> Get (Maybe (Image PixelRGB16))
findPalette [ImageFileDirectory]
cleaned
Get
(Vector Word32
-> Maybe ExtraSample -> Predictor -> Metadatas -> TiffInfo)
-> Get (Vector Word32)
-> Get (Maybe ExtraSample -> Predictor -> Metadatas -> TiffInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList ([Word32] -> Vector Word32) -> Get [Word32] -> Get (Vector Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word32] -> ExifTag -> Get [Word32]
extDefault [2, 2] ExifTag
TagYCbCrSubsampling)
Get (Maybe ExtraSample -> Predictor -> Metadatas -> TiffInfo)
-> Get (Maybe ExtraSample)
-> Get (Predictor -> Metadatas -> TiffInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ExtraSample -> Get (Maybe ExtraSample)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ExtraSample
forall a. Maybe a
Nothing
Get (Predictor -> Metadatas -> TiffInfo)
-> Get Predictor -> Get (Metadatas -> TiffInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word32 -> ExifTag -> Get Word32
dataDefault 1 ExifTag
TagPredictor
Get Word32 -> (Word32 -> Get Predictor) -> Get Predictor
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32 -> Get Predictor
predictorOfConstant)
Get (Metadatas -> TiffInfo) -> Get Metadatas -> Get TiffInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Metadatas -> Get Metadatas
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ImageFileDirectory] -> Metadatas
extractTiffMetadata [ImageFileDirectory]
cleaned)
palette16Of :: Image PixelRGB16 -> Palette' PixelRGB16
palette16Of :: Image PixelRGB16 -> Palette' PixelRGB16
palette16Of p :: Image PixelRGB16
p = $WPalette' :: forall px. Int -> Vector (PixelBaseComponent px) -> Palette' px
Palette'
{ _paletteSize :: Int
_paletteSize = Image PixelRGB16 -> Int
forall a. Image a -> Int
imageWidth Image PixelRGB16
p
, _paletteData :: Vector (PixelBaseComponent PixelRGB16)
_paletteData = Image PixelRGB16 -> Vector (PixelBaseComponent PixelRGB16)
forall a. Image a -> Vector (PixelBaseComponent a)
imageData Image PixelRGB16
p
}
unpack :: B.ByteString -> TiffInfo -> Either String PalettedImage
unpack :: ByteString -> TiffInfo -> Either String PalettedImage
unpack file :: ByteString
file nfo :: TiffInfo
nfo@TiffInfo { tiffRowPerStrip :: TiffInfo -> Word32
tiffRowPerStrip = Word32
0 } =
ByteString -> TiffInfo -> Either String PalettedImage
unpack ByteString
file (TiffInfo -> Either String PalettedImage)
-> TiffInfo -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ TiffInfo
nfo { tiffRowPerStrip :: Word32
tiffRowPerStrip = TiffInfo -> Word32
tiffHeight TiffInfo
nfo }
unpack file :: ByteString
file nfo :: TiffInfo
nfo@TiffInfo { tiffColorspace :: TiffInfo -> TiffColorspace
tiffColorspace = TiffColorspace
TiffPaleted
, tiffBitsPerSample :: TiffInfo -> Vector Word32
tiffBitsPerSample = Vector Word32
lst
, tiffSampleFormat :: TiffInfo -> [TiffSampleFormat]
tiffSampleFormat = [TiffSampleFormat]
format
, tiffPalette :: TiffInfo -> Maybe (Image PixelRGB16)
tiffPalette = Just p :: Image PixelRGB16
p
}
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton 8 Bool -> Bool -> Bool
&& [TiffSampleFormat]
format [TiffSampleFormat] -> [TiffSampleFormat] -> Bool
forall a. Eq a => a -> a -> Bool
== [TiffSampleFormat
TiffSampleUint] =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Palette' PixelRGB16 -> PalettedImage)
-> Palette' PixelRGB16
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> Palette' PixelRGB16 -> PalettedImage
PalettedRGB16 (Word8 -> ByteString -> TiffInfo -> Image Word8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips (0 :: Word8) ByteString
file TiffInfo
nfo) (Palette' PixelRGB16 -> Either String PalettedImage)
-> Palette' PixelRGB16 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Image PixelRGB16 -> Palette' PixelRGB16
palette16Of Image PixelRGB16
p
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton 4 Bool -> Bool -> Bool
&& [TiffSampleFormat]
format [TiffSampleFormat] -> [TiffSampleFormat] -> Bool
forall a. Eq a => a -> a -> Bool
== [TiffSampleFormat
TiffSampleUint] =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Palette' PixelRGB16 -> PalettedImage)
-> Palette' PixelRGB16
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> Palette' PixelRGB16 -> PalettedImage
PalettedRGB16 (Pack4 -> ByteString -> TiffInfo -> Image Word8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips Pack4
Pack4 ByteString
file TiffInfo
nfo) (Palette' PixelRGB16 -> Either String PalettedImage)
-> Palette' PixelRGB16 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Image PixelRGB16 -> Palette' PixelRGB16
palette16Of Image PixelRGB16
p
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton 2 Bool -> Bool -> Bool
&& [TiffSampleFormat]
format [TiffSampleFormat] -> [TiffSampleFormat] -> Bool
forall a. Eq a => a -> a -> Bool
== [TiffSampleFormat
TiffSampleUint] =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Palette' PixelRGB16 -> PalettedImage)
-> Palette' PixelRGB16
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> Palette' PixelRGB16 -> PalettedImage
PalettedRGB16 (Pack2 -> ByteString -> TiffInfo -> Image Word8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips Pack2
Pack2 ByteString
file TiffInfo
nfo) (Palette' PixelRGB16 -> Either String PalettedImage)
-> Palette' PixelRGB16 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Image PixelRGB16 -> Palette' PixelRGB16
palette16Of Image PixelRGB16
p
unpack file :: ByteString
file nfo :: TiffInfo
nfo@TiffInfo { tiffColorspace :: TiffInfo -> TiffColorspace
tiffColorspace = TiffColorspace
TiffCMYK
, tiffBitsPerSample :: TiffInfo -> Vector Word32
tiffBitsPerSample = Vector Word32
lst
, tiffSampleFormat :: TiffInfo -> [TiffSampleFormat]
tiffSampleFormat = [TiffSampleFormat]
format }
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [8, 8, 8, 8] Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelCMYK8 -> PalettedImage)
-> Image PixelCMYK8
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelCMYK8 -> DynamicImage)
-> Image PixelCMYK8
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelCMYK8 -> DynamicImage
ImageCMYK8 (Image PixelCMYK8 -> Either String PalettedImage)
-> Image PixelCMYK8 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> TiffInfo -> Image PixelCMYK8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips (0 :: Word8) ByteString
file TiffInfo
nfo
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [16, 16, 16, 16] Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelCMYK16 -> PalettedImage)
-> Image PixelCMYK16
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelCMYK16 -> DynamicImage)
-> Image PixelCMYK16
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelCMYK16 -> DynamicImage
ImageCMYK16 (Image PixelCMYK16 -> Either String PalettedImage)
-> Image PixelCMYK16 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Word16 -> ByteString -> TiffInfo -> Image PixelCMYK16
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips (0 :: Word16) ByteString
file TiffInfo
nfo
unpack file :: ByteString
file nfo :: TiffInfo
nfo@TiffInfo { tiffColorspace :: TiffInfo -> TiffColorspace
tiffColorspace = TiffColorspace
TiffMonochromeWhite0 } = do
PalettedImage
img <- ByteString -> TiffInfo -> Either String PalettedImage
unpack ByteString
file (TiffInfo
nfo { tiffColorspace :: TiffColorspace
tiffColorspace = TiffColorspace
TiffMonochrome })
case PalettedImage
img of
TrueColorImage (ImageY8 i :: Image Word8
i) -> PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image Word8 -> PalettedImage)
-> Image Word8
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image Word8 -> DynamicImage) -> Image Word8 -> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> DynamicImage
ImageY8 (Image Word8 -> Either String PalettedImage)
-> Image Word8 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8) -> Image Word8 -> Image Word8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap (Word8
forall a. Bounded a => a
maxBound Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-) Image Word8
i
TrueColorImage (ImageY16 i :: Image Word16
i) -> PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image Word16 -> PalettedImage)
-> Image Word16
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image Word16 -> DynamicImage) -> Image Word16 -> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word16 -> DynamicImage
ImageY16 (Image Word16 -> Either String PalettedImage)
-> Image Word16 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ (Word16 -> Word16) -> Image Word16 -> Image Word16
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap (Word16
forall a. Bounded a => a
maxBound Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
-) Image Word16
i
TrueColorImage (ImageYA8 i :: Image PixelYA8
i) -> let negative :: PixelYA8 -> PixelYA8
negative (PixelYA8 y :: Word8
y a :: Word8
a) = Word8 -> Word8 -> PixelYA8
PixelYA8 (Word8
forall a. Bounded a => a
maxBound Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
y) Word8
a
in PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelYA8 -> PalettedImage)
-> Image PixelYA8
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelYA8 -> DynamicImage)
-> Image PixelYA8
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelYA8 -> DynamicImage
ImageYA8 (Image PixelYA8 -> Either String PalettedImage)
-> Image PixelYA8 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ (PixelYA8 -> PixelYA8) -> Image PixelYA8 -> Image PixelYA8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelYA8 -> PixelYA8
negative Image PixelYA8
i
TrueColorImage (ImageYA16 i :: Image PixelYA16
i) -> let negative :: PixelYA16 -> PixelYA16
negative (PixelYA16 y :: Word16
y a :: Word16
a) = Word16 -> Word16 -> PixelYA16
PixelYA16 (Word16
forall a. Bounded a => a
maxBound Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
y) Word16
a
in PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelYA16 -> PalettedImage)
-> Image PixelYA16
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelYA16 -> DynamicImage)
-> Image PixelYA16
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelYA16 -> DynamicImage
ImageYA16 (Image PixelYA16 -> Either String PalettedImage)
-> Image PixelYA16 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ (PixelYA16 -> PixelYA16) -> Image PixelYA16 -> Image PixelYA16
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelYA16 -> PixelYA16
negative Image PixelYA16
i
_ -> String -> Either String PalettedImage
forall a b. a -> Either a b
Left "Unsupported color type used with colorspace MonochromeWhite0"
unpack file :: ByteString
file nfo :: TiffInfo
nfo@TiffInfo { tiffColorspace :: TiffInfo -> TiffColorspace
tiffColorspace = TiffColorspace
TiffMonochrome
, tiffBitsPerSample :: TiffInfo -> Vector Word32
tiffBitsPerSample = Vector Word32
lst
, tiffSampleFormat :: TiffInfo -> [TiffSampleFormat]
tiffSampleFormat = [TiffSampleFormat]
format }
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton 2 Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image Word8 -> PalettedImage)
-> Image Word8
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image Word8 -> DynamicImage) -> Image Word8 -> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> DynamicImage
ImageY8 (Image Word8 -> DynamicImage)
-> (Image Word8 -> Image Word8) -> Image Word8 -> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8) -> Image Word8 -> Image Word8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap ((PixelBaseComponent Word8 -> PixelBaseComponent Word8)
-> Word8 -> Word8
forall a.
Pixel a =>
(PixelBaseComponent a -> PixelBaseComponent a) -> a -> a
colorMap (0x55 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
*)) (Image Word8 -> Either String PalettedImage)
-> Image Word8 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Pack2 -> ByteString -> TiffInfo -> Image Word8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips Pack2
Pack2 ByteString
file TiffInfo
nfo
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton 4 Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image Word8 -> PalettedImage)
-> Image Word8
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image Word8 -> DynamicImage) -> Image Word8 -> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> DynamicImage
ImageY8 (Image Word8 -> DynamicImage)
-> (Image Word8 -> Image Word8) -> Image Word8 -> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8) -> Image Word8 -> Image Word8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap ((PixelBaseComponent Word8 -> PixelBaseComponent Word8)
-> Word8 -> Word8
forall a.
Pixel a =>
(PixelBaseComponent a -> PixelBaseComponent a) -> a -> a
colorMap (0x11 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
*)) (Image Word8 -> Either String PalettedImage)
-> Image Word8 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Pack4 -> ByteString -> TiffInfo -> Image Word8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips Pack4
Pack4 ByteString
file TiffInfo
nfo
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton 8 Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image Word8 -> PalettedImage)
-> Image Word8
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image Word8 -> DynamicImage) -> Image Word8 -> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> DynamicImage
ImageY8 (Image Word8 -> Either String PalettedImage)
-> Image Word8 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> TiffInfo -> Image Word8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips (0 :: Word8) ByteString
file TiffInfo
nfo
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton 12 Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image Word16 -> PalettedImage)
-> Image Word16
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image Word16 -> DynamicImage) -> Image Word16 -> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word16 -> DynamicImage
ImageY16 (Image Word16 -> DynamicImage)
-> (Image Word16 -> Image Word16) -> Image Word16 -> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Word16) -> Image Word16 -> Image Word16
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap ((PixelBaseComponent Word16 -> PixelBaseComponent Word16)
-> Word16 -> Word16
forall a.
Pixel a =>
(PixelBaseComponent a -> PixelBaseComponent a) -> a -> a
colorMap PixelBaseComponent Word16 -> PixelBaseComponent Word16
forall a. (Num a, Bits a) => a -> a
expand12to16) (Image Word16 -> Either String PalettedImage)
-> Image Word16 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Pack12 -> ByteString -> TiffInfo -> Image Word16
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips Pack12
Pack12 ByteString
file TiffInfo
nfo
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton 16 Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image Word16 -> PalettedImage)
-> Image Word16
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image Word16 -> DynamicImage) -> Image Word16 -> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word16 -> DynamicImage
ImageY16 (Image Word16 -> Either String PalettedImage)
-> Image Word16 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Word16 -> ByteString -> TiffInfo -> Image Word16
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips (0 :: Word16) ByteString
file TiffInfo
nfo
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton 32 Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
let img :: Image Word32
img = Word32 -> ByteString -> TiffInfo -> Image Word32
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips (0 :: Word32) ByteString
file TiffInfo
nfo :: Image Pixel32
in PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> PalettedImage -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage) -> DynamicImage -> PalettedImage
forall a b. (a -> b) -> a -> b
$ Image Word32 -> DynamicImage
ImageY32 (Image Word32 -> DynamicImage) -> Image Word32 -> DynamicImage
forall a b. (a -> b) -> a -> b
$ Image Word32
img
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton 32 Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleFloat TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
let img :: Image Float
img = Float -> ByteString -> TiffInfo -> Image Float
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips (0 :: Float) ByteString
file TiffInfo
nfo :: Image PixelF
in PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> PalettedImage -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage) -> DynamicImage -> PalettedImage
forall a b. (a -> b) -> a -> b
$ Image Float -> DynamicImage
ImageYF (Image Float -> DynamicImage) -> Image Float -> DynamicImage
forall a b. (a -> b) -> a -> b
$ Image Float
img
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton 64 = String -> Either String PalettedImage
forall a b. a -> Either a b
Left "Failure to unpack TIFF file, 64-bit samples unsupported."
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [2, 2] Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelYA8 -> PalettedImage)
-> Image PixelYA8
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelYA8 -> DynamicImage)
-> Image PixelYA8
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelYA8 -> DynamicImage
ImageYA8 (Image PixelYA8 -> DynamicImage)
-> (Image PixelYA8 -> Image PixelYA8)
-> Image PixelYA8
-> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PixelYA8 -> PixelYA8) -> Image PixelYA8 -> Image PixelYA8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap ((PixelBaseComponent PixelYA8 -> PixelBaseComponent PixelYA8)
-> PixelYA8 -> PixelYA8
forall a.
Pixel a =>
(PixelBaseComponent a -> PixelBaseComponent a) -> a -> a
colorMap (0x55 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
*)) (Image PixelYA8 -> Either String PalettedImage)
-> Image PixelYA8 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Pack2 -> ByteString -> TiffInfo -> Image PixelYA8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips Pack2
Pack2 ByteString
file TiffInfo
nfo
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [4, 4] Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelYA8 -> PalettedImage)
-> Image PixelYA8
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelYA8 -> DynamicImage)
-> Image PixelYA8
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelYA8 -> DynamicImage
ImageYA8 (Image PixelYA8 -> DynamicImage)
-> (Image PixelYA8 -> Image PixelYA8)
-> Image PixelYA8
-> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PixelYA8 -> PixelYA8) -> Image PixelYA8 -> Image PixelYA8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap ((PixelBaseComponent PixelYA8 -> PixelBaseComponent PixelYA8)
-> PixelYA8 -> PixelYA8
forall a.
Pixel a =>
(PixelBaseComponent a -> PixelBaseComponent a) -> a -> a
colorMap (0x11 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
*)) (Image PixelYA8 -> Either String PalettedImage)
-> Image PixelYA8 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Pack4 -> ByteString -> TiffInfo -> Image PixelYA8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips Pack4
Pack4 ByteString
file TiffInfo
nfo
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [8, 8] Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelYA8 -> PalettedImage)
-> Image PixelYA8
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelYA8 -> DynamicImage)
-> Image PixelYA8
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelYA8 -> DynamicImage
ImageYA8 (Image PixelYA8 -> Either String PalettedImage)
-> Image PixelYA8 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> TiffInfo -> Image PixelYA8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips (0 :: Word8) ByteString
file TiffInfo
nfo
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [12, 12] Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelYA16 -> PalettedImage)
-> Image PixelYA16
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelYA16 -> DynamicImage)
-> Image PixelYA16
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelYA16 -> DynamicImage
ImageYA16 (Image PixelYA16 -> DynamicImage)
-> (Image PixelYA16 -> Image PixelYA16)
-> Image PixelYA16
-> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PixelYA16 -> PixelYA16) -> Image PixelYA16 -> Image PixelYA16
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap ((PixelBaseComponent PixelYA16 -> PixelBaseComponent PixelYA16)
-> PixelYA16 -> PixelYA16
forall a.
Pixel a =>
(PixelBaseComponent a -> PixelBaseComponent a) -> a -> a
colorMap PixelBaseComponent PixelYA16 -> PixelBaseComponent PixelYA16
forall a. (Num a, Bits a) => a -> a
expand12to16) (Image PixelYA16 -> Either String PalettedImage)
-> Image PixelYA16 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Pack12 -> ByteString -> TiffInfo -> Image PixelYA16
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips Pack12
Pack12 ByteString
file TiffInfo
nfo
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [16, 16] Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelYA16 -> PalettedImage)
-> Image PixelYA16
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelYA16 -> DynamicImage)
-> Image PixelYA16
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelYA16 -> DynamicImage
ImageYA16 (Image PixelYA16 -> Either String PalettedImage)
-> Image PixelYA16 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Word16 -> ByteString -> TiffInfo -> Image PixelYA16
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips (0 :: Word16) ByteString
file TiffInfo
nfo
where
expand12to16 :: a -> a
expand12to16 x :: a
x = a
x a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 4 a -> a -> a
forall a. Num a => a -> a -> a
+ a
x a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (12 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 4)
unpack file :: ByteString
file nfo :: TiffInfo
nfo@TiffInfo { tiffColorspace :: TiffInfo -> TiffColorspace
tiffColorspace = TiffColorspace
TiffYCbCr
, tiffBitsPerSample :: TiffInfo -> Vector Word32
tiffBitsPerSample = Vector Word32
lst
, tiffPlaneConfiguration :: TiffInfo -> TiffPlanarConfiguration
tiffPlaneConfiguration = TiffPlanarConfiguration
PlanarConfigContig
, tiffSampleFormat :: TiffInfo -> [TiffSampleFormat]
tiffSampleFormat = [TiffSampleFormat]
format }
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [8, 8, 8] Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelYCbCr8 -> PalettedImage)
-> Image PixelYCbCr8
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelYCbCr8 -> DynamicImage)
-> Image PixelYCbCr8
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelYCbCr8 -> DynamicImage
ImageYCbCr8 (Image PixelYCbCr8 -> Either String PalettedImage)
-> Image PixelYCbCr8 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ YCbCrSubsampling -> ByteString -> TiffInfo -> Image PixelYCbCr8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips YCbCrSubsampling
cbcrConf ByteString
file TiffInfo
nfo
where defaulting :: p -> p
defaulting 0 = 2
defaulting n :: p
n = p
n
w :: Word32
w = Word32 -> Word32
forall p. (Eq p, Num p) => p -> p
defaulting (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Vector Word32
tiffYCbCrSubsampling TiffInfo
nfo Vector Word32 -> Int -> Word32
forall a. Vector a -> Int -> a
V.! 0
h :: Word32
h = Word32 -> Word32
forall p. (Eq p, Num p) => p -> p
defaulting (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Vector Word32
tiffYCbCrSubsampling TiffInfo
nfo Vector Word32 -> Int -> Word32
forall a. Vector a -> Int -> a
V.! 1
cbcrConf :: YCbCrSubsampling
cbcrConf = $WYCbCrSubsampling :: Int -> Int -> Int -> Int -> YCbCrSubsampling
YCbCrSubsampling
{ ycbcrWidth :: Int
ycbcrWidth = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w
, ycbcrHeight :: Int
ycbcrHeight = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
h
, ycbcrImageWidth :: Int
ycbcrImageWidth = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Word32
tiffWidth TiffInfo
nfo
, ycbcrStripHeight :: Int
ycbcrStripHeight = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ TiffInfo -> Word32
tiffRowPerStrip TiffInfo
nfo
}
unpack file :: ByteString
file nfo :: TiffInfo
nfo@TiffInfo { tiffColorspace :: TiffInfo -> TiffColorspace
tiffColorspace = TiffColorspace
TiffRGB
, tiffBitsPerSample :: TiffInfo -> Vector Word32
tiffBitsPerSample = Vector Word32
lst
, tiffSampleFormat :: TiffInfo -> [TiffSampleFormat]
tiffSampleFormat = [TiffSampleFormat]
format }
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [2, 2, 2] Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelRGB8 -> PalettedImage)
-> Image PixelRGB8
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> DynamicImage)
-> (Image PixelRGB8 -> Image PixelRGB8)
-> Image PixelRGB8
-> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PixelRGB8 -> PixelRGB8) -> Image PixelRGB8 -> Image PixelRGB8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap ((PixelBaseComponent PixelRGB8 -> PixelBaseComponent PixelRGB8)
-> PixelRGB8 -> PixelRGB8
forall a.
Pixel a =>
(PixelBaseComponent a -> PixelBaseComponent a) -> a -> a
colorMap (0x55 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
*)) (Image PixelRGB8 -> Either String PalettedImage)
-> Image PixelRGB8 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Pack2 -> ByteString -> TiffInfo -> Image PixelRGB8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips Pack2
Pack2 ByteString
file TiffInfo
nfo
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [4, 4, 4] Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelRGB8 -> PalettedImage)
-> Image PixelRGB8
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> DynamicImage)
-> (Image PixelRGB8 -> Image PixelRGB8)
-> Image PixelRGB8
-> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PixelRGB8 -> PixelRGB8) -> Image PixelRGB8 -> Image PixelRGB8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap ((PixelBaseComponent PixelRGB8 -> PixelBaseComponent PixelRGB8)
-> PixelRGB8 -> PixelRGB8
forall a.
Pixel a =>
(PixelBaseComponent a -> PixelBaseComponent a) -> a -> a
colorMap (0x11 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
*)) (Image PixelRGB8 -> Either String PalettedImage)
-> Image PixelRGB8 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Pack4 -> ByteString -> TiffInfo -> Image PixelRGB8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips Pack4
Pack4 ByteString
file TiffInfo
nfo
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [8, 8, 8] Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelRGB8 -> PalettedImage)
-> Image PixelRGB8
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> Either String PalettedImage)
-> Image PixelRGB8 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> TiffInfo -> Image PixelRGB8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips (0 :: Word8) ByteString
file TiffInfo
nfo
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [8, 8, 8, 8] Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelRGBA8 -> PalettedImage)
-> Image PixelRGBA8
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelRGBA8 -> DynamicImage)
-> Image PixelRGBA8
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBA8 -> DynamicImage
ImageRGBA8 (Image PixelRGBA8 -> Either String PalettedImage)
-> Image PixelRGBA8 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> TiffInfo -> Image PixelRGBA8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips (0 :: Word8) ByteString
file TiffInfo
nfo
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [16, 16, 16] Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelRGB16 -> PalettedImage)
-> Image PixelRGB16
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelRGB16 -> DynamicImage)
-> Image PixelRGB16
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB16 -> DynamicImage
ImageRGB16 (Image PixelRGB16 -> Either String PalettedImage)
-> Image PixelRGB16 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Word16 -> ByteString -> TiffInfo -> Image PixelRGB16
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips (0 :: Word16) ByteString
file TiffInfo
nfo
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [16, 16, 16, 16] Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelRGBA16 -> PalettedImage)
-> Image PixelRGBA16
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelRGBA16 -> DynamicImage)
-> Image PixelRGBA16
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBA16 -> DynamicImage
ImageRGBA16 (Image PixelRGBA16 -> Either String PalettedImage)
-> Image PixelRGBA16 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Word16 -> ByteString -> TiffInfo -> Image PixelRGBA16
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips (0 :: Word16) ByteString
file TiffInfo
nfo
unpack file :: ByteString
file nfo :: TiffInfo
nfo@TiffInfo { tiffColorspace :: TiffInfo -> TiffColorspace
tiffColorspace = TiffColorspace
TiffMonochrome
, tiffBitsPerSample :: TiffInfo -> Vector Word32
tiffBitsPerSample = Vector Word32
lst
, tiffSampleFormat :: TiffInfo -> [TiffSampleFormat]
tiffSampleFormat = [TiffSampleFormat]
format }
| Vector Word32
lst Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList [8, 8, 8] Bool -> Bool -> Bool
&& (TiffSampleFormat -> Bool) -> [TiffSampleFormat] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TiffSampleFormat
TiffSampleUint TiffSampleFormat -> TiffSampleFormat -> Bool
forall a. Eq a => a -> a -> Bool
==) [TiffSampleFormat]
format =
PalettedImage -> Either String PalettedImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PalettedImage -> Either String PalettedImage)
-> (Image PixelRGB8 -> PalettedImage)
-> Image PixelRGB8
-> Either String PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage (DynamicImage -> PalettedImage)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> PalettedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> Either String PalettedImage)
-> Image PixelRGB8 -> Either String PalettedImage
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> TiffInfo -> Image PixelRGB8
forall comp pixel.
(Unpackable comp, Pixel pixel,
StorageType comp ~ PixelBaseComponent pixel) =>
comp -> ByteString -> TiffInfo -> Image pixel
gatherStrips (0 :: Word8) ByteString
file TiffInfo
nfo
unpack _ _ = String -> Either String PalettedImage
forall a b. a -> Either a b
Left "Failure to unpack TIFF file"
decodeTiff :: B.ByteString -> Either String DynamicImage
decodeTiff :: ByteString -> Either String DynamicImage
decodeTiff = ((DynamicImage, Metadatas) -> DynamicImage)
-> Either String (DynamicImage, Metadatas)
-> Either String DynamicImage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DynamicImage, Metadatas) -> DynamicImage
forall a b. (a, b) -> a
fst (Either String (DynamicImage, Metadatas)
-> Either String DynamicImage)
-> (ByteString -> Either String (DynamicImage, Metadatas))
-> ByteString
-> Either String DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (DynamicImage, Metadatas)
decodeTiffWithMetadata
decodeTiffWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas)
decodeTiffWithMetadata :: ByteString -> Either String (DynamicImage, Metadatas)
decodeTiffWithMetadata str :: ByteString
str = (PalettedImage -> DynamicImage)
-> (PalettedImage, Metadatas) -> (DynamicImage, Metadatas)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first PalettedImage -> DynamicImage
palettedToTrueColor ((PalettedImage, Metadatas) -> (DynamicImage, Metadatas))
-> Either String (PalettedImage, Metadatas)
-> Either String (DynamicImage, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String (PalettedImage, Metadatas)
decodeTiffWithPaletteAndMetadata ByteString
str
decodeTiffWithPaletteAndMetadata :: B.ByteString -> Either String (PalettedImage, Metadatas)
decodeTiffWithPaletteAndMetadata :: ByteString -> Either String (PalettedImage, Metadatas)
decodeTiffWithPaletteAndMetadata file :: ByteString
file = Get TiffInfo -> ByteString -> Either String TiffInfo
forall a. Get a -> ByteString -> Either String a
runGetStrict (ByteString -> Get TiffInfo
forall a b. BinaryParam a b => a -> Get b
getP ByteString
file) ByteString
file Either String TiffInfo
-> (TiffInfo -> Either String (PalettedImage, Metadatas))
-> Either String (PalettedImage, Metadatas)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TiffInfo -> Either String (PalettedImage, Metadatas)
go
where
go :: TiffInfo -> Either String (PalettedImage, Metadatas)
go tinfo :: TiffInfo
tinfo = (, TiffInfo -> Metadatas
tiffMetadatas TiffInfo
tinfo) (PalettedImage -> (PalettedImage, Metadatas))
-> Either String PalettedImage
-> Either String (PalettedImage, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> TiffInfo -> Either String PalettedImage
unpack ByteString
file TiffInfo
tinfo
class (Pixel px) => TiffSaveable px where
colorSpaceOfPixel :: px -> TiffColorspace
:: px -> Maybe ExtraSample
extraSampleCodeOfPixel _ = Maybe ExtraSample
forall a. Maybe a
Nothing
subSamplingInfo :: px -> V.Vector Word32
subSamplingInfo _ = Vector Word32
forall a. Vector a
V.empty
sampleFormat :: px -> [TiffSampleFormat]
sampleFormat _ = [TiffSampleFormat
TiffSampleUint]
instance TiffSaveable Pixel8 where
colorSpaceOfPixel :: Word8 -> TiffColorspace
colorSpaceOfPixel _ = TiffColorspace
TiffMonochrome
instance TiffSaveable Pixel16 where
colorSpaceOfPixel :: Word16 -> TiffColorspace
colorSpaceOfPixel _ = TiffColorspace
TiffMonochrome
instance TiffSaveable Pixel32 where
colorSpaceOfPixel :: Word32 -> TiffColorspace
colorSpaceOfPixel _ = TiffColorspace
TiffMonochrome
instance TiffSaveable PixelF where
colorSpaceOfPixel :: Float -> TiffColorspace
colorSpaceOfPixel _ = TiffColorspace
TiffMonochrome
sampleFormat :: Float -> [TiffSampleFormat]
sampleFormat _ = [TiffSampleFormat
TiffSampleFloat]
instance TiffSaveable PixelYA8 where
colorSpaceOfPixel :: PixelYA8 -> TiffColorspace
colorSpaceOfPixel _ = TiffColorspace
TiffMonochrome
extraSampleCodeOfPixel :: PixelYA8 -> Maybe ExtraSample
extraSampleCodeOfPixel _ = ExtraSample -> Maybe ExtraSample
forall a. a -> Maybe a
Just ExtraSample
ExtraSampleUnassociatedAlpha
instance TiffSaveable PixelYA16 where
colorSpaceOfPixel :: PixelYA16 -> TiffColorspace
colorSpaceOfPixel _ = TiffColorspace
TiffMonochrome
extraSampleCodeOfPixel :: PixelYA16 -> Maybe ExtraSample
extraSampleCodeOfPixel _ = ExtraSample -> Maybe ExtraSample
forall a. a -> Maybe a
Just ExtraSample
ExtraSampleUnassociatedAlpha
instance TiffSaveable PixelCMYK8 where
colorSpaceOfPixel :: PixelCMYK8 -> TiffColorspace
colorSpaceOfPixel _ = TiffColorspace
TiffCMYK
instance TiffSaveable PixelCMYK16 where
colorSpaceOfPixel :: PixelCMYK16 -> TiffColorspace
colorSpaceOfPixel _ = TiffColorspace
TiffCMYK
instance TiffSaveable PixelRGB8 where
colorSpaceOfPixel :: PixelRGB8 -> TiffColorspace
colorSpaceOfPixel _ = TiffColorspace
TiffRGB
instance TiffSaveable PixelRGB16 where
colorSpaceOfPixel :: PixelRGB16 -> TiffColorspace
colorSpaceOfPixel _ = TiffColorspace
TiffRGB
instance TiffSaveable PixelRGBA8 where
colorSpaceOfPixel :: PixelRGBA8 -> TiffColorspace
colorSpaceOfPixel _ = TiffColorspace
TiffRGB
extraSampleCodeOfPixel :: PixelRGBA8 -> Maybe ExtraSample
extraSampleCodeOfPixel _ = ExtraSample -> Maybe ExtraSample
forall a. a -> Maybe a
Just ExtraSample
ExtraSampleUnassociatedAlpha
instance TiffSaveable PixelRGBA16 where
colorSpaceOfPixel :: PixelRGBA16 -> TiffColorspace
colorSpaceOfPixel _ = TiffColorspace
TiffRGB
extraSampleCodeOfPixel :: PixelRGBA16 -> Maybe ExtraSample
extraSampleCodeOfPixel _ = ExtraSample -> Maybe ExtraSample
forall a. a -> Maybe a
Just ExtraSample
ExtraSampleUnassociatedAlpha
instance TiffSaveable PixelYCbCr8 where
colorSpaceOfPixel :: PixelYCbCr8 -> TiffColorspace
colorSpaceOfPixel _ = TiffColorspace
TiffYCbCr
subSamplingInfo :: PixelYCbCr8 -> Vector Word32
subSamplingInfo _ = Int -> [Word32] -> Vector Word32
forall a. Int -> [a] -> Vector a
V.fromListN 2 [1, 1]
encodeTiff :: forall px. (TiffSaveable px) => Image px -> Lb.ByteString
encodeTiff :: Image px -> ByteString
encodeTiff img :: Image px
img = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> TiffInfo -> Put
forall a b. BinaryParam a b => a -> b -> Put
putP ByteString
rawPixelData TiffInfo
hdr
where intSampleCount :: Int
intSampleCount = px -> Int
forall a. Pixel a => a -> Int
componentCount (px
forall a. HasCallStack => a
undefined :: px)
sampleCount :: Word32
sampleCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
intSampleCount
sampleType :: PixelBaseComponent px
sampleType = PixelBaseComponent px
forall a. HasCallStack => a
undefined :: PixelBaseComponent px
pixelData :: Vector (PixelBaseComponent px)
pixelData = Image px -> Vector (PixelBaseComponent px)
forall a. Image a -> Vector (PixelBaseComponent a)
imageData Image px
img
rawPixelData :: ByteString
rawPixelData = Vector (PixelBaseComponent px) -> ByteString
forall a. Storable a => Vector a -> ByteString
toByteString Vector (PixelBaseComponent px)
pixelData
width :: Word32
width = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Image px -> Int
forall a. Image a -> Int
imageWidth Image px
img
height :: Word32
height = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Image px -> Int
forall a. Image a -> Int
imageHeight Image px
img
intSampleSize :: Int
intSampleSize = PixelBaseComponent px -> Int
forall a. Storable a => a -> Int
sizeOf PixelBaseComponent px
sampleType
sampleSize :: Word32
sampleSize = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
intSampleSize
bitPerSample :: Word32
bitPerSample = Word32
sampleSize Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* 8
imageSize :: Word32
imageSize = Word32
width Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
height Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
sampleCount Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
sampleSize
headerSize :: Word32
headerSize = 8
hdr :: TiffInfo
hdr = TiffInfo :: TiffHeader
-> Word32
-> Word32
-> TiffColorspace
-> Word32
-> Word32
-> TiffPlanarConfiguration
-> [TiffSampleFormat]
-> Vector Word32
-> TiffCompression
-> Vector Word32
-> Vector Word32
-> Maybe (Image PixelRGB16)
-> Vector Word32
-> Maybe ExtraSample
-> Predictor
-> Metadatas
-> TiffInfo
TiffInfo
{ tiffHeader :: TiffHeader
tiffHeader = $WTiffHeader :: Endianness -> Word32 -> TiffHeader
TiffHeader
{ hdrEndianness :: Endianness
hdrEndianness = Endianness
EndianLittle
, hdrOffset :: Word32
hdrOffset = Word32
headerSize Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
imageSize
}
, tiffWidth :: Word32
tiffWidth = Word32
width
, tiffHeight :: Word32
tiffHeight = Word32
height
, tiffColorspace :: TiffColorspace
tiffColorspace = px -> TiffColorspace
forall px. TiffSaveable px => px -> TiffColorspace
colorSpaceOfPixel (px
forall a. HasCallStack => a
undefined :: px)
, tiffSampleCount :: Word32
tiffSampleCount = Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sampleCount
, tiffRowPerStrip :: Word32
tiffRowPerStrip = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Image px -> Int
forall a. Image a -> Int
imageHeight Image px
img
, tiffPlaneConfiguration :: TiffPlanarConfiguration
tiffPlaneConfiguration = TiffPlanarConfiguration
PlanarConfigContig
, tiffSampleFormat :: [TiffSampleFormat]
tiffSampleFormat = px -> [TiffSampleFormat]
forall px. TiffSaveable px => px -> [TiffSampleFormat]
sampleFormat (px
forall a. HasCallStack => a
undefined :: px)
, tiffBitsPerSample :: Vector Word32
tiffBitsPerSample = Int -> Word32 -> Vector Word32
forall a. Int -> a -> Vector a
V.replicate Int
intSampleCount Word32
bitPerSample
, tiffCompression :: TiffCompression
tiffCompression = TiffCompression
CompressionNone
, tiffStripSize :: Vector Word32
tiffStripSize = Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton Word32
imageSize
, tiffOffsets :: Vector Word32
tiffOffsets = Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton Word32
headerSize
, tiffPalette :: Maybe (Image PixelRGB16)
tiffPalette = Maybe (Image PixelRGB16)
forall a. Maybe a
Nothing
, tiffYCbCrSubsampling :: Vector Word32
tiffYCbCrSubsampling = px -> Vector Word32
forall px. TiffSaveable px => px -> Vector Word32
subSamplingInfo (px
forall a. HasCallStack => a
undefined :: px)
, tiffExtraSample :: Maybe ExtraSample
tiffExtraSample = px -> Maybe ExtraSample
forall px. TiffSaveable px => px -> Maybe ExtraSample
extraSampleCodeOfPixel (px
forall a. HasCallStack => a
undefined :: px)
, tiffPredictor :: Predictor
tiffPredictor = Predictor
PredictorNone
, tiffMetadatas :: Metadatas
tiffMetadatas = Metadatas
forall a. Monoid a => a
mempty
}
writeTiff :: (TiffSaveable pixel) => FilePath -> Image pixel -> IO ()
writeTiff :: String -> Image pixel -> IO ()
writeTiff path :: String
path img :: Image pixel
img = String -> ByteString -> IO ()
Lb.writeFile String
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Image pixel -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff Image pixel
img
{-# ANN module "HLint: ignore Reduce duplication" #-}