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.Board
import Graphics.Chalkboard.Array
readPPM :: String -> IO (Board (Maybe RGB),(Int,Int))
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 $ (arrayToBoard arr,(width,height))
writePPM :: String -> (Int,Int) -> Board RGB -> IO ()
writePPM filename (x_dim,y_dim) img = writeFile filename $
"P6\n" ++ show (x_dim) ++ " " ++ show (y_dim) ++ "\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..y_dim1]
, x <- [0..x_dim1]
]
where arr = boardToArray (x_dim1,y_dim1) 3 img