import Array
import Data.List
import Debug.Trace
import System.IO

{- Datovy typ pro hrace a jeho symbol na hracim poli -}
data Player = Cross | Circle | None deriving Eq

type GameFieldArray = Array (Int,Int) Player

data GameFieldBorder = GameFieldBorder { left, right, top, bottom ::Int } deriving Show

{- Hraci plan se sklada z 
	fieldData - matice se symboly hracu, nebo praznym symbolem
		- fieldData by mely byt meneny pres pristupovou fci, protoze jejich zmena
		vyzaduje i zmenu hranic.
	border - hranice, ktere oznacuji ctverec, ve kterem se hra odehrava -}
data GameField = GameField { fieldData::GameFieldArray, border::GameFieldBorder }


switchPlayer :: Player -> Player
switchPlayer player = 
	case player of
		Cross -> Circle
		Circle -> Cross
		None -> error "None player nemuze byt 'switched'."

createGameField :: Int -> Int -> GameField
createGameField width height = 
	if (width < 5) || (height < 5) then error "Pole mensi jak 5x5 nedava smysl"
	else
		let widthHalf = (width `div` 2) in
		let heightHalf = (height `div` 2) in
		GameField (listArray ((1,1),(width, height)) [None | x<-[1..width], y<-[1..height]])
			(GameFieldBorder (widthHalf - 1) (widthHalf + 1) (heightHalf - 1) (heightHalf + 1))
			
			
width gameField = let (width, height) = size gameField in width
height gameField = let (width, height) = size gameField in height
size gameField = let ((_,_), result) = bounds (fieldData gameField) in result

isValidIndex (x,y) gameField = 
	let (width, height) = size gameField in
	x >= 1 && x <= width && y >= 1 && y <= height
			
get :: (Int, Int) -> GameField -> Player
get (x,y) f = (fieldData f)!(x,y)
			
