import SOEGraphics

type Side = Int
type Tile = (Side,Side,Side,Side)
type Position = (Int,Int)
type Board = [(Tile,Position)]

-- Basic operation on Tiles

getUp :: Tile -> Side
getUp (u,r,d,l)=u

getRight :: Tile -> Side
getRight (u,r,d,l)=r

getDown :: Tile -> Side
getDown (u,r,d,l)=d

getLeft :: Tile -> Side
getLeft (u,r,d,l)=l

rmv :: Tile -> [Tile] ->[Tile]
rmv a (b:bs) = if same a b
	      then bs
	      else b:(rmv a bs)
rmv a [] = []

same :: Tile -> Tile -> Bool
same (u,r,d,l) (u',r',d',l') =
    u == u' && r == r' && d == d' && l == l'

-------------------------------------------------------------------------
--     Search Algorithm
-------------------------------------------------------------------------

-- Given a list of tiles and all possible positions, return the solution
-- and the step it used.
game :: [Tile] -> [Position]-> (Board,Int)
game t p= 
    let res = play t p [] [] 0
    in
        case res of
		 (Nothing,i) -> ([],i)
		 (Just b,i) -> (b,i)

-- Search Algorithm	    
play :: [Tile] -> [Position] -> Board -> [Tile]-> Int -> (Maybe Board, Int)
play (t:ts) (p:ps) b usucc i=
    let t1 =  sort (t:ts) p b 
    in
	case t1 of
 		Nothing -> (Nothing,i)
		Just tt -> 
		     let newb = (tt,p):b
			 nexts = rmv tt (t:ts)
			 newts = nexts  ++ usucc             
	       		 next = play newts ps newb [] (i+1)	 
		     in
		      case next of
			(Nothing, is) -> play nexts (p:ps) b (tt:usucc) is
			(Just bs, is) -> (Just bs, is)
play [] [] b _ i = (Just b , i)
play [] (p:ps) _ _ i = (Nothing,i)
	  
-- Find a suitable Tile for the given position
sort :: [Tile]->Position->Board->Maybe Tile
sort (t:ts) p b =
    if (match (t,p) b)
       then  Just t
	     else sort ts p b
sort [] _ _ = Nothing

-- Check whether the new tile have conflicts with Board
match :: (Tile,Position)->Board -> Bool
match (t,p) b = 
    let (up,right,down,left) = findAdj p b
    in ((noconflict (getUp t) up 'u') && (noconflict (getRight t) right 'r')  
         && (noconflict (getDown t) down 'd') && 
	(noconflict (getLeft t) left 'l')) 

-- Check the attached Side with same number or not
noconflict :: Side -> Maybe (Tile,Position) -> Char -> Bool
noconflict _ Nothing _ = True
noconflict s (Just((u,r,d,l),_)) c =
    case c of 
	   'u' -> s == d
	   'r' -> s == l
	   'd' -> s == u
           'l' -> s == r

-- Find adjuncent tiles in the Board
findAdj (x,y) [] = (Nothing,Nothing,Nothing,Nothing)
findAdj (x,y) ((t,(x',y')):bs) =
    let (u,r,d,l) = findAdj (x,y) bs
    in
	if (x' == x+1 && y' == y) then (u,r,Just (t,(x',y')),l)
	   else
	   if (x' == x-1 && y' == y) then (Just (t,(x',y')),r,d,l)
	      else
	      if (x' == x && y' == y+1) then (u,Just (t,(x',y')),d,l)
		 else
		 if (x' == x && y' == y-1) then (u,r,d,Just (t,(x',y')))
		    else (u,r,d,l)



---------------------------------------------------------------------------
--         Result Show
---------------------------------------------------------------------------

-- pixels per square
pps = 40 :: Int

-- Translate the Position of a tile to the real Points in the Window
snodes :: Position->[Point]
snodes (x,y) =
	let x'=y*pps-1
	    y'=x*pps-1
	    y''=(x-1)*pps +1
	    x''=(y-1)*pps +1
	in [(x'',y''),(x'',y'),(x',y'),(x',y'')]

-- For the four values of a tile, calulate the proper position to put
-- them in the window
tnodes :: Position->[Point]
tnodes (x,y) =
	let xm = y*pps - (pps `div` 2)- 5
	    ym = x*pps - (pps `div` 2)- 6
	    det = (pps `div` 4)+2
	    x2 = xm -det
	    y2 = ym + det
	    x1 = xm +det
	    y1= ym - det
	in [(xm,y1),(x1,ym),(xm,y2),(x2,ym)]

