module AIReversi (aiDecision ) where

import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import States
import VectorMaps
import Control.Applicative  
import qualified Data.Map as Map

import System.Random
import General (listRandomSelect , listConnectedComponent)
import BoardOperater


myTurn :: GameTurn
myTurn = Turn2P

puttable :: MState -> [(Vector2 GLint)]
puttable mst = let cs   = getTurnStone mst myTurn 
	           gbcs = gBoardCells mst
	       in 
	       filter (dPuttableCell cs gbcs) (bCellsList mst)

makePuttable :: MState -> GStone -> GBoardCells -> [(Vector2 GLint)]
makePuttable mst s gbcs = filter (dPuttableCell s gbcs) (bCellsList mst)


------AIボードの作成
makeAIBoard :: GStone -> GBoardCells -> (Vector2 GLint) -> GBoardCells
makeAIBoard s gbcs cPos = putStone s gbcs cPos


------AI
aiDecision :: MState -> ((Vector2 GLint) , StdGen)
aiDecision mst = let putValueList = makePutValueList mst (bCellsList mst)
		    
		     
		 in putPosVector mst (map (makePutValue mst) (puttable mst))


------PutValueListからおく位置を決定する
putPosVector :: MState ->[((Vector2 GLint) , GLint)] -> ((Vector2 GLint) , StdGen)
putPosVector mst xs = let sumValue = sum (map snd xs)
			  rnd = randomR (1 , sumValue) (randGen mst) 
		      in (putPosVector' mst xs sumValue (fst rnd) , (snd rnd))	


------PutValueListからおく位置を決定する(再帰)
putPosVector' :: MState -> [((Vector2 GLint) , GLint)] -> GLint -> GLint -> (Vector2 GLint)
putPosVector' mst [] sv rnd = (Vector2 0 0)					-----念のため
putPosVector' mst (x : xs) sv rnd = let cv = snd x
			
			            in if rnd >= (sv - cv)
			then fst x
			else putPosVector' mst xs (sv - cv) rnd 				 
			  




------PutValueList の作成
makePutValueList :: MState -> [(Vector2 GLint)] -> [((Vector2 GLint) , GLint)]
makePutValueList mst (v:vs) =  (makePutValue mst v) : (makePutValueList mst vs)


		
makePutValue :: MState -> (Vector2 GLint) -> ((Vector2 GLint) , GLint)
makePutValue mst v = let value = 1000000
			 value2 = aiConstruct aiGeneraters mst v value

		     in (v , (max value2 1))


type AIGenerater = (MState -> (Vector2 GLint) -> GLint -> GLint)


------AIを構成する関数たち
aiGeneraters :: [AIGenerater]
aiGeneraters = [losePutValue , cornerPutValue , xPutValue , cPutValue , cornerLosePut]


-------AIの作成(再帰)
aiConstruct :: [AIGenerater] -> MState -> (Vector2 GLint) -> GLint -> GLint
aiConstruct [] mst v value = value
aiConstruct (ai : ais) mst v value = ai mst v (aiConstruct ais mst v value)


-------X打ち
xPutValue :: MState -> (Vector2 GLint) -> GLint -> GLint
xPutValue mst pos value = if dPutX mst pos
				then putXCornerStateValue mst pos value
				else value

-------C打ち
cPutValue :: MState -> (Vector2 GLint) -> GLint -> GLint
cPutValue mst pos value = let cs   = getTurnStone mst myTurn 
	           	      gbcs = gBoardCells mst
			  in if dPutC mst pos
				then edgeValueC mst cs gbcs pos value
				else value


-------角優先
cornerPutValue :: MState -> (Vector2 GLint) -> GLint -> GLint
cornerPutValue mst pos value = if pos `elem` (cornerSetv mst)
			then value * 100
			else value


-------全滅するような手を避ける
losePutValue :: MState -> (Vector2 GLint) ->  GLint -> GLint
losePutValue mst pos value = if dLosePutValue mst pos 
				then 1
				else value 


-------全滅するような手であるか?
dLosePutValue :: MState -> (Vector2 GLint) -> Bool
dLosePutValue mst pos = let cs   = getTurnStone mst myTurn
			    gbcs = gBoardCells mst 
		            aiBoard = makeAIBoard cs gbcs pos
			    puttable2 = makePuttable mst (opStone cs) aiBoard
			    aiBoard2List = map (makeAIBoard (opStone cs) aiBoard) puttable2 
			    num0aiBoardList = map (numberStone cs) aiBoard2List
			in 0 `elem` num0aiBoardList



-------角を取られるような手であるか？
dcornerLosePut :: MState -> GStone -> GBoardCells -> (Vector2 GLint) -> Bool
dcornerLosePut mst s gbcs pos = let aiBoard = makeAIBoard s gbcs pos 
			        in foldl (||) False (map (dPuttableCell (opStone s) gbcs ) (cornerSetv mst))

-------角を取られるような手をさける
cornerLosePut :: MState -> (Vector2 GLint) -> GLint -> GLint
cornerLosePut mst pos value = let cs  = getTurnStone mst myTurn
			      in if dcornerLosePut mst cs (gBoardCells mst) pos 
				then value `quot` 100000 
				else value

-------角を取られるような手以外の残っていない
dcornerLosePutOnly :: MState -> GStone ->  GBoardCells -> (Vector2 GLint) ->  Bool 
dcornerLosePutOnly mst s gbcs pos = foldl (&&) True (map (dcornerLosePut mst s gbcs) (makePuttable mst s gbcs))
				

-------角集合
cornerSet :: [(Vector2 GLint)]
cornerSet = [(Vector2 0 0) , (Vector2 1 0) , (Vector2 0 1) , (Vector2 1 1)]	



-------角集合実値
cornerSetv :: MState -> [(Vector2 GLint)]
cornerSetv mst = let bx = (divBoardNumX mst) - 1
		     by = (divBoardNumY mst) - 1
		 in [(Vector2 0 0) , (Vector2 bx 0) , (Vector2 0 by) , (Vector2 bx by)]	



------角打ちの値
putXCornerStateValue :: MState -> (Vector2 GLint) -> GLint -> GLint
putXCornerStateValue mst  pos value =     let cornerB = getCornerNeighber mst pos
					      cs = getTurnStone mst myTurn
					      gbcs = gBoardCells mst
				          in if dCornerStateCorner mst cs gbcs cornerB >= 1
			then value
			else if dcornerLosePutOnly mst cs gbcs pos
				then value
				else value `quot` 100000 
			
 


-------辺座標タイプ集合
edgeSet :: [EdgeType]
edgeSet = [EdgeTop1 , EdgeBottom1 , EdgeRight1 , EdgeLeft1 , EdgeTop2 , EdgeBottom2 , EdgeRight2 , EdgeLeft2]

-------Cであるか
dPutC :: MState -> (Vector2 GLint) -> Bool
dPutC mst pos = let cset = map ((flip(tCoordNormalIntoEdge mst)) pos) edgeSet
	        in  (Vector2 1 0) `elem` cset

-------Xであるか
dPutX :: MState -> (Vector2 GLint) -> Bool
dPutX mst pos = let cset = map ((flip(tCoordNormalIntoCorner mst)) pos) cornerSet
	        in  (Vector2 1 1) `elem` cset



------角において角は埋まっているか
dCornerStateCorner :: MState -> GStone -> GBoardCells -> (Vector2 GLint)-> GLint
dCornerStateCorner mst s gbcs v = case (getStoneCorner mst gbcs v (Vector2 0 0)) of 
			Nothing 	  -> 0
			Just x		  -> if x == s 	then 1
							else 2			




------辺において手前の角が埋まっているか
dEdgeStateCorner0 :: MState -> GStone -> GBoardCells -> EdgeType -> GLint
dEdgeStateCorner0 mst s gbcs eType = case (getStoneEdge mst gbcs eType (Vector2 0 0)) of
			Nothing 	  -> 0
			Just x		  -> if x == s 	then 1
							else 2


------辺において(2,0)が埋まっているか
dEdgeState20 :: MState -> GStone -> GBoardCells -> EdgeType -> GLint
dEdgeState20 mst s gbcs eType = case (getStoneEdge mst gbcs eType (Vector2 2 0)) of
			Nothing 	  -> 0
			Just x		  -> if x == s 	then 1
							else 2


------辺において奥の角が埋まっているか
dEdgeStateCornerX :: MState -> GStone -> GBoardCells -> EdgeType -> GLint
dEdgeStateCornerX mst s gbcs eType = let bx = (divBoardNumX mst) - 1
					 by = (divBoardNumY mst) - 1
					 b = if eType `elem` [EdgeLeft1 , EdgeLeft2 , EdgeRight1 , EdgeRight2]
						then by
						else bx
				     in case (getStoneEdge mst gbcs eType (Vector2 b 0)) of
			Nothing 	  -> 0
			Just x		  -> if x == s 	then 1
							else 2





------C打ちにおいて辺の状態によるValueの変化
edgeValueC :: MState -> GStone -> GBoardCells -> (Vector2 GLint) -> GLint -> GLint
edgeValueC mst s gbcs pos value 
		| c0 == 0 , c1 == 1 , c2 == 0	= edgeValueC00 mst s gbcs eType pos value 
		| c0 == 0 , c1 == 1 , c2 == 1	= value `quot` 3	----チェック
		| c0 == 0 , c2 == 1             = value `quot` 10000
		| c0 == 0			= value `quot` 1000
		| c0 == 1 , c1 == 1   		= value * 100
		| c0 == 1			= value * 3
		| c0 == 2 , c1 == 2		= value * 100
		| otherwise			= value 
		where eType = getEdgeNeighberC mst pos
		      c0 = dEdgeStateCorner0 mst s gbcs eType 
		      c1 = dEdgeState20 mst s gbcs eType
		      c2 = dEdgeStateCornerX mst s gbcs eType 
			      



------両辺が埋まっていない状態の辺の状態によるValueの変化
edgeValueC00 :: MState -> GStone -> GBoardCells -> EdgeType -> (Vector2 GLint) -> GLint -> GLint
edgeValueC00 mst s gbcs eType pos value 
	| take 4 (edgeConnectedComponent mst gbcs s eType) == [0 , 2 , 0 , 2] = value `quot` 1000
	| otherwise					   		      = value 



------辺における石の連結成分の類別
edgeConnectedComponent :: MState -> GBoardCells -> GStone -> EdgeType -> [GLint]
edgeConnectedComponent mst gbcs s eType = listConnectedComponent (getStoneBoardEdgeList mst gbcs s eType)


------辺の石の配列の取得
getStoneBoardEdgeList :: MState -> GBoardCells -> GStone -> EdgeType -> [GLint]
getStoneBoardEdgeList mst gbcs s eType = let xs = map (\x -> (Vector2 x 1)) [0 .. ((divBoardNumX mst) - 1)]

					 in map (getStoneBoardEdge mst gbcs s eType) xs




------石の取得(0　空　,1 自石 , 2　敵石 )
getStoneBoard :: MState -> GBoardCells -> GStone -> (Vector2 GLint) -> GLint
getStoneBoard mst gbcs s pos = 	let ms = Map.lookup pos gbcs
				
			   	in case ms of
			Nothing -> 0
			Just x  -> if x == s	then 1
						else 2

-----辺座標における-石の取得(0　空　,1 自石 , 2　敵石 )
getStoneBoardEdge :: MState -> GBoardCells -> GStone -> EdgeType -> (Vector2 GLint) -> GLint
getStoneBoardEdge mst gbcs s eType pos = getStoneBoard mst gbcs s (tCoordEdgeIntoNormal mst eType pos) 
					     	



-----角座標における-石の取得(0　空　,1 自石 , 2　敵石 )
getStoneBoardCorner :: MState -> GBoardCells -> GStone -> (Vector2 GLint) -> (Vector2 GLint) -> GLint
getStoneBoardCorner mst gbcs s v pos = getStoneBoard mst gbcs s (tCoordCornerIntoNormal mst v pos)
 



------辺座標における石の取得
getStoneEdge :: MState -> GBoardCells -> EdgeType -> (Vector2 GLint) ->  (Maybe GStone)
getStoneEdge mst gbcs eType pos = Map.lookup (tCoordEdgeIntoNormal mst eType pos) gbcs


------角座標における石の取得
getStoneCorner :: MState -> GBoardCells -> (Vector2 GLint) -> (Vector2 GLint) ->  (Maybe GStone)
getStoneCorner mst gbcs v pos = Map.lookup (tCoordCornerIntoNormal mst v pos) gbcs


------Cで考える辺を得る
getEdgeNeighberC :: MState -> (Vector2 GLint) -> EdgeType
getEdgeNeighberC mst (Vector2 x y)
	| x == 1 , y == 0 	= EdgeBottom1
	| x == bx - 1 , y == 0	= EdgeBottom2
	| x == 1 , y == by  	= EdgeTop1
	| x == bx - 1,y == by 	= EdgeTop2
	| x == 0 , y == 1	= EdgeLeft1
	| x == 0 , y == by - 1	= EdgeLeft2
	| x == bx , y == 1	= EdgeRight1
	| x == bx , y == by - 1	= EdgeRight2
	| otherwise 		= EdgeBottom1
	where	bx = (divBoardNumX mst) - 1
		by = (divBoardNumY mst) - 1


------どの角が最も近いかを得る
getCornerNeighber :: MState -> (Vector2 GLint) -> (Vector2 GLint) 
getCornerNeighber mst (Vector2 x y) 
	| x <= hbx , y <= hby = (Vector2 0 0)
	| x > hbx  , y <= hby = (Vector2 1 0)
	| x <= hbx ,  y > hby = (Vector2 0 1)
	| x > hbx  ,  y > hby = (Vector2 1 1)
	where 	bx = (divBoardNumX mst) - 1
		by = (divBoardNumY mst) - 1
		hbx = bx `quot` 2
		hby = by `quot` 2




--------座標変換（標準座標から角座標に変換）
tCoordNormalIntoCorner :: MState ->(Vector2 GLint) -> (Vector2 GLint) -> (Vector2 GLint)
tCoordNormalIntoCorner mst baseP (Vector2 x y) = let bx = (divBoardNumX mst) - 1
				  		     by = (divBoardNumY mst) - 1
						 in case baseP of
				(Vector2 0 0) 	-> (Vector2 x y)
				(Vector2 1 0)	-> (Vector2 (bx - x) y) 
				(Vector2 1 1) -> (Vector2 (bx - x) (by - y))
				(Vector2 0 1)	-> (Vector2 x (by - y)) 
				_ 		-> (Vector2 x y)					

--------座標変換（角座標から標準座標に変換）
tCoordCornerIntoNormal :: MState ->(Vector2 GLint) -> (Vector2 GLint) -> (Vector2 GLint)
tCoordCornerIntoNormal = tCoordNormalIntoCorner							

data EdgeType = EdgeTop1 | EdgeBottom1 | EdgeRight1 | EdgeLeft1 | EdgeTop2 | EdgeBottom2 | EdgeRight2 | EdgeLeft2  deriving (Show , Eq , Ord)

data EdgeTypeDirect = EdgeUp | EdgeRight deriving (Show , Eq ,Ord)

--------EdgeTypeの分類
getEdgeTypeDirect :: EdgeType -> EdgeTypeDirect
getEdgeTypeDirect eType = if eType `elem` [EdgeTop1 , EdgeBottom1 , EdgeTop2 , EdgeBottom2] 
			then EdgeRight
			else EdgeUp






--------座標変換（標準座標から辺座標に変換）
tCoordNormalIntoEdge :: MState -> EdgeType -> (Vector2 GLint) -> (Vector2 GLint)
tCoordNormalIntoEdge mst edge (Vector2 x y) = let bx = (divBoardNumX mst) - 1
				  		  by = (divBoardNumY mst) - 1
					      in case edge of
				EdgeBottom1 	-> (Vector2 x y)
				EdgeBottom2 	-> (Vector2 (bx - x) y) 
				EdgeTop1 	-> (Vector2 x (by - y))
				EdgeTop2 	-> (Vector2 (bx - x) (by - y)) 
				EdgeRight1 	-> (Vector2 y x)
				EdgeRight2 	-> (Vector2 (by - y) x) 
				EdgeLeft1 	-> (Vector2 y (bx - x))
				EdgeLeft2 	-> (Vector2 (by - y) (bx - x))
				


--------座標変換（辺座標から標準座標に変換）
tCoordEdgeIntoNormal :: MState -> EdgeType -> (Vector2 GLint) -> (Vector2 GLint)
tCoordEdgeIntoNormal = tCoordNormalIntoEdge