module Graphics.Chalkboard.PPM where
import System.IO
import Data.Array
import Data.Char
import Graphics.Chalkboard.Types
import Graphics.Chalkboard.Color
import Graphics.Chalkboard.Array
readPPM :: String -> IO (Array (Int,Int) RGB)
readPPM filename = do
h <- openFile filename ReadMode
ty <- hGetLine h
bin <- case ty of
"P3" -> return False
"P6" -> return True
_ -> error $ "bad PPM format: " ++ ty
szs <- hGetLine h
let [width,height] = (map read (words szs) :: [Int])
mx <- hGetLine h
let [maxs] = (map read (words mx) :: [R])
str <- hGetContents h
let num1 = if bin
then map (\ x -> fromIntegral (ord x) / maxs) str
else map (\ x -> read x / maxs) (words str)
let joinN _ [] = []
joinN n xs = take n xs : joinN n (drop n xs)
let num3 = joinN 3 num1
let num_rows = joinN width num3
let arr = array ((0,0),(width1,height1))
[ ((w,h'),RGB r g b)
| (row,h') <- zip num_rows [height1,height2..]
, ([r,g,b],w) <- zip row [0..]
]
return $ arr
readPBM :: String -> IO (Array (Int,Int) Bool)
readPBM filename = do
h <- openFile filename ReadMode
ty <- hGetLine h
_bin <- case ty of
"P1" -> return False
"P4" -> error "P4 PBM format not (yet) supported"
_ -> error $ "bad PPM format: " ++ ty
szs <- hGetLine h
let [width,height] = (map read (words szs) :: [Int])
str <- hGetContents h
let num1 = map (\ x -> if x == '1' then True else
if x == '0' then False
else error $ "bad data inside P1 file" ++ show x)
$ filter (not . isSpace) str
let joinN _ [] = []
joinN n xs = take n xs : joinN n (drop n xs)
let num_rows = joinN width num1
let arr = array ((0,0),(width1,height1))
[ ((w,h'),v)
| (row,h') <- zip num_rows [height1,height2..]
, (v,w) <- zip row [0..]
]
return $ arr
writePPM :: String -> Array (Int,Int) RGB -> IO ()
writePPM filename arr = writeFile filename $
"P6\n" ++ show w ++ " " ++ show h ++ "\n255\n" ++
concat
[ let (RGB r g b) = arr ! (x,y)
f x' = if v < 0 then chr 0 else
if v > 255 then chr 255 else chr v
where v = floor (x' * 255)
in [f r,f g,f b]
| y <- reverse [0..(h1)]
, x <- [0..(w 1)]
]
where (w,h) = widthHeight arr