--liz evans
-- cs429 Final project

import "game.hs"
import "Fal.lhs"
import "Picture.lhs"
import SOEGraphics hiding (Region, Event)
import "Draw.lhs" (trans)

--constants
sz :: Behavior Float
sz = 1
tn :: Float
tn = 0.2
xoff :: Float
xoff = 2.5
yoff :: Float
yoff = 2.0

-- create static colors
ones :: [Int]
ones = 1 : ones

numbers :: [Int]
numbers = 1: zipWith (+) ones numbers 

colorL = red : blue :yellow :green : white : colorL

colors :: [(Int,(Behavior Color))]
colors = zip numbers colorL

lookup' :: Int-> [(Int,b)] -> b
lookup' n (x:xs) = if (n == (fst x)) then (snd x) else (lookup' n xs) 
lookup'_ _ = white

--helper
intToFloat :: Int -> Float
intToFloat n = fromInteger (toInteger n) 


-- mini key
transX :: Float -> Float
transX x = (x * tn) - xoff
transY :: Float -> Float
transY y = (y * tn) + yoff

tiny = lift0 tn

drawK n count (x:xs)= if (xs == []) 
			then paint color (translate (xpos,ypos) (rec tiny tiny)) 
			else paint color (translate (xpos,ypos) (rec tiny tiny)) 
				`over` (drawK n (count+1) xs)
		       where xpos = lift0 (transX((xposC count n) - 0.5))
			     ypos = lift0 (transY(0.5 - (yposC count n 0.0)))
			     color = if (x ==0 ) then black
					else lookup' x colors

--drawB n count things colors
drawB n count (x:xs)= if (xs == []) 
			then paint color (translate (xpos,ypos) (rec sz sz)) 
			else paint color (translate (xpos,ypos) (rec sz sz)) 
				`over` (drawB n (count+1) xs)
		       where xpos = lift0 ((xposC count n) - 0.5)
			     ypos = lift0 (0.5 - (yposC count n 0.0))
			     color = if (x ==0 ) then black
					else lookup' x colors
			     

xposC :: Int -> Int -> Float
xposC count n = if (notMulOf count n)
				then (intToFloat (count `mod` n))
				else 0.0

yposC :: Int -> Int -> Float -> Float
yposC x n level =  if (x == 0)
			then level
			else if (x `mod` n) == 0
				then yposC (x-1)  n (level+1)
				else yposC (x-1)  n level

--reactive

--play' :: Int -> [Int] ->  (Behavior Picture) 
play' n xs ys=
   let
	slider = filterE  (\x -> if x== -1 then Nothing else Just x)
		(snapshot lbp which)
	
	which = lift3 whichOne (fst mouse) (snd mouse) (lift0 n)

   in ((drawB n 0 xs) `over` (drawK n 0 ys)) `untilB`  slider =>> 
			(\x -> (play' n (slide (x+1) n xs) ys))

whichOne a b n = if ((x < -1) || (x >= (n-1)) || (y > 1) || (y <= (1-n))) 
			then -1
		    else ((((1-y) `mod` n)* n) + x + 1)
		where  x = (ceiling a) -1
		       y = (ceiling b) 

filterE :: (b -> Maybe c) -> Event (a, b) -> Event c
filterE p (Event fe) = Event (\uts -> map aux (fe uts))
    where aux (Just (a, b)) = p b
          aux _ = Nothing

-- THE GAME
play n = test $ play' n (boardGen n) (gen 0 (n*n))