{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE CPP #-}
-- | Module implementing function to read and write

-- Targa (*.tga) files.

module Codec.Picture.Tga( decodeTga
                        , decodeTgaWithMetadata
                        , decodeTgaWithPaletteAndMetadata
                        , TgaSaveable
                        , encodeTga
                        , writeTga
                        )  where

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid( mempty )
import Control.Applicative( (<*>), pure, (<$>) )
#endif

import Control.Arrow( first )
import Control.Monad.ST( ST, runST )
import Data.Bits( (.&.)
                , (.|.)
                , bit
                , testBit
                , setBit
                , unsafeShiftL
                , unsafeShiftR )
import Data.Word( Word8, Word16 )
import Data.Binary( Binary( .. ), encode )
import Data.Binary.Get( Get
                      , getByteString 
                      , getWord8
                      , getWord16le
                      )
import Data.Binary.Put( putWord8
                      , putWord16le
                      , putByteString
                      )

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as Lb
import qualified Data.ByteString.Unsafe as U
import qualified Data.Vector.Storable.Mutable as M

import Codec.Picture.Types
import Codec.Picture.InternalHelper
import Codec.Picture.Metadata( Metadatas
                             , SourceFormat( SourceTGA )
                             , basicMetadata )
import Codec.Picture.VectorByteConversion

data TgaColorMapType
  = ColorMapWithoutTable
  | ColorMapWithTable
  | ColorMapUnknown Word8

instance Binary TgaColorMapType where
  get :: Get TgaColorMapType
get = do
    Word8
v <- Get Word8
getWord8
    TgaColorMapType -> Get TgaColorMapType
forall (m :: * -> *) a. Monad m => a -> m a
return (TgaColorMapType -> Get TgaColorMapType)
-> TgaColorMapType -> Get TgaColorMapType
forall a b. (a -> b) -> a -> b
$ case Word8
v of
      Word8
0 -> TgaColorMapType
ColorMapWithoutTable
      Word8
1 -> TgaColorMapType
ColorMapWithTable
      Word8
n -> Word8 -> TgaColorMapType
ColorMapUnknown Word8
n

  put :: TgaColorMapType -> Put
put TgaColorMapType
v = case TgaColorMapType
v of
    TgaColorMapType
ColorMapWithoutTable -> Word8 -> Put
putWord8 Word8
0
    TgaColorMapType
ColorMapWithTable -> Word8 -> Put
putWord8 Word8
1
    (ColorMapUnknown Word8
vv) -> Word8 -> Put
putWord8 Word8
vv

data TgaImageType
  = ImageTypeNoData Bool
  | ImageTypeColorMapped Bool
  | ImageTypeTrueColor Bool
  | ImageTypeMonochrome Bool

isRleEncoded :: TgaImageType -> Bool
isRleEncoded :: TgaImageType -> Bool
isRleEncoded TgaImageType
v = case TgaImageType
v of
  ImageTypeNoData      Bool
yn -> Bool
yn
  ImageTypeColorMapped Bool
yn -> Bool
yn
  ImageTypeTrueColor   Bool
yn -> Bool
yn
  ImageTypeMonochrome  Bool
yn -> Bool
yn

imageTypeOfCode :: Word8 -> Get TgaImageType
imageTypeOfCode :: Word8 -> Get TgaImageType
imageTypeOfCode Word8
v = case Word8
v Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
3 of
    Word8
0 -> TgaImageType -> Get TgaImageType
forall (m :: * -> *) a. Monad m => a -> m a
return (TgaImageType -> Get TgaImageType)
-> TgaImageType -> Get TgaImageType
forall a b. (a -> b) -> a -> b
$ Bool -> TgaImageType
ImageTypeNoData Bool
isEncoded
    Word8
1 -> TgaImageType -> Get TgaImageType
forall (m :: * -> *) a. Monad m => a -> m a
return (TgaImageType -> Get TgaImageType)
-> TgaImageType -> Get TgaImageType
forall a b. (a -> b) -> a -> b
$ Bool -> TgaImageType
ImageTypeColorMapped Bool
isEncoded
    Word8
2 -> TgaImageType -> Get TgaImageType
forall (m :: * -> *) a. Monad m => a -> m a
return (TgaImageType -> Get TgaImageType)
-> TgaImageType -> Get TgaImageType
forall a b. (a -> b) -> a -> b
$ Bool -> TgaImageType
ImageTypeTrueColor Bool
isEncoded
    Word8
3 -> TgaImageType -> Get TgaImageType
forall (m :: * -> *) a. Monad m => a -> m a
return (TgaImageType -> Get TgaImageType)
-> TgaImageType -> Get TgaImageType
forall a b. (a -> b) -> a -> b
$ Bool -> TgaImageType
ImageTypeMonochrome Bool
isEncoded
    Word8
_ -> String -> Get TgaImageType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get TgaImageType) -> String -> Get TgaImageType
forall a b. (a -> b) -> a -> b
$ String
"Unknown TGA image type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
v
  where
    isEncoded :: Bool
isEncoded = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
v Int
3

codeOfImageType :: TgaImageType -> Word8
codeOfImageType :: TgaImageType -> Word8
codeOfImageType TgaImageType
v = case TgaImageType
v of
    ImageTypeNoData Bool
encoded -> Word8 -> Bool -> Word8
forall p. Bits p => p -> Bool -> p
setVal Word8
0 Bool
encoded
    ImageTypeColorMapped Bool
encoded -> Word8 -> Bool -> Word8
forall p. Bits p => p -> Bool -> p
setVal Word8
1 Bool
encoded
    ImageTypeTrueColor Bool
encoded -> Word8 -> Bool -> Word8
forall p. Bits p => p -> Bool -> p
setVal Word8
2 Bool
encoded
    ImageTypeMonochrome Bool
encoded -> Word8 -> Bool -> Word8
forall p. Bits p => p -> Bool -> p
setVal Word8
3 Bool
encoded
    where
      setVal :: p -> Bool -> p
setVal p
vv Bool
True = p -> Int -> p
forall a. Bits a => a -> Int -> a
setBit p
vv Int
3
      setVal p
vv Bool
False = p
vv

instance Binary TgaImageType where
  get :: Get TgaImageType
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get TgaImageType) -> Get TgaImageType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get TgaImageType
imageTypeOfCode
  put :: TgaImageType -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put) -> (TgaImageType -> Word8) -> TgaImageType -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TgaImageType -> Word8
codeOfImageType
    
data TgaImageDescription = TgaImageDescription
  { TgaImageDescription -> Bool
_tgaIdXOrigin       :: Bool
  , TgaImageDescription -> Bool
_tgaIdYOrigin       :: Bool
  , TgaImageDescription -> Word8
_tgaIdAttributeBits :: Word8
  }

instance Binary TgaImageDescription where
  put :: TgaImageDescription -> Put
put TgaImageDescription
desc = Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8
xOrig Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
yOrig Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
attr
    where
      xOrig :: Word8
xOrig | TgaImageDescription -> Bool
_tgaIdXOrigin TgaImageDescription
desc = Int -> Word8
forall a. Bits a => Int -> a
bit Int
4
            | Bool
otherwise = Word8
0

      yOrig :: Word8
yOrig | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TgaImageDescription -> Bool
_tgaIdYOrigin TgaImageDescription
desc = Int -> Word8
forall a. Bits a => Int -> a
bit Int
5
            | Bool
otherwise = Word8
0
      
      attr :: Word8
attr = TgaImageDescription -> Word8
_tgaIdAttributeBits TgaImageDescription
desc Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xF

  get :: Get TgaImageDescription
