halftone

import Data.Array.IArray
import Control.Monad (liftM,replicateM)
import System (getArgs)
import System.Random (getStdGen,randomRs)
type Picture = Array (Int,Int) Int

step x | x < 0 = 0
       | otherwise = 1

inv 0 = 1
inv _ = 0

threshold :: Picture -> Int -> Picture
threshold a t= a//[((i',j'),inv.step$a!(i,j)-t)
                 |i' <- range(i,k),j'<-range(j,l)]
    where ((i,j),(k,l)) = bounds a
mask4 = listArray ((1,1),(4,4))
       [6,12,7,9,
        15,1,14,4,
        10,8,11,5,
        3,13,2,16]::Array(Int,Int) Int
mask3 = listArray((1,1),(3,3))
        [8,1,6,
         3,5,7,
         4,9,2]::Array(Int,Int) Int
dither ::Array(Int,Int) Int -> Picture ->Int-> Picture
dither m a n= a//[((i',j'),inv.step$ (m1*m2+1)*a!(i',j') - n*m!((mod i' m1)+1,(mod j' m2)+1))
                 |i' <- range(i,k),j'<-range(j,l)]
    where ((i,j),(k,l)) = bounds a
          ((_,_),(m1,m2)) = bounds m
rand ::Picture -> Int -> IO Picture
rand a m = do
  r <- getStdGen
  return$listArray ((1,1),(h,w))$zipWith f (elems a)$ take (h*w) $randomRs(0,m)r
          where f x y = inv.step $ x- y
                ((_,_),(h,w)) = bounds a

er ::Picture -> Int -> Picture
er a m = listArray (bounds a) $ map (inv.fst) $elems a'
    where a' = listArray (bounds a) $ map b $indices a::Array(Int,Int)(Int,Double)
          e (1,1) = 0
          e (1,j+1) = snd $ a'!(1,j)
          e (i+1,1) =sum$ zipWith (*) [2*x,2*y] $map(snd.(a'!))[(i,1),(i,2)]
          e (i+1,w) =sum$ zipWith (*) [z,z*sqrt 2,z*sqrt 2] $map(snd.(a'!))[(i,w-1),(i,w),(i+1,w-1)]
          e (i+1,j+1) =sum$ zipWith (*) [y,x,y,x] $map(snd.(a'!))[(i,j),(i,j+1),(i,j+2),(i+1,j)]
          b (i,j) = (step$ e(i,j)+(fromIntegral$a!(i,j))-m'/2,e(i,j)+(fromIntegral$a!(i,j)-m*fst(b(i,j))))
          m' = fromIntegral m 
          x = 1/(2+sqrt 2)
          y = 1/(2+2*sqrt 2)
          z = 1/(1+2*sqrt 2)
          ((_,_),(_,w)) = bounds a

splitW::Picture -> (Picture,Picture)
splitW a =(listArray((1,1),(h,w'))a1,listArray((1,1),(h,w-w'))a2) 
    where ((_,_),(h,w)) = bounds a
          w' = ceiling $ (/2).fromIntegral $ w
          a1 = [a!(i,j)|i<-range(1,h),j<-range(1,w')]
          a2 = [a!(i,j)|i<-range(1,h),j<-range(w'+1,w)]

splitH::Picture -> (Picture,Picture)
splitH a =(listArray((1,1),(h',w))a1,listArray((1,1),(h-h',w))a2)
    where ((_,_),(h,w)) = bounds a
          h' = ceiling $ (/2).fromIntegral $ h
          a1 = [a!(i,j)|i<-range(1,h'),j<-range(1,w)]
          a2 = [a!(i,j)|i<-range(h'+1,h),j<-range(1,w)]

combW::(Picture,Picture)->Picture
combW (a,b) = listArray ((1,1),(h,wa+wb)) [c(i,j)|i<-range(1,h),j<-range(1,wa+wb)]
    where ((_,_),(h,wa)) = bounds a
          ((_,_),(_,wb)) = bounds b
          c (i,j) | j <= wa = a!(i,j)
                  | otherwise =b!(i,j-wa)

combH::(Picture,Picture)->Picture
combH (a,b) = listArray ((1,1),(ha+hb,w)) [c(i,j)|i<-range(1,ha+hb),j<-range(1,w)]
    where ((_,_),(ha,w)) = bounds a
          ((_,_),(hb,_)) = bounds b
          c(i,j) | i <= ha = a!(i,j)
                 | otherwise = b!(i-ha,j)

divide::Picture -> Int -> Int -> Picture
divide a s m 
    | h == 1 && w==1 = listArray ((1,1),(1,1)) [s]
    | h > w = combH(divide h1 (signum$rh+s)m,divide h2 ((rh+s)`div`2)m)
    | otherwise = combW(divide w1 (signum$rw+s)m,divide w2 ((rw+s)`div`2)m)
    where ((_,_),(h,w)) = bounds a
          (h1,h2) = splitH a
          (w1,w2) = splitW a
          r a1 a2 = step.(flip(-)m).sum.map ((flip mod m).sum.elems) $ [a1,a2]
          (rh,rw)= (r h1 h2,r w1 w2)


getPic :: IO (String,Int,Picture)
getPic = do
  t <- getLine
  (w:h:hs) <- toNums getLine :: IO [Int]
  (m:ms) <- toNums getLine :: IO [Int]
  a <- toNums getContents ::IO[Int]
  case t of
    "P3" -> return (t,m,listArray((1,1),(h,3*w)) a)
    "P2" -> return (t,m,listArray((1,1),(h,w)) a)
    where toNums = liftM(map read.words) 

outP1 p = do
  putStrLn "P1"
  putStrLn $ show w ++" " ++ show h
  putStrLn.concat.map((" "++).show).elems $ p
      where ((_,_),(h,w)) = bounds p
outP3 p = do
  putStrLn "P3"
  putStrLn $ show (div w 3) ++" " ++ show h
  putStrLn "1"
  putStrLn.concat.map((" "++).show.((flip mod 2).(+1))).elems $ p
      where ((_,_),(h,w)) = bounds p
main :: IO ()
main = do
  a <- getArgs
  (t,m,p) <- getPic
  case (head a)++t of
    "tP2" -> outP1 $ threshold p (div m 2)
    "tP3" -> outP3 $ threshold p (div m 2) 
    "dP2" -> outP1 $ dither mask3 p m
    "dP3" -> outP3 $ dither mask3 p m
    "d3P2" -> outP1 $ dither mask3 p m
    "d3P3" -> outP3 $ dither mask3 p m
    "d4P2" -> outP1 $ dither mask4 p m
    "d4P3" -> outP3 $ dither mask4 p m
    "rP2" -> rand p m >>= outP1
    "rP3" -> rand p m >>= outP3
    "eP2" -> outP1 $ er p m
    "eP3" -> outP3 $ er p m
    "vP2" -> outP1 $ divide (listArray(bounds p)(map ((-)m) (elems p))) 0 m
    "vP3" -> outP3 $ divide p 0 m
    "gP2" -> outP1.pg.modGen$read(a!!1)

pic = listArray ((1,1),(10,10)) [0..99]::Picture
pg a = listArray ((1,1),(256,256))[a(i,j)|i<-[1..256],j<-[1..256]]::Picture
modGen  m (i,j) =inv $  (i+j)`mod` m