{-| 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] ]