51 lines
1.6 KiB
Haskell
51 lines
1.6 KiB
Haskell
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
module Bitmap.Netpbm(readNetpbm, writeNetpbm) where
|
|
|
|
import Bitmap
|
|
import Data.Char
|
|
import System.IO
|
|
import Control.Monad
|
|
import Control.Monad.ST
|
|
import Data.Array.ST
|
|
|
|
nil :: a
|
|
nil = undefined
|
|
|
|
readNetpbm :: forall c. Color c => FilePath -> IO (Image RealWorld c)
|
|
readNetpbm path = do
|
|
let die = fail "readNetpbm: bad format"
|
|
ppm <- readFile path
|
|
let (s, rest) = splitAt 2 ppm
|
|
unless (s == magicNumber) die
|
|
let getNum :: String -> IO (Int, String)
|
|
getNum ppm = do
|
|
let (s, rest) = span isDigit $ skipBlanks ppm
|
|
when (null s) die
|
|
return (read s, rest)
|
|
(width, rest) <- getNum rest
|
|
(height, rest) <- getNum rest
|
|
(_, c : rest) <-
|
|
if getMaxval then getNum rest else return (nil, rest)
|
|
unless (isSpace c) die
|
|
i <- stToIO $ listImage width height $
|
|
fromNetpbm $ map fromEnum rest
|
|
return i
|
|
where skipBlanks =
|
|
dropWhile isSpace .
|
|
until ((/= '#') . head) (tail . dropWhile (/= '\n')) .
|
|
dropWhile isSpace
|
|
magicNumber = netpbmMagicNumber (nil :: c)
|
|
getMaxval = not $ null $ netpbmMaxval (nil :: c)
|
|
|
|
writeNetpbm :: forall c. Color c => FilePath -> Image RealWorld c -> IO ()
|
|
writeNetpbm path i = withFile path WriteMode $ \h -> do
|
|
(width, height) <- stToIO $ dimensions i
|
|
let w = hPutStrLn h
|
|
w $ magicNumber
|
|
w $ show width ++ " " ++ show height
|
|
unless (null maxval) (w maxval)
|
|
stToIO (getPixels i) >>= hPutStr h . toNetpbm
|
|
where magicNumber = netpbmMagicNumber (nil :: c)
|
|
maxval = netpbmMaxval (nil :: c)
|