Library/PNG
From HaskellWiki
< Library(Difference between revisions)
m (category library) |
m |
||
| (4 intermediate revisions not shown.) | |||
| Line 1: | Line 1: | ||
| - | [[Category:Code]][[Category | + | [[Category:Code]][[Category:Libraries]] |
Here is a small library to generate monochrome PNG images. PNG is probably the simplest format with widespread support (ie. in browsers). This library has a function "png" which converts two-dimensional data <hask>[[Bool]]</hask> into a String. Writing the String to a file (ie. with writeFile) creates a PNG file. | Here is a small library to generate monochrome PNG images. PNG is probably the simplest format with widespread support (ie. in browsers). This library has a function "png" which converts two-dimensional data <hask>[[Bool]]</hask> into a String. Writing the String to a file (ie. with writeFile) creates a PNG file. | ||
| Line 78: | Line 78: | ||
crcTab :: Array Word8 Word32 | crcTab :: Array Word8 Word32 | ||
| - | crcTab = | + | crcTab = listArray (0,255) $ flip map [0..255] (\n -> |
foldl' (\c k -> if c .&. 1 == 1 | foldl' (\c k -> if c .&. 1 == 1 | ||
then 0xedb88320 `xor` (c `shiftR` 1) | then 0xedb88320 `xor` (c `shiftR` 1) | ||
else c `shiftR` 1) n [0..7]) | else c `shiftR` 1) n [0..7]) | ||
</haskell> | </haskell> | ||
| + | |||
| + | == 8-bit Grayscale == | ||
| + | |||
| + | This code is relatively easy to extend to handle other PNG color formats. For instance, a version that produced 8-bit grayscale instead of 1-bit monochrome would only need to change the png and bitpack functions, as follows: | ||
| + | |||
| + | <haskell> | ||
| + | white, black :: Int | ||
| + | white = 255 | ||
| + | black = 0 | ||
| + | |||
| + | -- | Produces a single grayscale bit given a percent black | ||
| + | gray :: Int -> Int | ||
| + | gray percent = 255 - floor (fromIntegral percent * 2.55) | ||
| + | |||
| + | -- | Return a grayscale PNG file from a two dimensional bitmap stored in a list | ||
| + | -- of lines represented as a list of 0-255 integer values. | ||
| + | png :: [[Int]] -> String | ||
| + | png dat = unpack $ B.concat $ hdr : concat [ihdr, imgdat, iend] | ||
| + | where height = fromIntegral $ length dat | ||
| + | width = fromIntegral $ length (head dat) | ||
| + | ihdr = chunk iHDR $ B.concat | ||
| + | [ be32 width | ||
| + | , be32 height | ||
| + | , be8 8 -- bits per pixel | ||
| + | , be8 0 -- color type | ||
| + | , be8 0 -- compression method | ||
| + | , be8 0 -- filter method | ||
| + | , be8 0 ] -- interlace method | ||
| + | imgdat = chunk iDAT (Z.compress imgbits) | ||
| + | imgbits = B.concat $ map scanline dat | ||
| + | iend = chunk iEND B.empty | ||
| + | |||
| + | scanline :: [Int] -> B.ByteString | ||
| + | scanline dat = B.pack (0 : map fromIntegral dat) | ||
| + | |||
| + | bitpack :: [Int] -> B.ByteString | ||
| + | bitpack = B.pack . map fromIntegral | ||
| + | </haskell> | ||
| + | |||
| + | Since one pixel fits into one byte, we no longer need the bitpack' function in this version. | ||
| + | |||
| + | == 24 Bit RGB == | ||
| + | |||
| + | The code can be extended to full RGB with minor changes: | ||
| + | |||
| + | <haskell> | ||
| + | png :: [[(Int,Int,Int)]] -> B.ByteString | ||
| + | png dat = B.concat $ hdr : concat [ihdr, imgdat ,iend] | ||
| + | where height = fromIntegral $ length dat | ||
| + | width = fromIntegral $ length (head dat) | ||
| + | ihdr = chunk iHDR $ B.concat | ||
| + | [ be32 height | ||
| + | , be32 width | ||
| + | , be8 8 -- bits per sample (8 for r, 8 for g, 8 for b) | ||
| + | , be8 2 -- color type (2=rgb) | ||
| + | , be8 0 -- compression method | ||
| + | , be8 0 -- filter method | ||
| + | , be8 0 ] -- interlace method | ||
| + | imgdat = chunk iDAT (Z.compress imagedata) | ||
| + | imagedata = B.concat $ map scanline dat | ||
| + | iend = chunk iEND B.empty | ||
| + | |||
| + | scanline :: [(Int,Int,Int)] -> B.ByteString | ||
| + | scanline dat = B.pack (0 : (map fromIntegral $ concatMap (\(r,g,b) -> [r,g,b]) dat)) | ||
| + | </haskell> | ||
| + | |||
| + | By appropriately changing the color type and adding another Int to the tuple you could have an alpha channel too. | ||
Current revision
[[Bool]]
This code requires the Zlib package.
{- A small library for creating monochrome PNG files. This file is placed into the public domain. Dependencies: Zlib. -} module Png (png) where import Data.Array import Data.Bits import Data.List import Data.Word import qualified Codec.Compression.Zlib as Z import qualified Data.ByteString.Lazy as B be8 :: Word8 -> B.ByteString be8 x = B.singleton x be32 :: Word32 -> B.ByteString be32 x = B.pack [fromIntegral (x `shiftR` sh) | sh <- [24,16,8,0]] pack :: String -> B.ByteString pack xs = B.pack $ map (fromIntegral.fromEnum) xs unpack :: B.ByteString -> String unpack xs = map (toEnum.fromIntegral) (B.unpack xs) hdr, iHDR, iDAT, iEND :: B.ByteString hdr = pack "\137\80\78\71\13\10\26\10" iHDR = pack "IHDR" iDAT = pack "IDAT" iEND = pack "IEND" chunk :: B.ByteString -> B.ByteString -> [B.ByteString] chunk tag xs = [be32 (fromIntegral $ B.length xs), dat, be32 (crc dat)] where dat = B.append tag xs -- | Return a monochrome PNG file from a two dimensional bitmap -- stored in a list of lines represented as a list of booleans. png :: [[Bool]] -> String png dat = unpack $ B.concat $ hdr : concat [ihdr, imgdat, iend] where height = fromIntegral $ length dat width = fromIntegral $ length (head dat) ihdr = chunk iHDR (B.concat [ be32 width, be32 height, be8 1, be8 0, be8 0, be8 0, be8 0]) imgdat = chunk iDAT (Z.compress imgbits) imgbits = B.concat $ map scanline dat iend = chunk iEND B.empty scanline :: [Bool] -> B.ByteString scanline dat = 0 `B.cons` bitpack dat bitpack' :: [Bool] -> Word8 -> Word8 -> B.ByteString bitpack' [] n b = if b /= 0x80 then B.singleton n else B.empty bitpack' (x:xs) n b = if b == 1 then v `B.cons` bitpack' xs 0 0x80 else bitpack' xs v (b `shiftR` 1) where v = if x then n else n .|. b bitpack :: [Bool] -> B.ByteString bitpack xs = bitpack' xs 0 0x80 crc :: B.ByteString -> Word32 crc xs = updateCrc 0xffffffff xs `xor` 0xffffffff updateCrc :: Word32 -> B.ByteString -> Word32 updateCrc = B.foldl' crcStep crcStep :: Word32 -> Word8 -> Word32 crcStep crc ch = (crcTab ! n) `xor` (crc `shiftR` 8) where n = fromIntegral (crc `xor` fromIntegral ch) crcTab :: Array Word8 Word32 crcTab = listArray (0,255) $ flip map [0..255] (\n -> foldl' (\c k -> if c .&. 1 == 1 then 0xedb88320 `xor` (c `shiftR` 1) else c `shiftR` 1) n [0..7])
1 8-bit Grayscale
This code is relatively easy to extend to handle other PNG color formats. For instance, a version that produced 8-bit grayscale instead of 1-bit monochrome would only need to change the png and bitpack functions, as follows:
white, black :: Int white = 255 black = 0 -- | Produces a single grayscale bit given a percent black gray :: Int -> Int gray percent = 255 - floor (fromIntegral percent * 2.55) -- | Return a grayscale PNG file from a two dimensional bitmap stored in a list -- of lines represented as a list of 0-255 integer values. png :: [[Int]] -> String png dat = unpack $ B.concat $ hdr : concat [ihdr, imgdat, iend] where height = fromIntegral $ length dat width = fromIntegral $ length (head dat) ihdr = chunk iHDR $ B.concat [ be32 width , be32 height , be8 8 -- bits per pixel , be8 0 -- color type , be8 0 -- compression method , be8 0 -- filter method , be8 0 ] -- interlace method imgdat = chunk iDAT (Z.compress imgbits) imgbits = B.concat $ map scanline dat iend = chunk iEND B.empty scanline :: [Int] -> B.ByteString scanline dat = B.pack (0 : map fromIntegral dat) bitpack :: [Int] -> B.ByteString bitpack = B.pack . map fromIntegral
Since one pixel fits into one byte, we no longer need the bitpack' function in this version.
2 24 Bit RGB
The code can be extended to full RGB with minor changes:
png :: [[(Int,Int,Int)]] -> B.ByteString png dat = B.concat $ hdr : concat [ihdr, imgdat ,iend] where height = fromIntegral $ length dat width = fromIntegral $ length (head dat) ihdr = chunk iHDR $ B.concat [ be32 height , be32 width , be8 8 -- bits per sample (8 for r, 8 for g, 8 for b) , be8 2 -- color type (2=rgb) , be8 0 -- compression method , be8 0 -- filter method , be8 0 ] -- interlace method imgdat = chunk iDAT (Z.compress imagedata) imagedata = B.concat $ map scanline dat iend = chunk iEND B.empty scanline :: [(Int,Int,Int)] -> B.ByteString scanline dat = B.pack (0 : (map fromIntegral $ concatMap (\(r,g,b) -> [r,g,b]) dat))
By appropriately changing the color type and adding another Int to the tuple you could have an alpha channel too.
