Library for PPM images

From HaskellWiki
Revision as of 12:48, 17 April 2007 by MathematicalOrchid (talk | contribs) (Added 'P6' PPM file format.)
Jump to navigation Jump to search


Here's a trivial little thing I wrote for saving PPM images.

For those that don't know, PPM is probably the simplest possible image file format that other software will actually read! For example, IrfanView will read it. Thus, this is a simple, light-weight way to write programs that will output graphics files, using only pure Haskell 98 I/O.

ASCII PPM

module PPM (make_ppm, save_ppm) where

import Colour

save_ppm :: FilePath -> [[Colour]] -> IO ()
save_ppm f css = writeFile f $ make_ppm css

make_ppm :: [[Colour]] -> String
make_ppm css =
  "P3\n" ++ (show $ length $ head css) ++ " " ++ (show $ length css) ++ " 255\n" ++
  (unlines $ map unwords $ group 15 $ map show $ concatMap colour $ concat css)

group _ [] = []
group n xs =
  let (xs0,xs1) = splitAt n xs
  in  xs0 : group n xs1

colour (Colour r g b) = [channel r, channel g, channel b]

channel :: Double -> Int
channel = floor . (255*) . min 1 . max 0

The code is actually designed to work with my Library for colours - but you can supply something of your own if you prefer.

Binary PPM

This is the 'P6' PPM format. The header is still plain ASCII, but the actual raster data is binary. This makes the file roughly 10x smaller. I suspect it also makes it go faster too. This library is a drop-in replacement for the one about; include whichever one you want depending on what output you want.

module Fast_PPM (make_ppm, save_ppm) where

import Data.Word
import qualified Data.ByteString as BIN
import Colour

quant8 :: Double -> Word8
quant8 x = floor $ x * 0xFF

cquant8 :: Colour -> [Word8]
cquant8 (Colour r g b) = [quant8 r, quant8 g, quant8 b]

string_to_bin :: String -> BIN.ByteString
string_to_bin = BIN.pack . map (fromIntegral . fromEnum)

header :: [[Colour]] -> BIN.ByteString
header pss =
  let nx = length $ head pss
      ny = length        pss
  in  string_to_bin $ "P6\n" ++ show nx ++ " " ++ show ny ++ " 255\n"

body :: [[Colour]] -> BIN.ByteString
body pss = BIN.pack $ concatMap (cquant8 . cclip) $ concat pss

make_ppm :: [[Colour]] -> BIN.ByteString
make_ppm pss = BIN.append (header pss) (body pss)

save_ppm :: FilePath -> [[Colour]] -> IO ()
save_ppm f pss = BIN.writeFile f (make_ppm pss)