-- |
-- Module: Graphics.Chalkboard.PPM
-- Copyright: (c) 2009 Andy Gill
-- License: BSD3
--
-- Maintainer: Andy Gill <andygill@ku.edu>
-- Stability: unstable
-- Portability: ghc
--
-- Reading and writing portable pix maps. For now, we only support color images (@P1@, @P3@ and @P6@ formats).
--

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' reads a PPM file, and outputs a @Board@, and the @x@ and @y@ dimensions of the image.
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])
--	print width
--	print height   
 	mx <- hGetLine h
	let [maxs] = (map read (words mx) :: [R])
--	print mx
	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),(width-1,height-1))
		[ ((w,h'),RGB r g b)
		| (row,h') <- zip num_rows [height-1,height-2..]
		, ([r,g,b],w) <- zip row [0..]
		]
	return $ arr -- (arrayToBoard arr,(width,height))


-- | 'readBPM' reads a PPM file, and outputs a @Board@, and the @x@ and @y@ dimensions of the image.
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])
--	print width
--	print height   
-- 	mx <- hGetLine h
--	let [maxs] = (map read (words mx) :: [R])
--	print mx
	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),(width-1,height-1))
		[ ((w,h'),v)
		| (row,h') <- zip num_rows [height-1,height-2..]
		, (v,w) <- zip row [0..]
		]
	return $ arr -- (arrayToBoard arr,(width,height))

-- | 'writePPM' writes a PPM file, based on a color @Board@, where bottom left corner of the image is as @(0,0)@.
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..(h-1)]
	, x <- [0..(w - 1)]
	]
   where (w,h) = widthHeight arr