Personal tools

Library/PNG

From HaskellWiki

< Library
Revision as of 05:41, 19 February 2010 by Newacct (Talk | contribs)

Jump to: navigation, search


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
[[Bool]]
into a String. Writing the String to a file (ie. with writeFile) creates a PNG file.

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 = array (0,255) $ zip [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 appropriatly changing the color type and adding another Int to the tuple you could have an alpha channel too.