{- Tim's NetPNM processor
   (C) Tim Haynes, 2004    <mailto:netpbmhs@spodzone.org.uk>

   Redistributable under the terms of the BSD License, see
   <http://www.opensource.org/licenses/bsd-license.php>

   Known to work well with ghc, anything else is your own problem.
-}

import IO
import System
import List
import Char (toUpper,ord,chr,showLitChar)
import Maybe

toFloat :: Int -> Float
toFloat n = fromInteger (toInteger n) :: Float

type Format=String
type Width=Int
type Height=Int
type Depth=Int
type Color=Int
type Pixel= (Color,Color,Color)
type BigPixel = (Integer,Integer,Integer)
type Body=[Pixel]
type Image = (Format, Width, Height, Depth, Body)


bytesToInt :: Char -> Char -> Int
bytesToInt h l = let hi= ord h
		     lo= ord l
		  in 256*hi + lo

intToBytes :: Int -> [Char]
intToBytes i = [chr (i `div` 256),
		chr (i `mod` 256)]

getRed :: Pixel -> Color
getRed (r,g,b) = r

getGreen :: Pixel -> Color
getGreen (r,g,b) = g

getBlue :: Pixel -> Color
getBlue (r,g,b) = b

getWidth :: Image -> Width
getWidth = \(f,w,h,d,b) -> w

getHeight :: Image -> Height
getHeight = \(f,w,h,d,b) -> h

getDepth :: Image -> Depth
getDepth = \(f,w,h,d,b) -> d

getBody :: Image -> Body
getBody = \(f,w,h,d,b) -> b

intens :: Pixel -> Color
intens (r,g,b) = (2*r+3*g+2*b) `div` 7

gS :: Pixel -> Pixel
gS p = let i=intens p
		in (i, i, i)

greyScale :: Image -> Image
greyScale (f,w,h,d,b) = (f,w,h,d,map gS b)

redScale :: Image -> Image
redScale (f,w,h,d,b) = (f,w,h,d, map (\(r,g,b)-> (r,0,0)) b )

greenScale :: Image -> Image
greenScale (f,w,h,d,b) = (f,w,h,d, map (\(r,g,b)-> (0,g,0)) b )

blueScale :: Image -> Image
blueScale (f,w,h,d,b) = (f,w,h,d, map (\(r,g,b)-> (0,0,b)) b )

redChannel :: Image -> [Color]
redChannel (f,w,h,d,b) = map getRed b

greenChannel :: Image -> [Color]
greenChannel (f,w,h,d,b) = map getGreen b

blueChannel :: Image -> [Color]
blueChannel (f,w,h,d,b) = map getBlue b

sumPixels :: Pixel -> Pixel -> BigPixel
sumPixels (r1,g1,b1) (r2,g2,b2) = (toInteger (r1+r2), 
				   toInteger (g1+g2), 
			 	   toInteger (b1+b2))

pixelToBigPixel :: Pixel -> BigPixel
pixelToBigPixel (r,g,b) = (toInteger r, toInteger g, toInteger b)

averageColor :: Image -> Pixel
averageColor i = let 	bi=getBody i
			sr=sum [toInteger r | r <- map getRed bi]
			sg=sum [toInteger r | r <- map getGreen bi]
			sb=sum [toInteger r | r <- map getBlue bi]
			nopels= toInteger ((getWidth i) * (getHeight i))
		   in
			(fromInteger (sr `div` nopels), 
			 fromInteger (sg `div` nopels), 
			 fromInteger (sb `div` nopels))

pixelsToString :: [(Pixel)] -> String
pixelsToString [] = []
pixelsToString ((r,g,b):ps)=
		  (intToBytes r) ++ (intToBytes g) ++ (intToBytes b)
		    ++ (pixelsToString ps)


formatImage :: Image -> String
formatImage (f,w,h,d,b) = f ++ "\n" ++ show w ++ " " ++ show h ++ "\n"
			    ++ show d ++ "\n" ++ pixelsToString b

readBody :: String -> [Char] -> [Pixel]
readBody _ [] = []
readBody "65535" (r1:r2:g1:g2:b1:b2:t)=
	   	    [((bytesToInt r1 r2), 
		      (bytesToInt g1 g2), 
		      (bytesToInt b1 b2))] ++ readBody "65535" t
readBody "255" (r:g:b:t) = [(ord r, ord g, ord b)] ++ readBody "256" t
readBody _ _ = []

readImage fmts dims depths body =
  		          (fmts, (read (head (words dims)) :: Int),
				 (read ((words dims) !! 1) :: Int),
				 (read depths :: Int),
				 readBody depths body)

normalize :: Image -> Image
normalize i = let ap=averageColor i
	 	  ai=intens ap
		in 
		 ("P6", getWidth i, getHeight i, getDepth i,
		    map ( \p -> if (or [intens p < ai*8 `div` 10, 
				        intens p > ai*11 `div` 10] )
				then p else ap)
			(getBody i))

fixupBody :: Pixel -> Pixel -> Body -> Body -> Body
fixupBody avg lastpixel [] _ = []
fixupBody avg lastpixel (p:ps) (f:fs) = 
	 	if ((intens f) < (intens avg)*9`div`10)
		then
		  [lastpixel] ++ (fixupBody avg lastpixel ps fs)
		else
		  [p] ++ (fixupBody avg p ps fs)

fixupImage :: Image -> Image -> Image
fixupImage src norm = 	let a=averageColor norm
			    sb=getBody src
			in  
			("P6", getWidth src, getHeight src, getDepth src,
			 (fixupBody a 
				    (head sb)
				    sb 
				    (getBody norm)))

main = do
	  fmts <- getLine
	  dims <- getLine
	  depths <- getLine
	  body <- getContents
	  args <- getArgs
	  let i=readImage fmts dims depths body
	   in case args of 
		[]  	  -> do putStr (formatImage i)
		["-avg"]  -> do 
				putStr "Average pixel value is: " 
				print (averageColor i)
		["-grey"] -> do putStr (formatImage (greyScale i))
		["-r"] 	  -> do putStr (formatImage (redScale i))
		["-g"] 	  -> do putStr (formatImage (greenScale i))
		["-b"] 	  -> do putStr (formatImage (blueScale i))
		["-n"] 	  -> do putStr (formatImage (normalize i))
		["-fix"]  -> do 
				fwf <- openFile "white-normalized.pnm" ReadMode
			    	fwfmt <- hGetLine fwf
				fwdims <- hGetLine fwf
				fwdepth <- hGetLine fwf
				fwbody <- hGetContents fwf
				let img=readImage fwfmt fwdims fwdepth fwbody
			       	  in putStr (formatImage (fixupImage i img))
				putStr ""