Generate textual PPM files (\"P3\"). These are much larger
  than binary files and slower to generate, but have the
  advantage of being /vaguely/ human-readable. (Apart from
  the file header, each line is three decimal numbers
  representing the RGB values of a single pixel.) Such files
  will also survive transfer in \"text mode\" without
  being mutilated, unlike binary image files.

module Codec.PPM.Text where

import Data.Word
import qualified Data.ByteString.Lazy.Char8 as TXT
import System.IO

  Given the image size (X pixels, Y pixels) and a list of
  pixel values (red, green, blue), produce a lazy ByteString
  containing the PPM data.
stringPPM :: (Integer,Integer) -> [(Word8,Word8,Word8)] -> TXT.ByteString
stringPPM (sx,sy) ps =
  TXT.pack ("P3\n" ++ show sx ++ " " ++ show sy ++ "\n255\n") `TXT.append`
  TXT.unlines (map (\(r,g,b) -> TXT.pack $ unwords [show r, show g,show b]) ps)

  Convenience function: Generate PPM data and write it to the
  specified 'Handle'. The handle is not closed or flushed afterwards.
  This allows writing PPM data to network streams, etc. This function
  does not return until all the data has been completely written.
  (It may of course throw some kind of I/O exception instead.)
putPPM :: Handle -> (Integer, Integer) -> [(Word8,Word8,Word8)] -> IO ()
putPPM h sz ps = TXT.hPut h (stringPPM sz ps)

  Convenience function: Write PPM data directly to a file. If the file
  does not exist, it is created. If it exists, it is overwritten.
  This function does not return until the file has been completely
  created. (It may of course throw some kind of I/O exception instead.)
writePPM :: FilePath -> (Integer, Integer) -> [(Word8,Word8,Word8)] -> IO ()
writePPM f sz ps = TXT.writeFile f (stringPPM sz ps)

  Helper function: Given a function from pixel coordinates to pixel
  colour, produce a list of pixel data ready to feed to one of the
  other PPM functions.
fn_list :: ((Integer,Integer) -> (Word8,Word8,Word8)) -> (Integer, Integer) -> [(Word8,Word8,Word8)]
fn_list fn (sx, sy) = map fn [ (x,y) | y <- [0..sy-1], x <- [0..sx-1] ]