get = Word8 -> TgaImageDescription
toDescr (Word8 -> TgaImageDescription)
-> Get Word8 -> Get TgaImageDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 where
    toDescr :: Word8 -> TgaImageDescription
toDescr Word8
v = TgaImageDescription :: Bool -> Bool -> Word8 -> TgaImageDescription
TgaImageDescription
      { _tgaIdXOrigin :: Bool
_tgaIdXOrigin       = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
v Int
4
      , _tgaIdYOrigin :: Bool
_tgaIdYOrigin       = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
v Int
5
      , _tgaIdAttributeBits :: Word8
_tgaIdAttributeBits = Word8
v Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xF
      }

data TgaHeader = TgaHeader
  { TgaHeader -> Word8
_tgaHdrIdLength         :: {-# UNPACK #-} !Word8
  , TgaHeader -> TgaColorMapType
_tgaHdrColorMapType     :: !TgaColorMapType
  , TgaHeader -> TgaImageType
_tgaHdrImageType        :: !TgaImageType
  , TgaHeader -> Word16
_tgaHdrMapStart         :: {-# UNPACK #-} !Word16
  , TgaHeader -> Word16
_tgaHdrMapLength        :: {-# UNPACK #-} !Word16
  , TgaHeader -> Word8
_tgaHdrMapDepth         :: {-# UNPACK #-} !Word8
  , TgaHeader -> Word16
_tgaHdrXOffset          :: {-# UNPACK #-} !Word16
  , TgaHeader -> Word16
_tgaHdrYOffset          :: {-# UNPACK #-} !Word16
  , TgaHeader -> Word16
_tgaHdrWidth            :: {-# UNPACK #-} !Word16
  , TgaHeader -> Word16
_tgaHdrHeight           :: {-# UNPACK #-} !Word16
  , TgaHeader -> Word8
_tgaHdrPixelDepth       :: {-# UNPACK #-} !Word8
  , TgaHeader -> TgaImageDescription
_tgaHdrImageDescription :: {-# UNPACK #-} !TgaImageDescription
  }

instance Binary TgaHeader where
  get :: Get TgaHeader
get = Word8
-> TgaColorMapType
-> TgaImageType
-> Word16
-> Word16
-> Word8
-> Word16
-> Word16
-> Word16
-> Word16
-> Word8
-> TgaImageDescription
-> TgaHeader
TgaHeader
     (Word8
 -> TgaColorMapType
 -> TgaImageType
 -> Word16
 -> Word16
 -> Word8
 -> Word16
 -> Word16
 -> Word16
 -> Word16
 -> Word8
 -> TgaImageDescription
 -> TgaHeader)
-> Get Word8
-> Get
     (TgaColorMapType
      -> TgaImageType
      -> Word16
      -> Word16
      -> Word8
      -> Word16
      -> Word16
      -> Word16
      -> Word16
      -> Word8
      -> TgaImageDescription
      -> TgaHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
g8 Get
  (TgaColorMapType
   -> TgaImageType
   -> Word16
   -> Word16
   -> Word8
   -> Word16
   -> Word16
   -> Word16
   -> Word16
   -> Word8
   -> TgaImageDescription
   -> TgaHeader)
-> Get TgaColorMapType
-> Get
     (TgaImageType
      -> Word16
      -> Word16
      -> Word8
      -> Word16
      -> Word16
      -> Word16
      -> Word16
      -> Word8
      -> TgaImageDescription
      -> TgaHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TgaColorMapType
forall t. Binary t => Get t
get Get
  (TgaImageType
   -> Word16
   -> Word16
   -> Word8
   -> Word16
   -> Word16
   -> Word16
   -> Word16
   -> Word8
   -> TgaImageDescription
   -> TgaHeader)
-> Get TgaImageType
-> Get
     (Word16
      -> Word16
      -> Word8
      -> Word16
      -> Word16
      -> Word16
      -> Word16
      -> Word8
      -> TgaImageDescription
      -> TgaHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TgaImageType
forall t. Binary t => Get t
get Get
  (Word16
   -> Word16
   -> Word8
   -> Word16
   -> Word16
   -> Word16
   -> Word16
   -> Word8
   -> TgaImageDescription
   -> TgaHeader)
-> Get Word16
-> Get
     (Word16
      -> Word8
      -> Word16
      -> Word16
      -> Word16
      -> Word16
      -> Word8
      -> TgaImageDescription
      -> TgaHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
g16 Get
  (Word16
   -> Word8
   -> Word16
   -> Word16
   -> Word16
   -> Word16
   -> Word8
   -> TgaImageDescription
   -> TgaHeader)
-> Get Word16
-> Get
     (Word8
      -> Word16
      -> Word16
      -> Word16
      -> Word16
      -> Word8
      -> TgaImageDescription
      -> TgaHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
g16 Get
  (Word8
   -> Word16
   -> Word16
   -> Word16
   -> Word16
   -> Word8
   -> TgaImageDescription
   -> TgaHeader)
-> Get Word8
-> Get
     (Word16
      -> Word16
      -> Word16
      -> Word16
      -> Word8
      -> TgaImageDescription
      -> TgaHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
g8
     Get
  (Word16
   -> Word16
   -> Word16
   -> Word16
   -> Word8
   -> TgaImageDescription
   -> TgaHeader)
-> Get Word16
-> Get
     (Word16
      -> Word16 -> Word16 -> Word8 -> TgaImageDescription -> TgaHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
g16 Get
  (Word16
   -> Word16 -> Word16 -> Word8 -> TgaImageDescription -> TgaHeader)
-> Get Word16
-> Get
     (Word16 -> Word16 -> Word8 -> TgaImageDescription -> TgaHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
g16 Get (Word16 -> Word16 -> Word8 -> TgaImageDescription -> TgaHeader)
-> Get Word16
-> Get (Word16 -> Word8 -> TgaImageDescription -> TgaHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
g16 Get (Word16 -> Word8 -> TgaImageDescription -> TgaHeader)
-> Get Word16 -> Get (Word8 -> TgaImageDescription -> TgaHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
g16 Get (Word8 -> TgaImageDescription -> TgaHeader)
-> Get Word8 -> Get (TgaImageDescription -> TgaHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
g8 Get (TgaImageDescription -> TgaHeader)
-> Get TgaImageDescription -> Get TgaHeader
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TgaImageDescription
forall t. Binary t => Get t
get
   where g16 :: Get Word16
g16 = Get Word16
getWord16le
         g8 :: Get Word8
g8 = Get Word8
getWord8

  put :: TgaHeader -> Put
put TgaHeader
v = do
    let p8 :: Word8 -> Put
p8 = Word8 -> Put
putWord8
        p16 :: Word16 -> Put
p16 = Word16 -> Put
putWord16le
    Word8 -> Put
p8  (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word8
_tgaHdrIdLength TgaHeader
v
    TgaColorMapType -> Put
forall t. Binary t => t -> Put
put (TgaColorMapType -> Put) -> TgaColorMapType -> Put
forall a b. (a -> b) -> a -> b
$ TgaHeader -> TgaColorMapType
_tgaHdrColorMapType TgaHeader
v
    TgaImageType -> Put
forall t. Binary t => t -> Put
put (TgaImageType -> Put) -> TgaImageType -> Put
forall a b. (a -> b) -> a -> b
$ TgaHeader -> TgaImageType
_tgaHdrImageType TgaHeader
v

    Word16 -> Put
p16 (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word16
_tgaHdrMapStart TgaHeader
v
    Word16 -> Put
p16 (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word16
_tgaHdrMapLength TgaHeader
v
    Word8 -> Put
p8  (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word8
_tgaHdrMapDepth TgaHeader
v
    Word16 -> Put
p16 (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word16
_tgaHdrXOffset TgaHeader
v
    Word16 -> Put
p16 (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word16
_tgaHdrYOffset TgaHeader
v
    Word16 -> Put
p16 (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word16
_tgaHdrWidth TgaHeader
v
    Word16 -> Put
p16 (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word16
_tgaHdrHeight TgaHeader
v
    Word8 -> Put
p8  (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word8
_tgaHdrPixelDepth TgaHeader
v
    TgaImageDescription -> Put
forall t. Binary t => t -> Put
put (TgaImageDescription -> Put) -> TgaImageDescription -> Put
forall a b. (a -> b) -> a -> b
$ TgaHeader -> TgaImageDescription
_tgaHdrImageDescription TgaHeader
v


data TgaFile = TgaFile
  { TgaFile -> TgaHeader
_tgaFileHeader :: !TgaHeader
  , TgaFile -> ByteString
_tgaFileId     :: !B.ByteString
  , TgaFile -> ByteString
_tgaPalette    :: !B.ByteString
  , TgaFile -> ByteString
_tgaFileRest   :: !B.ByteString
  }

getPalette :: TgaHeader -> Get B.ByteString
getPalette :: TgaHeader -> Get ByteString
getPalette TgaHeader
hdr | TgaHeader -> Word16
_tgaHdrMapLength TgaHeader
hdr Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
0 = ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
forall a. Monoid a => a
mempty
getPalette TgaHeader
hdr = Int -> Get ByteString
getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Int
bytePerPixel Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pixelCount
  where
    bytePerPixel :: Int
bytePerPixel = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word8
_tgaHdrMapDepth TgaHeader
hdr Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
`div` Word8
8
    pixelCount :: Int
pixelCount = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word16
_tgaHdrMapLength TgaHeader
hdr

instance Binary TgaFile where
  get :: Get TgaFile
get = do
    TgaHeader
hdr <- Get TgaHeader
forall t. Binary t => Get t
get
    TgaHeader -> Get ()
validateTga TgaHeader
hdr
    ByteString
fileId <- Int -> Get ByteString
getByteString (Int -> Get ByteString)
-> (Word8 -> Int) -> Word8 -> Get ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Get ByteString) -> Word8 -> Get ByteString
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word8
_tgaHdrIdLength TgaHeader
hdr
    ByteString
palette <- TgaHeader -> Get ByteString
getPalette TgaHeader
hdr
    ByteString
rest <- Get ByteString
getRemainingBytes

    TgaFile -> Get TgaFile
forall (m :: * -> *) a. Monad m => a -> m a
return TgaFile :: TgaHeader -> ByteString -> ByteString -> ByteString -> TgaFile
TgaFile {
        _tgaFileHeader :: TgaHeader
_tgaFileHeader = TgaHeader
hdr
      , _tgaFileId :: ByteString
_tgaFileId = ByteString
fileId
      , _tgaPalette :: ByteString
_tgaPalette = ByteString
palette
      , _tgaFileRest :: ByteString
_tgaFileRest = ByteString
rest
      }

  put :: TgaFile -> Put
put TgaFile
file = do
    TgaHeader -> Put
forall t. Binary t => t -> Put
put (TgaHeader -> Put) -> TgaHeader -> Put
forall a b. (a -> b) -> a -> b
$ TgaFile -> TgaHeader
_tgaFileHeader TgaFile
file
    ByteString -> Put
putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ TgaFile -> ByteString
_tgaFileId TgaFile
file
    ByteString -> Put
putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ TgaFile -> ByteString
_tgaPalette TgaFile
file
    ByteString -> Put
putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ TgaFile -> ByteString
_tgaFileRest TgaFile
file

data Depth8 = Depth8
data Depth15 = Depth15
data Depth24 = Depth24
data Depth32 = Depth32

class (Pixel (Unpacked a)) => TGAPixel a where
   type Unpacked a
   packedByteSize :: a -> Int
   tgaUnpack      :: a -> B.ByteString -> Int -> Unpacked a

instance TGAPixel Depth8 where
   type Unpacked Depth8 = Pixel8
   packedByteSize :: Depth8 -> Int
packedByteSize Depth8
_ = Int
1
   tgaUnpack :: Depth8 -> ByteString -> Int -> Unpacked Depth8
tgaUnpack Depth8
_ = ByteString -> Int -> Word8
ByteString -> Int -> Unpacked Depth8
U.unsafeIndex

instance TGAPixel Depth15 where
   type Unpacked Depth15 = PixelRGBA8
   packedByteSize :: Depth15 -> Int
packedByteSize Depth15
_ = Int
2
   tgaUnpack :: Depth15 -> ByteString -> Int -> Unpacked Depth15
tgaUnpack Depth15
_ ByteString
str Int
ix = Word8 -> Word8 -> Word8 -> Word8 -> PixelRGBA8
PixelRGBA8 Word8
r Word8
g Word8
b Word8
a
      where
        v0 :: Word8
v0 = ByteString -> Int -> Word8
U.unsafeIndex ByteString
str Int
ix
        v1 :: Word8
v1 = ByteString -> Int -> Word8
U.unsafeIndex ByteString
str (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        r :: Word8
r = (Word8
v1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7c) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1;
        g :: Word8
g = ((Word8
v1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x03) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
6) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Word8
v0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xe0) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2);
        b :: Word8
b = (Word8
v0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x1f) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
3
        a :: Word8
a = Word8
255 -- v1 .&. 0x80


instance TGAPixel Depth24 where
   type Unpacked Depth24 = PixelRGB8
   packedByteSize :: Depth24 -> Int
packedByteSize Depth24
_ = Int
3
   tgaUnpack :: Depth24 -> ByteString -> Int -> Unpacked Depth24
tgaUnpack Depth24
_ ByteString
str Int
ix = Word8 -> Word8 -> Word8 -> PixelRGB8
PixelRGB8 Word8
r Word8
g Word8
b
     where
       b :: Word8
b = ByteString -> Int -> Word8
U.unsafeIndex ByteString
str Int
ix
       g :: Word8
g = ByteString -> Int -> Word8
U.unsafeIndex ByteString
str (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
       r :: Word8
r = ByteString -> Int -> Word8
U.unsafeIndex ByteString
str (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)

instance TGAPixel Depth32 where
   type Unpacked Depth32 = PixelRGBA8
   packedByteSize :: Depth32 -> Int
packedByteSize Depth32
_ = Int
4
   tgaUnpack :: Depth32 -> ByteString -> Int -> Unpacked Depth32
tgaUnpack Depth32
_ ByteString
str Int
ix = Word8 -> Word8 -> Word8 -> Word8 -> PixelRGBA8
PixelRGBA8 Word8
r Word8
g Word8
b Word8
a
     where
       b :: Word8
b = ByteString -> Int -> Word8
U.unsafeIndex ByteString
str Int
ix
       g :: Word8
g = ByteString -> Int -> Word8
U.unsafeIndex ByteString
str (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
       r :: Word8
r = ByteString -> Int -> Word8
U.unsafeIndex ByteString
str (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
       a :: Word8
a = ByteString -> Int -> Word8
U.unsafeIndex ByteString
str (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)

prepareUnpacker :: TgaFile
                -> (forall tgapx. (TGAPixel tgapx) => tgapx -> TgaFile -> Image (Unpacked tgapx))
                -> Either String DynamicImage
prepareUnpacker :: TgaFile
-> (forall tgapx.
    TGAPixel tgapx =>
    tgapx -> TgaFile -> Image (Unpacked tgapx))
-> Either String DynamicImage
prepareUnpacker TgaFile
file forall tgapx.
TGAPixel tgapx =>
tgapx -> TgaFile -> Image (Unpacked tgapx)
f =
  let hdr :: TgaHeader
hdr = TgaFile -> TgaHeader
_tgaFileHeader TgaFile
file
      flipper :: (Pixel px) => Image px -> Image px
      flipper :: Image px -> Image px
flipper = TgaImageDescription -> Image px -> Image px
forall px. Pixel px => TgaImageDescription -> Image px -> Image px
flipImage (TgaImageDescription -> Image px -> Image px)
-> TgaImageDescription -> Image px -> Image px
forall a b. (a -> b) -> a -> b
$ TgaHeader -> TgaImageDescription
_tgaHdrImageDescription TgaHeader
hdr
  in
  case TgaHeader -> Word8
_tgaHdrPixelDepth TgaHeader
hdr of
    Word8
8  -> DynamicImage -> Either String DynamicImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DynamicImage -> Either String DynamicImage)
-> (Image Word8 -> DynamicImage)
-> Image Word8
-> Either String DynamicImage
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
. Image Word8 -> Image Word8
forall px. Pixel px => Image px -> Image px
flipper (Image Word8 -> Either String DynamicImage)
-> Image Word8 -> Either String DynamicImage
forall a b. (a -> b) -> a -> b
$ Depth8 -> TgaFile -> Image (Unpacked Depth8)
forall tgapx.
TGAPixel tgapx =>
tgapx -> TgaFile -> Image (Unpacked tgapx)
f Depth8
Depth8 TgaFile
file
    Word8
16 -> DynamicImage -> Either String DynamicImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DynamicImage -> Either String DynamicImage)
-> (Image PixelRGBA8 -> DynamicImage)
-> Image PixelRGBA8
-> Either String DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBA8 -> DynamicImage
ImageRGBA8 (Image PixelRGBA8 -> DynamicImage)
-> (Image PixelRGBA8 -> Image PixelRGBA8)
-> Image PixelRGBA8
-> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBA8 -> Image PixelRGBA8
forall px. Pixel px => Image px -> Image px
flipper (Image PixelRGBA8 -> Either String DynamicImage)
-> Image PixelRGBA8 -> Either String DynamicImage
forall a b. (a -> b) -> a -> b
$ Depth15 -> TgaFile -> Image (Unpacked Depth15)
forall tgapx.
TGAPixel tgapx =>
tgapx -> TgaFile -> Image (Unpacked tgapx)
f Depth15
Depth15 TgaFile
file
    Word8
24 -> DynamicImage -> Either String DynamicImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DynamicImage -> Either String DynamicImage)
-> (Image PixelRGB8 -> DynamicImage)
-> Image PixelRGB8
-> Either String DynamicImage
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
. Image PixelRGB8 -> Image PixelRGB8
forall px. Pixel px => Image px -> Image px
flipper (Image PixelRGB8 -> Either String DynamicImage)
-> Image PixelRGB8 -> Either String DynamicImage
forall a b. (a -> b) -> a -> b
$ Depth24 -> TgaFile -> Image (Unpacked Depth24)
forall tgapx.
TGAPixel tgapx =>
tgapx -> TgaFile -> Image (Unpacked tgapx)
f Depth24
Depth24 TgaFile
file
    Word8
32 -> DynamicImage -> Either String DynamicImage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DynamicImage -> Either String DynamicImage)
-> (Image PixelRGBA8 -> DynamicImage)
-> Image PixelRGBA8
-> Either String DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBA8 -> DynamicImage
ImageRGBA8 (Image PixelRGBA8 -> DynamicImage)
-> (Image PixelRGBA8 -> Image PixelRGBA8)
-> Image PixelRGBA8
-> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBA8 -> Image PixelRGBA8
forall px. Pixel px => Image px -> Image px
flipper (Image PixelRGBA8 -> Either String DynamicImage)
-> Image PixelRGBA8 -> Either String DynamicImage
forall a b. (a -> b) -> a -> b
$ Depth32 -> TgaFile -> Image (Unpacked Depth32)
forall tgapx.
TGAPixel tgapx =>
tgapx -> TgaFile -> Image (Unpacked tgapx)
f Depth32
Depth32 TgaFile
file
    Word8
n  -> String -> Either String DynamicImage
forall a b. a -> Either a b
Left (String -> Either String DynamicImage)
-> String -> Either String DynamicImage
forall a b. (a -> b) -> a -> b
$ String
"Invalid bit depth (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

toPaletted :: (Pixel px)
           => (Image Pixel8 -> Palette' px -> PalettedImage) -> Image px
           -> DynamicImage
           -> Either String PalettedImage
toPaletted :: (Image Word8 -> Palette' px -> PalettedImage)
-> Image px -> DynamicImage -> Either String PalettedImage
toPaletted Image Word8 -> Palette' px -> PalettedImage
f Image px
palette (ImageY8 Image Word8
img) = 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
$ Image Word8 -> Palette' px -> PalettedImage
f Image Word8
img Palette' px
pal where
  pal :: Palette' px
pal = Palette' :: forall px. Int -> Vector (PixelBaseComponent px) -> Palette' px
Palette' 
    { _paletteSize :: Int
_paletteSize = Image px -> Int
forall a. Image a -> Int
imageWidth Image px
palette
    , _paletteData :: Vector (PixelBaseComponent px)
_paletteData = Image px -> Vector (PixelBaseComponent px)
forall a. Image a -> Vector (PixelBaseComponent a)
imageData Image px
palette
    }
toPaletted Image Word8 -> Palette' px -> PalettedImage
_ Image px
_ DynamicImage
_ = String -> Either String PalettedImage
forall a b. a -> Either a b
Left String
"Bad colorspace for image"

unparse :: TgaFile -> Either String (PalettedImage, Metadatas)
unparse :: TgaFile -> Either String (PalettedImage, Metadatas)
unparse TgaFile
file =
  let hdr :: TgaHeader
hdr = TgaFile -> TgaHeader
_tgaFileHeader TgaFile
file
      imageType :: TgaImageType
imageType = TgaHeader -> TgaImageType
_tgaHdrImageType TgaHeader
hdr

      unpacker :: forall tgapx. (TGAPixel tgapx)
               => tgapx -> TgaFile -> Image (Unpacked tgapx)
      unpacker :: tgapx -> TgaFile -> Image (Unpacked tgapx)
unpacker | TgaImageType -> Bool
isRleEncoded TgaImageType
imageType = tgapx -> TgaFile -> Image (Unpacked tgapx)
forall tgapx.
TGAPixel tgapx =>
tgapx -> TgaFile -> Image (Unpacked tgapx)
unpackRLETga
               | Bool
otherwise = tgapx -> TgaFile -> Image (Unpacked tgapx)
forall tgapx.
TGAPixel tgapx =>
tgapx -> TgaFile -> Image (Unpacked tgapx)
unpackUncompressedTga

      metas :: Metadatas
metas = SourceFormat -> Word16 -> Word16 -> Metadatas
forall nSize.
Integral nSize =>
SourceFormat -> nSize -> nSize -> Metadatas
basicMetadata SourceFormat
SourceTGA (TgaHeader -> Word16
_tgaHdrWidth TgaHeader
hdr) (TgaHeader -> Word16
_tgaHdrHeight TgaHeader
hdr)
      decodedPalette :: Either String (PalettedImage, Metadatas)
decodedPalette = TgaFile -> Either String (PalettedImage, Metadatas)
unparse TgaFile
file
        { _tgaFileHeader :: TgaHeader
_tgaFileHeader = TgaHeader
hdr
            { _tgaHdrHeight :: Word16
_tgaHdrHeight = Word16
1
            , _tgaHdrWidth :: Word16
_tgaHdrWidth = TgaHeader -> Word16
_tgaHdrMapLength TgaHeader
hdr
            , _tgaHdrPixelDepth :: Word8
_tgaHdrPixelDepth = TgaHeader -> Word8
_tgaHdrMapDepth TgaHeader
hdr
            , _tgaHdrImageType :: TgaImageType
_tgaHdrImageType = Bool -> TgaImageType
ImageTypeTrueColor Bool
False
            }
        , _tgaFileRest :: ByteString
_tgaFileRest = TgaFile -> ByteString
_tgaPalette TgaFile
file
        }
  in
  case TgaImageType
imageType of
    ImageTypeNoData Bool
_ -> String -> Either String (PalettedImage, Metadatas)
forall a b. a -> Either a b
Left String
"No data detected in TGA file"
    ImageTypeTrueColor Bool
_ ->
      (DynamicImage -> (PalettedImage, Metadatas))
-> Either String DynamicImage
-> Either String (PalettedImage, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((, Metadatas
metas) (PalettedImage -> (PalettedImage, Metadatas))
-> (DynamicImage -> PalettedImage)
-> DynamicImage
-> (PalettedImage, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage) (Either String DynamicImage
 -> Either String (PalettedImage, Metadatas))
-> Either String DynamicImage
-> Either String (PalettedImage, Metadatas)
forall a b. (a -> b) -> a -> b
$ TgaFile
-> (forall tgapx.
    TGAPixel tgapx =>
    tgapx -> TgaFile -> Image (Unpacked tgapx))
-> Either String DynamicImage
prepareUnpacker TgaFile
file forall tgapx.
TGAPixel tgapx =>
tgapx -> TgaFile -> Image (Unpacked tgapx)
unpacker
    ImageTypeMonochrome Bool
_ ->
      (DynamicImage -> (PalettedImage, Metadatas))
-> Either String DynamicImage
-> Either String (PalettedImage, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((, Metadatas
metas) (PalettedImage -> (PalettedImage, Metadatas))
-> (DynamicImage -> PalettedImage)
-> DynamicImage
-> (PalettedImage, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> PalettedImage
TrueColorImage) (Either String DynamicImage
 -> Either String (PalettedImage, Metadatas))
-> Either String DynamicImage
-> Either String (PalettedImage, Metadatas)
forall a b. (a -> b) -> a -> b
$ TgaFile
-> (forall tgapx.
    TGAPixel tgapx =>
    tgapx -> TgaFile -> Image (Unpacked tgapx))
-> Either String DynamicImage
prepareUnpacker TgaFile
file forall tgapx.
TGAPixel tgapx =>
tgapx -> TgaFile -> Image (Unpacked tgapx)
unpacker
    ImageTypeColorMapped Bool
_ ->
      case Either String (PalettedImage, Metadatas)
decodedPalette of
        Left String
str -> String -> Either String (PalettedImage, Metadatas)
forall a b. a -> Either a b
Left String
str
        Right (TrueColorImage (ImageY8 Image Word8
img), Metadatas
_) ->
          (PalettedImage -> (PalettedImage, Metadatas))
-> Either String PalettedImage
-> Either String (PalettedImage, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Metadatas
metas) (Either String PalettedImage
 -> Either String (PalettedImage, Metadatas))
-> Either String PalettedImage
-> Either String (PalettedImage, Metadatas)
forall a b. (a -> b) -> a -> b
$ TgaFile
-> (forall tgapx.
    TGAPixel tgapx =>
    tgapx -> TgaFile -> Image (Unpacked tgapx))
-> Either String DynamicImage
prepareUnpacker TgaFile
file forall tgapx.
TGAPixel tgapx =>
tgapx -> TgaFile -> Image (Unpacked tgapx)
unpacker Either String DynamicImage
-> (DynamicImage -> Either String PalettedImage)
-> Either String PalettedImage
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Image Word8 -> Palette' Word8 -> PalettedImage)
-> Image Word8 -> DynamicImage -> Either String PalettedImage
forall px.
Pixel px =>
(Image Word8 -> Palette' px -> PalettedImage)
-> Image px -> DynamicImage -> Either String PalettedImage
toPaletted Image Word8 -> Palette' Word8 -> PalettedImage
PalettedY8 Image Word8
img
        Right (TrueColorImage (ImageRGB8 Image PixelRGB8
img), Metadatas
_) ->
          (PalettedImage -> (PalettedImage, Metadatas))
-> Either String PalettedImage
-> Either String (PalettedImage, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Metadatas
metas) (Either String PalettedImage
 -> Either String (PalettedImage, Metadatas))
-> Either String PalettedImage
-> Either String (PalettedImage, Metadatas)
forall a b. (a -> b) -> a -> b
$ TgaFile
-> (forall tgapx.
    TGAPixel tgapx =>
    tgapx -> TgaFile -> Image (Unpacked tgapx))
-> Either String DynamicImage
prepareUnpacker TgaFile
file forall tgapx.
TGAPixel tgapx =>
tgapx -> TgaFile -> Image (Unpacked tgapx)
unpacker Either String DynamicImage
-> (DynamicImage -> Either String PalettedImage)
-> Either String PalettedImage
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Image Word8 -> Palette' PixelRGB8 -> PalettedImage)
-> Image PixelRGB8 -> DynamicImage -> Either String PalettedImage
forall px.
Pixel px =>
(Image Word8 -> Palette' px -> PalettedImage)
-> Image px -> DynamicImage -> Either String PalettedImage
toPaletted Image Word8 -> Palette' PixelRGB8 -> PalettedImage
PalettedRGB8 Image PixelRGB8
img
        Right (TrueColorImage (ImageRGBA8 Image PixelRGBA8
img), Metadatas
_) ->
          (PalettedImage -> (PalettedImage, Metadatas))
-> Either String PalettedImage
-> Either String (PalettedImage, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Metadatas
metas) (Either String PalettedImage
 -> Either String (PalettedImage, Metadatas))
-> Either String PalettedImage
-> Either String (PalettedImage, Metadatas)
forall a b. (a -> b) -> a -> b
$ TgaFile
-> (forall tgapx.
    TGAPixel tgapx =>
    tgapx -> TgaFile -> Image (Unpacked tgapx))
-> Either String DynamicImage
prepareUnpacker TgaFile
file forall tgapx.
TGAPixel tgapx =>
tgapx -> TgaFile -> Image (Unpacked tgapx)
unpacker Either String DynamicImage
-> (DynamicImage -> Either String PalettedImage)
-> Either String PalettedImage
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Image Word8 -> Palette' PixelRGBA8 -> PalettedImage)
-> Image PixelRGBA8 -> DynamicImage -> Either String PalettedImage
forall px.
Pixel px =>
(Image Word8 -> Palette' px -> PalettedImage)
-> Image px -> DynamicImage -> Either String PalettedImage
toPaletted Image Word8 -> Palette' PixelRGBA8 -> PalettedImage
PalettedRGBA8 Image PixelRGBA8
img
        Right (PalettedImage, Metadatas)
_ -> String -> Either String (PalettedImage, Metadatas)
forall a b. a -> Either a b
Left String
"Unknown pixel type"

writeRun :: (Pixel px)
         => M.STVector s (PixelBaseComponent px) -> Int -> px -> Int
         -> ST s Int
writeRun :: STVector s (PixelBaseComponent px) -> Int -> px -> Int -> ST s Int
writeRun STVector s (PixelBaseComponent px)
imgData Int
localMaxi px
px = Int -> ST s Int
run
  where
    writeDelta :: Int
writeDelta = px -> Int
forall a. Pixel a => a -> Int
componentCount px
px
    run :: Int -> ST s Int
run Int
writeIndex 
      | Int
writeIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
localMaxi = Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
writeIndex
    run Int
writeIndex = do
      STVector (PrimState (ST s)) (PixelBaseComponent px)
-> Int -> px -> ST s ()
forall a (m :: * -> *).
(Pixel a, PrimMonad m) =>
STVector (PrimState m) (PixelBaseComponent a) -> Int -> a -> m ()
unsafeWritePixel STVector s (PixelBaseComponent px)
STVector (PrimState (ST s)) (PixelBaseComponent px)
imgData Int
writeIndex px
px
      Int -> ST s Int
run (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
writeIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
writeDelta

copyData :: forall tgapx s
          . (TGAPixel tgapx)
         => tgapx
         -> M.STVector s (PixelBaseComponent (Unpacked tgapx))
         -> B.ByteString
         -> Int -> Int
         -> Int -> Int
         -> ST s (Int, Int)
copyData :: tgapx
-> STVector s (PixelBaseComponent (Unpacked tgapx))
-> ByteString
-> Int
-> Int
-> Int
-> Int
-> ST s (Int, Int)
copyData tgapx
tgapx STVector s (PixelBaseComponent (Unpacked tgapx))
imgData ByteString
readData Int
maxi Int
maxRead = Int -> Int -> ST s (Int, Int)
go
  where
    readDelta :: Int
readDelta = tgapx -> Int
forall a. TGAPixel a => a -> Int
packedByteSize tgapx
tgapx
    writeDelta :: Int
writeDelta = Unpacked tgapx -> Int
forall a. Pixel a => a -> Int
componentCount (Unpacked tgapx
forall a. HasCallStack => a
undefined :: Unpacked tgapx)

    go :: Int -> Int -> ST s (Int, Int)
go Int
writeIndex Int
readIndex
      | Int
writeIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxi Bool -> Bool -> Bool
||
        Int
readIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxRead = (Int, Int) -> ST s (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
writeIndex, Int
readIndex)
    go Int
writeIndex Int
readIndex = do
      let px :: Unpacked tgapx
px = tgapx -> ByteString -> Int -> Unpacked tgapx
forall a. TGAPixel a => a -> ByteString -> Int -> Unpacked a
tgaUnpack tgapx
tgapx ByteString
readData Int
readIndex :: Unpacked tgapx
      STVector (PrimState (ST s)) (PixelBaseComponent (Unpacked tgapx))
-> Int -> Unpacked tgapx -> ST s ()
forall a (m :: * -> *).
(Pixel a, PrimMonad m) =>
STVector (PrimState m) (PixelBaseComponent a) -> Int -> a -> m ()
unsafeWritePixel STVector s (PixelBaseComponent (Unpacked tgapx))
STVector (PrimState (ST s)) (PixelBaseComponent (Unpacked tgapx))
imgData Int
writeIndex Unpacked tgapx
px
      Int -> Int -> ST s (Int, Int)
go (Int
writeIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
writeDelta) (Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
readDelta)

unpackUncompressedTga :: forall tgapx
                       . (TGAPixel tgapx)
                      => tgapx -- ^ Type witness

                      -> TgaFile
                      -> Image (Unpacked tgapx)
unpackUncompressedTga :: tgapx -> TgaFile -> Image (Unpacked tgapx)
unpackUncompressedTga tgapx
tga TgaFile
file = (forall s. ST s (Image (Unpacked tgapx))) -> Image (Unpacked tgapx)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Image (Unpacked tgapx)))
 -> Image (Unpacked tgapx))
-> (forall s. ST s (Image (Unpacked tgapx)))
-> Image (Unpacked tgapx)
forall a b. (a -> b) -> a -> b
$ do
    MutableImage s (Unpacked tgapx)
img <- Int
-> Int
-> MVector s (PixelBaseComponent (Unpacked tgapx))
-> MutableImage s (Unpacked tgapx)
forall s a.
Int -> Int -> STVector s (PixelBaseComponent a) -> MutableImage s a
MutableImage Int
width Int
height (MVector s (PixelBaseComponent (Unpacked tgapx))
 -> MutableImage s (Unpacked tgapx))
-> ST s (MVector s (PixelBaseComponent (Unpacked tgapx)))
-> ST s (MutableImage s (Unpacked tgapx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ST
     s
     (MVector (PrimState (ST s)) (PixelBaseComponent (Unpacked tgapx)))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new Int
maxi
    let imgData :: MVector s (PixelBaseComponent (Unpacked tgapx))
imgData = MutableImage s (Unpacked tgapx)
-> MVector s (PixelBaseComponent (Unpacked tgapx))
forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData MutableImage s (Unpacked tgapx)
img
    (Int, Int)
_ <- tgapx
-> MVector s (PixelBaseComponent (Unpacked tgapx))
-> ByteString
-> Int
-> Int
-> Int
-> Int
-> ST s (Int, Int)
forall tgapx s.
TGAPixel tgapx =>
tgapx
-> STVector s (PixelBaseComponent (Unpacked tgapx))
-> ByteString
-> Int
-> Int
-> Int
-> Int
-> ST s (Int, Int)
copyData tgapx
tga MVector s (PixelBaseComponent (Unpacked tgapx))
imgData ByteString
readData Int
maxi Int
maxRead Int
0 Int
0
    MutableImage (PrimState (ST s)) (Unpacked tgapx)
-> ST s (Image (Unpacked tgapx))
forall a (m :: * -> *).
(Storable (PixelBaseComponent a), PrimMonad m) =>
MutableImage (PrimState m) a -> m (Image a)
unsafeFreezeImage MutableImage s (Unpacked tgapx)
MutableImage (PrimState (ST s)) (Unpacked tgapx)
img

  where
    hdr :: TgaHeader
hdr = TgaFile -> TgaHeader
_tgaFileHeader TgaFile
file
    width :: Int
width = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word16
_tgaHdrWidth TgaHeader
hdr
    height :: Int
height = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word16
_tgaHdrHeight TgaHeader
hdr
    readData :: ByteString
readData = TgaFile -> ByteString
_tgaFileRest TgaFile
file
    compCount :: Int
compCount = Unpacked tgapx -> Int
forall a. Pixel a => a -> Int
componentCount (Unpacked tgapx
forall a. HasCallStack => a
undefined :: Unpacked tgapx)
    maxi :: Int
maxi = 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
compCount
    maxRead :: Int
maxRead = ByteString -> Int
B.length ByteString
readData

isRleChunk :: Word8 -> Bool
isRleChunk :: Word8 -> Bool
isRleChunk Word8
v = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
v Int
7

runLength :: Word8 -> Int
runLength :: Word8 -> Int
runLength Word8
v = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
v Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

unpackRLETga :: forall tgapx
              . (TGAPixel tgapx)
             => tgapx -- ^ Type witness

             -> TgaFile
             -> Image (Unpacked tgapx)
unpackRLETga :: tgapx -> TgaFile -> Image (Unpacked tgapx)
unpackRLETga tgapx
tga TgaFile
file = (forall s. ST s (Image (Unpacked tgapx))) -> Image (Unpacked tgapx)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Image (Unpacked tgapx)))
 -> Image (Unpacked tgapx))
-> (forall s. ST s (Image (Unpacked tgapx)))
-> Image (Unpacked tgapx)
forall a b. (a -> b) -> a -> b
$ do
    MutableImage s (Unpacked tgapx)
img <- Int
-> Int
-> MVector s (PixelBaseComponent (Unpacked tgapx))
-> MutableImage s (Unpacked tgapx)
forall s a.
Int -> Int -> STVector s (PixelBaseComponent a) -> MutableImage s a
MutableImage Int
width Int
height (MVector s (PixelBaseComponent (Unpacked tgapx))
 -> MutableImage s (Unpacked tgapx))
-> ST s (MVector s (PixelBaseComponent (Unpacked tgapx)))
-> ST s (MutableImage s (Unpacked tgapx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ST
     s
     (MVector (PrimState (ST s)) (PixelBaseComponent (Unpacked tgapx)))
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new Int
maxi
    let imgData :: MVector s (PixelBaseComponent (Unpacked tgapx))
imgData = MutableImage s (Unpacked tgapx)
-> MVector s (PixelBaseComponent (Unpacked tgapx))
forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData MutableImage s (Unpacked tgapx)
img

        go :: Int -> Int -> ST s ()
go Int
writeIndex Int
readIndex
            | Int
writeIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxi = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return () 
            | Int
readIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxRead = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        go Int
writeIndex Int
readIndex = do
          let code :: Word8
code = ByteString -> Int -> Word8
U.unsafeIndex ByteString
readData Int
readIndex
              copyMax :: Int
copyMax = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxi (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
writeIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
runLength Word8
code Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
compCount
          
          if Word8 -> Bool
isRleChunk Word8
code then do
            let px :: Unpacked tgapx
px = tgapx -> ByteString -> Int -> Unpacked tgapx
forall a. TGAPixel a => a -> ByteString -> Int -> Unpacked a
tgaUnpack tgapx
tga ByteString
readData (Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) :: Unpacked tgapx
            Int
lastWriteIndex <- MVector s (PixelBaseComponent (Unpacked tgapx))
-> Int -> Unpacked tgapx -> Int -> ST s Int
forall px s.
Pixel px =>
STVector s (PixelBaseComponent px) -> Int -> px -> Int -> ST s Int
writeRun MVector s (PixelBaseComponent (Unpacked tgapx))
imgData Int
copyMax Unpacked tgapx
px Int
writeIndex
            Int -> Int -> ST s ()
go Int
lastWriteIndex (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
readDelta

          else do
            (Int
newWrite, Int
newRead) <-
                tgapx
-> MVector s (PixelBaseComponent (Unpacked tgapx))
-> ByteString
-> Int
-> Int
-> Int
-> Int
-> ST s (Int, Int)
forall tgapx s.
TGAPixel tgapx =>
tgapx
-> STVector s (PixelBaseComponent (Unpacked tgapx))
-> ByteString
-> Int
-> Int
-> Int
-> Int
-> ST s (Int, Int)
copyData tgapx
tga MVector s (PixelBaseComponent (Unpacked tgapx))
imgData ByteString
readData Int
copyMax Int
maxRead
                    Int
writeIndex (Int
readIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            Int -> Int -> ST s ()
go Int
newWrite Int
newRead

    Int -> Int -> ST s ()
go Int
0 Int
0
    MutableImage (PrimState (ST s)) (Unpacked tgapx)
-> ST s (Image (Unpacked tgapx))
forall a (m :: * -> *).
(Storable (PixelBaseComponent a), PrimMonad m) =>
MutableImage (PrimState m) a -> m (Image a)
unsafeFreezeImage MutableImage s (Unpacked tgapx)
MutableImage (PrimState (ST s)) (Unpacked tgapx)
img

  where
    hdr :: TgaHeader
hdr = TgaFile -> TgaHeader
_tgaFileHeader TgaFile
file
    width :: Int
width = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word16
_tgaHdrWidth TgaHeader
hdr
    height :: Int
height = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ TgaHeader -> Word16
_tgaHdrHeight TgaHeader
hdr
    readData :: ByteString
readData = TgaFile -> ByteString
_tgaFileRest TgaFile
file
    compCount :: Int
compCount = Unpacked tgapx -> Int
forall a. Pixel a => a -> Int
componentCount (Unpacked tgapx
forall a. HasCallStack => a
undefined :: Unpacked tgapx)
    maxi :: Int
maxi = 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
compCount
    maxRead :: Int
maxRead = ByteString -> Int
B.length ByteString
readData
    readDelta :: Int
readDelta = tgapx -> Int
forall a. TGAPixel a => a -> Int
packedByteSize tgapx
tga

flipImage :: (Pixel px)
          => TgaImageDescription -> Image px -> Image px
flipImage :: TgaImageDescription -> Image px -> Image px
flipImage TgaImageDescription
desc Image px
img
    | Bool
xFlip Bool -> Bool -> Bool
&& Bool
yFlip =
        (Int -> Int -> px) -> Int -> Int -> Image px
forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage (\Int
x Int
y -> Image px -> Int -> Int -> px
forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image px
img (Int
wMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x) (Int
hMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y)) Int
w Int
h
    | Bool
xFlip =
        (Int -> Int -> px) -> Int -> Int -> Image px
forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage (\Int
x Int
y -> Image px -> Int -> Int -> px
forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image px
img (Int
wMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x) Int
y) Int
w Int
h
    | Bool
yFlip =
        (Int -> Int -> px) -> Int -> Int -> Image px
forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage (\Int
x Int
y -> Image px -> Int -> Int -> px
forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image px
img Int
x (Int
hMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y)) Int
w Int
h
    | Bool
otherwise = Image px
img
  where
    xFlip :: Bool
xFlip = TgaImageDescription -> Bool
_tgaIdXOrigin TgaImageDescription
desc
    yFlip :: Bool
yFlip = TgaImageDescription -> Bool
_tgaIdYOrigin TgaImageDescription
desc
    w :: Int
w = Image px -> Int
forall a. Image a -> Int
imageWidth Image px
img
    h :: Int
h = Image px -> Int
forall a. Image a -> Int
imageHeight Image px
img

    !wMax :: Int
wMax = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    !hMax :: Int
hMax = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

validateTga :: TgaHeader -> Get ()
validateTga :: TgaHeader -> Get ()
validateTga TgaHeader
hdr
    | TgaHeader -> Word16
_tgaHdrWidth TgaHeader
hdr Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
0 = String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Width is null or negative"
    | TgaHeader -> Word16
_tgaHdrHeight TgaHeader
hdr Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
0 = String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Height is null or negative"
validateTga TgaHeader
_ = () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Transform a raw tga image to an image, without modifying

-- the underlying pixel type.

--

-- This function can output the following images:

--

--  * 'ImageY8'

--

--  * 'ImageRGB8'

--

--  * 'ImageRGBA8'

--

decodeTga :: B.ByteString -> Either String DynamicImage
decodeTga :: ByteString -> Either String DynamicImage
decodeTga ByteString
byte = (DynamicImage, Metadatas) -> DynamicImage
forall a b. (a, b) -> a
fst ((DynamicImage, Metadatas) -> DynamicImage)
-> Either String (DynamicImage, Metadatas)
-> Either String DynamicImage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String (DynamicImage, Metadatas)
decodeTgaWithMetadata ByteString
byte

-- | Equivalent to decodeTga but also provide metadata

decodeTgaWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas)
decodeTgaWithMetadata :: ByteString -> Either String (DynamicImage, Metadatas)
decodeTgaWithMetadata ByteString
byte = (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)
decodeTgaWithPaletteAndMetadata ByteString
byte

-- | Equivalent to decodeTga but with metdata and palette if any

decodeTgaWithPaletteAndMetadata :: B.ByteString -> Either String (PalettedImage, Metadatas)
decodeTgaWithPaletteAndMetadata :: ByteString -> Either String (PalettedImage, Metadatas)
decodeTgaWithPaletteAndMetadata ByteString
byte = Get TgaFile -> ByteString -> Either String TgaFile
forall a. Get a -> ByteString -> Either String a
runGetStrict Get TgaFile
forall t. Binary t => Get t
get ByteString
byte Either String TgaFile
-> (TgaFile -> Either String (PalettedImage, Metadatas))
-> Either String (PalettedImage, Metadatas)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TgaFile -> Either String (PalettedImage, Metadatas)
unparse

-- | This typeclass determine if a pixel can be saved in the

-- TGA format.

class TgaSaveable a where
    tgaDataOfImage :: Image a -> B.ByteString
    tgaPixelDepthOfImage :: Image a -> Word8
    tgaTypeOfImage :: Image a -> TgaImageType

instance TgaSaveable Pixel8 where
    tgaDataOfImage :: Image Word8 -> ByteString
tgaDataOfImage = Vector Word8 -> ByteString
forall a. Storable a => Vector a -> ByteString
toByteString (Vector Word8 -> ByteString)
-> (Image Word8 -> Vector Word8) -> Image Word8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Word8 -> Vector Word8
forall a. Image a -> Vector (PixelBaseComponent a)
imageData
    tgaPixelDepthOfImage :: Image Word8 -> Word8
tgaPixelDepthOfImage Image Word8
_ = Word8
8
    tgaTypeOfImage :: Image Word8 -> TgaImageType
tgaTypeOfImage Image Word8
_ = Bool -> TgaImageType
ImageTypeMonochrome Bool
False

instance TgaSaveable PixelRGB8 where
    tgaPixelDepthOfImage :: Image PixelRGB8 -> Word8
tgaPixelDepthOfImage Image PixelRGB8
_ = Word8
24
    tgaTypeOfImage :: Image PixelRGB8 -> TgaImageType
tgaTypeOfImage Image PixelRGB8
_ = Bool -> TgaImageType
ImageTypeTrueColor Bool
False
    tgaDataOfImage :: Image PixelRGB8 -> ByteString
tgaDataOfImage = Vector Word8 -> ByteString
forall a. Storable a => Vector a -> ByteString
toByteString (Vector Word8 -> ByteString)
-> (Image PixelRGB8 -> Vector Word8)
-> Image PixelRGB8
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> Vector Word8
forall a. Image a -> Vector (PixelBaseComponent a)
imageData (Image PixelRGB8 -> Vector Word8)
-> (Image PixelRGB8 -> Image PixelRGB8)
-> Image PixelRGB8
-> Vector Word8
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 PixelRGB8 -> PixelRGB8
flipRgb
      where
        flipRgb :: PixelRGB8 -> PixelRGB8
flipRgb (PixelRGB8 Word8
r Word8
g Word8
b) = Word8 -> Word8 -> Word8 -> PixelRGB8
PixelRGB8 Word8
b Word8
g Word8
r

instance TgaSaveable PixelRGBA8 where
    tgaPixelDepthOfImage :: Image PixelRGBA8 -> Word8
tgaPixelDepthOfImage Image PixelRGBA8
_ = Word8
32
    tgaTypeOfImage :: Image PixelRGBA8 -> TgaImageType
tgaTypeOfImage Image PixelRGBA8
_ = Bool -> TgaImageType
ImageTypeTrueColor Bool
False
    tgaDataOfImage :: Image PixelRGBA8 -> ByteString
tgaDataOfImage = Vector Word8 -> ByteString
forall a. Storable a => Vector a -> ByteString
toByteString (Vector Word8 -> ByteString)
-> (Image PixelRGBA8 -> Vector Word8)
-> Image PixelRGBA8
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBA8 -> Vector Word8
forall a. Image a -> Vector (PixelBaseComponent a)
imageData (Image PixelRGBA8 -> Vector Word8)
-> (Image PixelRGBA8 -> Image PixelRGBA8)
-> Image PixelRGBA8
-> Vector Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PixelRGBA8 -> PixelRGBA8) -> Image PixelRGBA8 -> Image PixelRGBA8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelRGBA8 -> PixelRGBA8
flipRgba
      where
        flipRgba :: PixelRGBA8 -> PixelRGBA8
flipRgba (PixelRGBA8 Word8
r Word8
g Word8
b Word8
a) = Word8 -> Word8 -> Word8 -> Word8 -> PixelRGBA8
PixelRGBA8 Word8
b Word8
g Word8
r Word8
a

-- | Helper function to directly write an image a tga on disk.

writeTga :: (TgaSaveable pixel) => FilePath -> Image pixel -> IO ()
writeTga :: String -> Image pixel -> IO ()
writeTga String
path 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. TgaSaveable px => Image px -> ByteString
encodeTga Image pixel
img

-- | Transform a compatible image to a raw bytestring

-- representing a Targa file.

encodeTga :: (TgaSaveable px) => Image px -> Lb.ByteString
encodeTga :: Image px -> ByteString
encodeTga Image px
img = TgaFile -> ByteString
forall a. Binary a => a -> ByteString
encode TgaFile
file
  where
    file :: TgaFile
file = TgaFile :: TgaHeader -> ByteString -> ByteString -> ByteString -> TgaFile
TgaFile
      { _tgaFileHeader :: TgaHeader
_tgaFileHeader = TgaHeader :: Word8
-> TgaColorMapType
-> TgaImageType
-> Word16
-> Word16
-> Word8
-> Word16
-> Word16
-> Word16
-> Word16
-> Word8
-> TgaImageDescription
-> TgaHeader
TgaHeader
            { _tgaHdrIdLength :: Word8
_tgaHdrIdLength         = Word8
0
            , _tgaHdrColorMapType :: TgaColorMapType
_tgaHdrColorMapType     = TgaColorMapType
ColorMapWithoutTable
            , _tgaHdrImageType :: TgaImageType
_tgaHdrImageType        = Image px -> TgaImageType
forall a. TgaSaveable a => Image a -> TgaImageType
tgaTypeOfImage Image px
img
            , _tgaHdrMapStart :: Word16
_tgaHdrMapStart         = Word16
0
            , _tgaHdrMapLength :: Word16
_tgaHdrMapLength        = Word16
0
            , _tgaHdrMapDepth :: Word8
_tgaHdrMapDepth         = Word8
0
            , _tgaHdrXOffset :: Word16
_tgaHdrXOffset          = Word16
0
            , _tgaHdrYOffset :: Word16
_tgaHdrYOffset          = Word16
0
            , _tgaHdrWidth :: Word16
_tgaHdrWidth            = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Image px -> Int
forall a. Image a -> Int
imageWidth Image px
img
            , _tgaHdrHeight :: Word16
_tgaHdrHeight           = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Image px -> Int
forall a. Image a -> Int
imageHeight Image px
img
            , _tgaHdrPixelDepth :: Word8
_tgaHdrPixelDepth       = Image px -> Word8
forall a. TgaSaveable a => Image a -> Word8
tgaPixelDepthOfImage Image px
img
            , _tgaHdrImageDescription :: TgaImageDescription
_tgaHdrImageDescription = TgaImageDescription :: Bool -> Bool -> Word8 -> TgaImageDescription
TgaImageDescription
                    { _tgaIdXOrigin :: Bool
_tgaIdXOrigin       = Bool
False
                    , _tgaIdYOrigin :: Bool
_tgaIdYOrigin       = Bool
False
                    , _tgaIdAttributeBits :: Word8
_tgaIdAttributeBits = Word8
0
                    }
            }
      , _tgaFileId :: ByteString
_tgaFileId     = ByteString
forall a. Monoid a => a
mempty
      , _tgaPalette :: ByteString
_tgaPalette    = ByteString
forall a. Monoid a => a
mempty
      , _tgaFileRest :: ByteString
_tgaFileRest   = Image px -> ByteString
forall a. TgaSaveable a => Image a -> ByteString
tgaDataOfImage Image px
img
      }

{-# ANN module "HLint: ignore Reduce duplication" #-}