module Codec.Image.PPM (ppm, ppm_p6, ColorArray, Color) where
import Control.Monad.Writer
import Data.Char
import Data.List (intersperse)
data Profile = P3 | P6 deriving (Show)
type Color = (Int, Int, Int)
type ColorArray = [Color]
data PPM = PPM
{ profile :: Profile
, color :: Int
, columns :: Int
, rows :: Int
, bytes :: ColorArray
}
deriving (Show)
def :: PPM
def = PPM P3 255 0 0 []
dump_ppm :: PPM -> String
dump_ppm x = execWriter $ do
write $ profile x
br
write $ columns x
tell " "
write $ rows x
br
write $ color x
br
mapM_ (write_pixel (profile x)) (bytes x)
where
write_pixel P3 (r,g,b) = do
let xs = [r,g,b]
tell $ concat $ intersperse " " $ map show xs
br
write_pixel P6 (r,g,b) = do
let xs = [r,g,b]
tell $ map chr xs
br = tell "\n"
write :: (Show a) => a -> Writer String ()
write = tell . show
ppm :: [ColorArray] -> String
ppm xs = dump_ppm $ from_list xs
ppm_p6 :: [ColorArray] -> String
ppm_p6 xs = dump_ppm $ (from_list xs) {profile = P6}
from_list :: [ColorArray] -> PPM
from_list [] = def
from_list xs = def
{ columns = length $ head xs
, rows = length xs
, bytes = concat xs
}