-- This is to draw a single tile in the window
drawTile w (t,p)=
     do drawInWindow w (withColor Cyan (polygon l1))
	drawInWindow w (withColor Black (line x1 y1))
	drawInWindow w (withColor Black (line x2 y2))
	sequence_(map showtext (zipWith text t1 texts)) 
      where
	l1=snodes p
	x1=nth 1 l1
	x2=nth 2 l1
	y1=nth 3 l1
	y2=nth 4 l1
	t1 = tnodes p
	texts = toString(tolist t)
	showtext g = drawInWindow w (withColor Black g)

-- Show the Game result
render :: String -> Int -> [(Tile,Position)] -> IO ()
render title n ts = runGraphics(
       let dim= n * pps
       in
	do w <- openWindow title (dim,dim)
	   sequence_(map (drawTile w) ts)
	   k <- getKey w
           closeWindow w
      )

-- Some Helper functions

	
tolist :: Tile->[Side]
tolist (a,b,c,d) = [a,b,c,d]
	
nth :: Int -> [a] -> a
nth n (a:as) = 
	if n == 1 
	then a
	else nth (n-1) as

toString :: [Side] -> [String]
toString [] = []
toString (a:as) =
	case a of
	0 -> "0":(toString as)
	1 -> "1":(toString as)
	2 -> "2":(toString as)
	3 -> "3":(toString as)
	4 -> "4":(toString as)
	5 -> "5":(toString as)
	6 -> "6":(toString as)
	7 -> "7":(toString as)
	8 -> "8":(toString as)
	9 -> "9":(toString as)
-------------------------------------------------------------------------
--      Start to run
-------------------------------------------------------------------------
playgame :: Int -> [Tile]-> (Int->[Position])-> IO()
playgame n ts gens =
	let pos = gens n
	    tnum = n * n
	    tlen = length ts
	in
	  if (tlen == tnum)
	      then 
		let (rest,i) = game ts pos
		in
		  case rest of
		     [] -> putStr ("No Match founded. IN Step \n" ++(show i))
		     _  -> render ("TeTravex: in step " ++ (show i)) n rest
	      else putStr "The number of Tile is not correct.\n"

-- Use Sequence 1 to search the puzzle
start1 :: Int -> [Tile] ->IO()
start1 n ts =
	playgame n ts (genPos 1)

-- Use Sequence 2 to Search the puzzle
start2 :: Int -> [Tile] ->IO()
start2 n ts =
	playgame n ts newPos

-- Generate the sequence of search.
-- Way 1 line by line and from left to right.
genPos::Int->Int->[Position]
genPos s e=
       if s == e then (genLine s e)
	  else (genLine s e)++(genPos (s+1) e)

genLine::Int->Int->[Position]
genLine n len =
    if len == 0 then []
       else (n,len):(genLine n (len-1))


-- Generate the sequence of search.
-- Way 2: from upper left corner to the right down corner

newPos::Int->[Position]
newPos 2 = [(1,1),(1,2),(2,1),(2,2)]
newPos n = 
	let ps=newPos (n-1)
	in ps ++ (getNew 1 n [])

getNew::Int->Int->[Position]->[Position]
getNew x 1 ps = (x,1):ps
getNew x y ps = if (x >= y)
		then getNew x (y-1) ((x,y):ps)
	        else getNew (x+1) y ((x,y):ps)


-------------------------------------------------------------------------
-- Some Puzzles
-------------------------------------------------------------------------
   
t3::[Tile]
t3=[(4,0,6,8),(3,8,4,9),(0,8,9,6),(6,7,6,6),(8,8,3,7),
     (6,9,8,2),(4,6,9,1),(6,4,0,8),(8,1,3,3)]

t4::[Tile]
t4 = [(4,3,3,2),(9,4,1,1),(3,1,2,8),(8,0,1,0),
	(9,0,4,1),(8,2,9,6),(8,2,8,0),(8,1,8,1),
	(4,0,5,3),(4,7,8,0),(7,8,0,9),(3,0,7,5),
	(2,1,4,9),(1,6,8,2),(5,2,3,0),(1,1,8,7)]
t5::[Tile]
t5 =   [(7,4,5,9),(7,7,1,8),(1,7,9,6),(3,8,6,2),(6,6,4,5),
	(1,2,3,7),(4,2,3,3),(5,1,2,0),(2,5,6,3),(3,7,9,9),
      	(7,6,1,5),(9,1,4,2),(4,2,2,9),(8,9,4,1),(6,3,8,6),
	(1,1,1,9),(1,2,0,2),(9,6,7,5),(2,5,6,8),(4,5,6,2),
	(6,7,6,6),(7,8,7,1),(4,2,6,7),(9,9,7,4),(6,9,1,3)]

show1 = start1 3 t3
show2 = start2 3 t3

show1' = start1 4 t4
show2' = start2 4 t4

t2::[Tile]
t2=[(0,1,0,1),(1,0,0,1),(0,1,0,1),(1,1,0,0)]


test = start1 2 t2