Monday, 1 October 2007

lib for the image processing stuff

This is the library file for that image processing project.

-- PPMlib.hs
-- Library for 433-152 Project 2007
-- Bernard Pope

module PPMlib where

import Text.ParserCombinators.Parsec

type Pixel = (Int, Int, Int)

data PPM
= PPM Int Int Int [Pixel]
deriving Show

getPixels :: PPM -> [Pixel]
getPixels (PPM _ _ _ ps) = ps

getWidth :: PPM -> Int
getWidth (PPM w _ _ _) = w

getHeight :: PPM -> Int
getHeight (PPM _ h _ _) = h

getMaxVal :: PPM -> Int
getMaxVal (PPM _ _ m _) = m

{- transform interface
example: transform verify greyScale "in.ppm" "out.ppm"
-}

transform :: (PPM -> Maybe String) -> (PPM -> PPM) -> String -> String -> IO ()
transform verify trans inFile outFile = do
result <- parser inFile
case result of
Left e -> print e
Right ppm -> do
case verify ppm of
Nothing -> do
let newPPM = trans ppm
case verify newPPM of
Nothing -> writeFile outFile $ pretty newPPM
Just err -> do
putStrLn "Error in transformed image"
putStrLn err
Just err -> do
putStrLn "Error in input image"
putStrLn err

{- pretty printing PPM files -}

pretty :: PPM -> String
pretty (PPM width height maxVal pixels)
= "P3 " ++ unwords [show width, show height] ++ "\n" ++
unlines (show maxVal : prettyPixels pixels)
where
prettyPixels :: [Pixel] -> [String]
prettyPixels = map prettyPixel
prettyPixel :: Pixel -> String
prettyPixel (r,g,b) = unwords $ map show [r,g,b]

{- parsing PPM files -}

parser :: String -> IO (Either ParseError PPM)
parser = parseFromFile parsePPM

parsePPM :: Parser PPM
parsePPM = do
string "P3"
junk
width <- parseInt
junk
height <- parseInt
junk
maxVal <- parseInt
junk
pixels <- many parseTriplet
return $ PPM width height maxVal pixels

comment :: Parser ()
comment = do
char '#'
manyTill anyChar newline
spaces

junk :: Parser ()
junk = do
spaces
optional comment

parseTriplet :: Parser (Int, Int, Int)
parseTriplet = do
red <- parseInt
spaces
green <- parseInt
spaces
blue <- parseInt
spaces
return (red, green, blue)

parseInt :: Parser Int
parseInt = do
ds <- many1 digit
return $ read ds

No comments: