module Graphics.Formats.TGA.TGA(readTGA, writeTGA, TGAData(..), Picture(..))
where
import Data.Word
import Data.Bits
import qualified Data.ByteString as B
data Picture = RGB24 ImageData |
RGB32 ImageData |
PaletteUncompressed Palette ImageData |
MonoUncompressed ImageData
type Palette = B.ByteString
type ImageData = B.ByteString
data TGAData = TGAData {
picId :: B.ByteString,
picture :: Picture,
xcoord :: Int,
ycoord :: Int,
width :: Int,
height :: Int
}
readTGA :: String -> IO TGAData
readTGA fileName = do bs <- B.readFile fileName
return (TGAData (readId bs)
(readPicture bs)
(fromIntegral ((B.index bs 8 )+(shiftL (B.index bs 9) 8)))
(fromIntegral ((B.index bs 10)+(shiftL (B.index bs 11) 8)))
(fromIntegral ((B.index bs 12)+(shiftL (B.index bs 13) 8)))
(fromIntegral ((B.index bs 14)+(shiftL (B.index bs 15) 8))) )
readId bs = B.take len (B.drop 17 bs)
where len = fromIntegral (B.index bs 0)
readPicture bs | ((B.index bs 2) == 2) && ((B.index bs 16) == 24) = RGB24 (B.drop (17+id_len+pal_len+1) bs)
| ((B.index bs 2) == 2) && ((B.index bs 16) == 32) = RGB32 (B.drop (17+id_len+pal_len+1) bs)
where id_len = fromIntegral (B.index bs 0)
pal_len = fromIntegral ((B.index bs 5) + (shiftL (B.index bs 6) 8))
writeTGA :: String -> TGAData -> IO ()
writeTGA fileName tgaData = B.writeFile fileName $ (header tgaData) `B.append` (body tgaData)
header :: TGAData -> B.ByteString
header file = B.pack ([(fromIntegral (B.length (picId file))) :: Word8] ++
[hasPalette p] ++
[ptype p] ++
[0::Word8] ++ [0::Word8] ++
(palette_len p) ++
[palette_entry_len p] ++
(toW8 (xcoord file)) ++ (toW8 (ycoord file)) ++
(toW8 (width file)) ++ (toW8 (height file)) ++
[pixelBits p] ++
[32::Word8])
where p = (picture file)
hasPalette (PaletteUncompressed _ _) = 1 :: Word8
hasPalette _ = 0 :: Word8
pixelBits (RGB24 _) = 24 :: Word8
pixelBits (RGB32 _) = 32 :: Word8
ptype (PaletteUncompressed _ _) = 1 :: Word8
ptype (RGB24 _) = 2 :: Word8
ptype (RGB32 _) = 2 :: Word8
ptype (MonoUncompressed _) = 3 :: Word8
palette_len (PaletteUncompressed palette _) = toW8 $ (toEnum . fromEnum) (B.length palette)
palette_len _ = [0 :: Word8, 0 :: Word8]
toW8 :: Int -> [Word8]
toW8 i = [(fromIntegral (i .&. 255)) :: Word8, (fromIntegral (shiftR i 8)) :: Word8]
palette_entry_len (RGB24 _) = 0 :: Word8
palette_entry_len (RGB32 _) = 0 :: Word8
body :: TGAData -> B.ByteString
body file = (picId file) `B.append` (getPalette (picture file)) `B.append` (getData (picture file))
getPalette (PaletteUncompressed p _) = p
getPalette _ = B.empty
getData (RGB32 d) = d
getData (RGB24 d) = d
getData (PaletteUncompressed _ d) = d
getData (MonoUncompressed d) = d