push :: (Int, Int) -> Player -> GameField -> GameField
push (x,y) player orig = 
	GameField (fieldData orig // [((x,y),player)]) (newBorder (x,y) (border orig))		
	where 
		newBorder (x,y) border = 
			let (newTop, newBottom) = newVerticalBorder y (top border) (bottom border) in
			let (newLeft, newRight) = newHorizontalBorder x (left border) (right border) in
			GameFieldBorder newLeft newRight newTop newBottom
		
		newHorizontalBorder x left right = 
			if x < left then (x, right)
			else if x > right then (left, x)
			else (left, right)
			
		newVerticalBorder y top bottom = 
			if y < top then (y, bottom)
			else if y > bottom then (top, y)
			else (top, bottom)

{- pomocna konstanta se seznamem vsech smeru jako 2D souradnice (x,y) -}
allDirections :: [(Int,Int)]
allDirections = [(-1,0), (-1,-1), (0,-1), (1,-1), (1,0), (1,1), (0,1), (-1,1)]
moveInDirection (x,y) (dx,dy) = (x+dx, y+dy)

{- zkontroleje, jestli tah do dane pozice zpusobi konec hry -}
checkEndOfGame ::  (Int, Int) -> Player -> GameField -> Bool
checkEndOfGame index player field = 
	if (get index field) == player then
		or (map (checkEnd' index player field 1) allDirections)
	else
		False
	where
		checkEnd' _ _ _ 5 _ = True
		checkEnd' index player field count direction =
			let nextIndex = (moveInDirection index direction) in			
			if isValidIndex nextIndex field then				
				if (get nextIndex field) == player then
					checkEnd' nextIndex player field (count+1) direction
				else
					False
			else False				

instance Show Player where
	show p = 
		if p == Cross then "x"
		else if p == Circle then "o"
		else "-"
		
instance Read Player where
	readsPrec _ s = read' s
		where
			read' :: String -> [(Player, String)]
			read' ('-':x) = [(None,x)]
			read' ('x':x) = [(Cross,x)]
			read' ('o':x) = [(Circle,x)]
		
instance Show GameField where
	show field = concatWith "\n" (map (showRow field) [1..(height field)])
		where
			showRow field row = (foldl (\a b -> a++b) [] $ map show [(get (x,row) field)|x<-[1..(width field)]])
			concatWith separator items = (foldl (\a b -> a++separator++b) [] items)
			
			
gameFieldFromList :: GameField -> [Player] -> GameField
gameFieldFromList field x = convert field x (1,1)
	where
		convert field [] _ = field
		convert field (x:xs) index = 
			convert (push index x field) xs (moveIndex field index)
		moveIndex field (x,y) = 
			if x == (width field) then 
				if y<(height field) then (1, y+1)
				else error "Spatny format."
			else (x+1, y)
			
{-
instance Read GameField where
	readsPrec _ s = read' s []
		where
			read' s acc = 
				let input = reads in
				if (length input) > 1 then error "Spatny format, nejednoznacnost."
				else if (length input) == 0 then
					-- jsem na konci vstupu
					gameFieldFromList -}
			

{- -------------------------------------------------- -}
{- ---------------- Testy --------------------------- -}			
infixl 0 |>
x |> f = f x

test name b = if not b then error ("Test " ++ name ++ ": failure")
			  else b

testAll = testPushAndGet && testPushAndGet2 && testCheckEndOfGame && testEvaluate

testPushAndGet = test "testPushAndGet" ((get (2,2) (push (2,2) Cross (createGameField 6 6))) == Cross)	
testPushAndGet2 = test "testPushAndGet2" ((get (2,2) (push (1,1) Cross (createGameField 6 6))) == None)	

testCheckEndOfGame = test "testCheckEndOfGame" 
	((foldl (\field index -> push (index,1) Cross field) (createGameField 6 6) [1..5]) |> checkEndOfGame (5,1) Cross)

	
	
	
	
	
	
	
	
	
	
	
	
{- ----------------------------------------------------------------- -}
{- ------------------------- Minimax ------------------------------- -}

{-
Vyhodnoti vyhodnost dane herni situace pro daneho hrace.
Funguje tak, ze zapocita kladne resp. zaporne body za kazdou souvislou radu 
hrace resp. jeho protihrace. Rady ktere jsou na obou koncich "volne" dostavaji 
vyrazne vetsi skore.
-}
evaluate:: Player -> GameField -> Int
evaluate player field = sum $
	(map (eval (0,1) 0 False 0) [(x,1)|x<-[1..(width field)]]) ++		-- zacatky na hornim radku, smer kolmo dolu
	(map (eval (1,0) 0 False 0) [(1,y)|y<-[1..(height field)]]) ++		-- zacatky v prvnim sloupci, smer doprava
	(map (eval (1,1) 0 False 0) [(x,1)|x<-[1..(width field)]]) ++		-- zacatky na hornim radku, smer sikmo doprava dolu
	(map (eval (1,1) 0 False 0) [(1,y)|y<-[1..(height field)]]) ++		-- zacatky v prvnim sloupci, smer sikmo doprava dolu
	(map (eval (-1,1) 0 False 0) [(x,1)|x<-[1..(width field)]]) ++		-- zacatky na hornim radku, smer sikmo doleva dolu
	(map (eval (-1,1) 0 False 0) [(1,y)|y<-[1..(height field)]])		-- zacatky v prvnim sloupci, smer sikmo doprava dolu	
	where	
		eval :: (Int,Int) -> Int -> Bool -> Int -> (Int,Int) -> Int
		eval direction countInLine wasFree acc index =
			let nextIndex = (moveInDirection index direction) in
			if isValidIndex nextIndex field then
				if (get index field) == player then
					eval direction (countInLine+1) wasFree acc nextIndex 
				else
					-- pokud zde hracova line nepokracuje vratim vyhodnoceni dosavadni line
					-- a pokracuji dal
					let isFree = ((get index field) == None) in
					eval direction 0 isFree ((evalLine wasFree isFree countInLine)+acc) nextIndex
			else
				-- jsem na konci hraciho planu, takze z teto strany urcite neni free
				acc + (evalLine wasFree False countInLine)
				
		evalLine :: Bool -> Bool -> Int -> Int		
		evalLine free1 free2 length =
			if length > 1 then
				if free1 && free2 then
					if length == 3 then 100
					else if length > 3 then 10000
					else 5
				else if free1 || free2 then length
				else 0
			else 0



{- TODO:
	- zjisteni konce hry
	- ohodnoceni bere v potaz i protihrace
	- moznost skoncit v libovolne hloubce, ne jen licheho cisla
-}		
minimax :: Player -> GameField -> (Int, Int)
minimax player field = 
	let (pos, _) = trace "startuju minimax" $ (minimax' player player 0 field) in pos
	where		
		minimax' _ startPlayer 1 field = ((0,0), evaluate startPlayer field)
		minimax' currentPlayer startPlayer deepth field = 						
			let playAndField = 
				-- utvorim si dvojice tah a hraci pole, ktere po takovem tahu vznikne
				(map (\pos -> (pos,push pos currentPlayer field)) (getPlayPositions field)) in				
			let results = 
				map (
					-- pro kazdou takovou dvojici zavolam rekursivne minimax, field uz mam, play, ze ktereho vznikl potrebuji pro vytvoreni
					-- vysledku - tim je dvojice play (tah) a jeho ohodnoceni pomoci minimaxu. Tah (enemyPos), ktery se mi vratil z dalsi vrstvy, nepouziji
					\(pos,field) -> 
					let (enemyPos,eval) = minimax' (switchPlayer currentPlayer) startPlayer (deepth+1) field
					in (pos,eval)
				) 			
				playAndField	
			in
				if currentPlayer == startPlayer then
					mapMinMax (>) (\(pos,eval) -> eval) results
				else
					mapMinMax (<) (\(pos,eval) -> eval) results								
		
		-- vrati vsechny hratelne pozice
		getPlayPositions field = 
			let b = border field in
			let (btop, bbottom, bleft, bright) = (top b, bottom b, left b, right b) in
			filter (\index -> (isValidIndex index field) && (get index field == None)) 
				[(x,y) | x<-[(bleft-1)..(bright+1)], y<-[(btop-1)..(bbottom+1)]]

		-- vybere nej prvek podle funkce cmp, pred porovnanim jeste prvky transformuje pomoci fce f
		mapMinMax _ _ [] = error "remiza! Hraci pole je plne."
		mapMinMax cmp f (x:xs) = mapMinMax' cmp f xs (f x) x
		mapMinMax' _ f [] _ result = result
		mapMinMax' cmp f (x:xs) mx mxOrig =
			if cmp (f x) mx then mapMinMax' cmp f xs (f x) x
			else mapMinMax' cmp f xs mx mxOrig
				
				
				
testEvaluate = test "testEvalueate"
	((createGameField 10 10 |> push (1,1) Cross |> push (1,2) Cross |> push (1,3) Cross |> push(2,1) Cross |> evaluate Cross) == 5)

	
	
	
	
{- -------------------------------------------------------------------------- -}
{- -------------------------------------------------------------------------- -}
{- -------------------------------------------------------------------------- -}

computerPlay gameField = 
	let pos = (minimax Circle gameField) in
	push pos Circle gameField

playerPlay "k" _ = do
	return ()
	
playerPlay x gameField = do
	y <- getLine
	game (computerPlay (push (read x,read y) Cross gameField))

game gameField = do 
	clearScreen	
	setCursorPosition 0 0
	putStr (show gameField ++ "\n")	
	a <- getChar			
	putStr [a]
	x <- getLine
	playerPlay x gameField
	
	
readChar = hSetBuffering stdin NoBuffering >> hSetEcho stdin False >> getChar

main = do
	putStr ("Hello in tic tac toe\n")
	hSetEcho stdin False 
	hSetBuffering stdin NoBuffering 
	hSetBuffering stdout NoBuffering
	scanLine 
	where 
		{-showInput (InputT m (Just c)) = show c
		showInput (InputT m (Nothing)) = "nic"	-}
		scanLine = do 
			  c <- readChar
			  putStr (show c)
			  scanLine 
	{- game $ createGameField 10 10 -}