module Functions
where

import Data.List(transpose)

import Types

black   ::          Int -> Int -> Picture
black	= grey 0.0

white   ::          Int -> Int -> Picture
white	= grey 1.0

grey    :: Color -> Int -> Int -> Picture
grey c w h
    | w <= 0 || h <= 0
      = []
    | otherwise
	= replicate h . replicate w $ c

b2wH    ::          Int -> Int -> Picture
b2wH w h
    | h <= 1
	= grey 0.5 w h
    | h > 1
	= [ replicate w (c i) | i <- [0..h-1] ]
	  where
	  c i = toFloat i / toFloat (h-1)

b2wV    ::          Int -> Int -> Picture
b2wV w h
    | w <= 1
	= grey 0.5 w h
    | w > 1
	= replicate h [ c i | i <- [0..w-1] ]
	  where
	  c i = toFloat i / toFloat (w-1)

-- oder
-- b2wV w h = rotate90 (b2wH h w)

b2wD    ::          Int -> Int -> Picture
b2wD w h
    | w + h <= 1
      = grey 0.5 w h
    | w + h > 1
      = [[c i j | i <- [0..w-1]] | j <- [0..h-1]]
	where
	c i j = toFloat (i+j) / toFloat (w + h -2)
-- oder
-- b2wD w h = b2wH w h `addPicture` b2wV w h

toFloat	:: Int -> Float
toFloat	= fromInteger . toInteger

-- ----------------------------------------

mapPicture	:: (Color -> Color) ->
                   Picture -> Picture
mapPicture f	= map (map f)

invert		:: Picture -> Picture
invert		= mapPicture (\x -> 1.0 - x)

bitMap		:: Picture -> Picture
bitMap		= mapPicture
		  ( \ x -> if x < 0.5
		           then 0.0
                           else 1.0
                  )

reduceColors	:: Int ->
		   Picture -> Picture
reduceColors n
    | n <= 1
	= mapPicture (const 0.5)
    | n > 1
	= mapPicture reduce
    where
    reduce x
	= 1.0 `min`
	  ( toFloat (floor (x * toFloat n))
	    /
	    toFloat (n-1)
	  )

gammaFct	:: Float -> Float -> Float
gammaFct g x	= x ** (1.0 / g)

gamma		:: Float ->
		   Picture -> Picture
gamma g		= mapPicture (gammaFct g)

stretch		:: Picture -> Picture
stretch p
    | dark < light
	= mapPicture str p
    | otherwise
	= p
    where
    dark 	= minimum (map minimum p)
    light	= maximum (map maximum p)
    str c	= (c - dark) / (light - dark)

-- ----------------------------------------

flipH	:: Picture -> Picture
flipH	= reverse

flipV	::          Picture -> Picture
flipV	= map reverse

rot90	:: Picture -> Picture
rot90	= transpose

rot180	::          Picture -> Picture
rot180	= flipV . flipH

rot270	:: Picture -> Picture
rot270	= rot90 . rot180

-- ----------------------------------------

halfSize	:: Picture -> Picture
halfSize
    = col2 . map row2
    where
    col2	:: Picture -> Picture
    col2	= map (uncurry (zipWith mean)) . pair

    row2	:: [Color] -> [Color]
    row2	= map (uncurry mean) . pair

pair		:: [a] -> [(a, a)]
pair (x1:x2:xs)	= (x1, x2) : pair xs
pair _		= []

mean		:: Color -> Color -> Color
mean x y		= (x + y) / 2.0

-- ----------------------------------------

zipPicture	:: (Color -> Color -> Color) ->
		   Picture -> Picture -> Picture
zipPicture	= zipWith . zipWith

addPicture	:: Picture -> Picture -> Picture
addPicture	= zipPicture mean

subPicture	:: Picture -> Picture -> Picture
subPicture	= zipPicture (\ x y -> (x - y + 1.0) / 2.0)

mulPicture	:: Picture -> Picture -> Picture
mulPicture	= zipPicture (*)

-- ----------------------------------------

beside		:: Picture -> Picture -> Picture
beside		= zipWith (++)

above		:: Picture -> Picture -> Picture
above		= (++)

above'		:: Picture -> Picture -> Picture
above' p1 p2	= reduceWidth w p1
		  ++
		  reduceWidth w p2
    where
    w = length (head p1) `min` length (head p2)
    
reduceWidth	:: Int -> Picture -> Picture
reduceWidth	= map . take

reduceHeigth	:: Int -> Picture -> Picture
reduceHeigth	= take

reduceSize	:: Int -> Int ->
		   Picture -> Picture
reduceSize w h	= reduceWidth w . reduceHeigth h

row		:: [Picture] -> Picture
row		= foldr1 beside

stack		:: [Picture] -> Picture
stack		= foldr1 above

-- ----------------------------------------

testCases	:: [ ( Picture -> Picture,
		       Picture -> Picture ) ]
testCases
    = [ ( invert . invert,
	  id		)
      , ( bitMap,
	  reduceColors 2	)
      , ( bitMap . bitMap,
	  bitMap		)
      , ( reduceColors 3 . reduceColors 3,
	  reduceColors 3	)
      , ( reduceColors 2 . reduceColors 4,
	  reduceColors 2	)
      , ( reduceColors 3
	  . gamma 0.5 . gamma 2.0
	  . reduceColors 3,
	  id		)
      , ( flipH . flipH,
	  id		)
      , ( flipV . flipV,
	  id		)
      , ( flipH . flipV,
	  flipV . flipH	)
      , ( rot90 . rot90,
	  rot180	)
      , ( rot90 . rot270,
	  id		)
      ]

test	:: Picture -> [Bool]
test p	= map compare testCases
	  where
	  compare (f1, f2) = f1 p == f2 p

-- ----------------------------------------