module MainState (newMState , numberStone) where

import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import States
import VectorMaps
import Control.Applicative  
import qualified Data.Map as Map
import EventFlags (eventMState)
import EventCheck (eventResetCheck)
import ResionMap
import SetValue (resetMState)
import System.Random
import General (listRandomSelect)

-----新しいMStateの作成
newMState :: MState -> DState -> KState -> MState
newMState mst dst kst  = let mst' = eventMState dst kst mst 
			     gMode = gameMode mst'
		         in case gMode of
		GameTitle  -> mst'
		GamePlay2P -> (eventAllAct  (maingameProg mst' kst) kst) 
		GamePlay1P -> (eventAllAct  (maingameProgCPU mst' kst) kst) 
		



------リセットイベント
eventReset :: MState -> KState -> MState
eventReset  mst kst =if eventResetCheck mst kst 
					then resetMState mst 
					else mst

-------イベント実行
eventAct ::   KState -> MState -> EventKey -> MState 
eventAct kst mst ekey = case ekey of
		EReset 	-> eventReset mst kst
		_	-> mst

-------すべてのイベント実行
eventAllAct :: MState -> KState -> MState
eventAllAct mst kst = let ekeys = Map.keys (events mst)
		      in foldl (eventAct kst) mst  ekeys 	



-----ゲーム進行
maingameProg :: MState -> KState -> MState
maingameProg mst kst =  let gpProg = gamePlayProg mst
			in case gpProg of
	SelectCell -> putStoneM mst kst

	PuttedCell -> nextTurn mst
	
-----ゲーム進行 (CPU戦)
maingameProgCPU :: MState -> KState -> MState
maingameProgCPU mst kst =  let gpProg = gamePlayProg mst
			       gturn = gameTurn mst
			       aD = aiDecision mst
			       v = fst aD
			       mst' = mStateChangeRandGen mst (snd aD)
			   in case gpProg of
	SelectCell -> case gturn of
			Turn1P -> putStoneM mst kst 
			Turn2P -> putStoneCPU mst' v 

	PuttedCell -> nextTurn mst

------AI
aiDecision :: MState -> ((Vector2 GLint) , StdGen)
aiDecision mst = let gbcs = gBoardCells mst
		     cs   = getTurnStone mst Turn2P
		     puttable = filter (dPuttableCell cs gbcs) (bCellsList mst)
		    
		     
		 in listRandomSelect (randGen mst) puttable	

			
-----ターンに対応する石の取得
getTurnStone :: MState -> GameTurn -> GStone
getTurnStone mst gturn = case gturn of
	Turn1P -> playerStone mst 
	Turn2P -> opStone (playerStone mst)

-----ターンの交換
opTurn :: GameTurn -> GameTurn 
opTurn gturn = case gturn of
	Turn1P -> Turn2P
	Turn2P -> Turn1P

-----ターンの管理
nextTurn :: MState -> MState
nextTurn mst = let gturn = gameTurn mst
		   gbcs = gBoardCells mst
		   gs = (getTurnStone mst gturn)
		   mst' = mStateChangeGamePlayProg mst SelectCell
	       in
	if existPuttableCell mst (opStone gs) gbcs	
		then mStateChangeGTurn mst' (opTurn gturn)
		else mst'




-----クリックした位置のセルに石を置く

putStoneM :: MState -> KState -> MState 
putStoneM mst kst = putStoneP mst (gameTurn mst) kst 

-----クリックした位置のセルに石を置く (ターン指定)

putStoneP :: MState -> GameTurn -> KState -> MState
putStoneP mst gturn  kst = case (getClickCellPos mst kst) of 
		Nothing -> mst
		Just x  -> putStoneT mst gturn x


-----CPUターンの石を置く
putStoneCPU :: MState -> (Vector2 GLint) -> MState 
putStoneCPU mst v = putStoneT mst Turn2P v

-----位置を指定して石を置く
putStoneT :: MState -> GameTurn -> (Vector2 GLint) ->  MState 
putStoneT mst gturn cPos = let gbcs = gBoardCells mst
			       gs = getTurnStone mst gturn
					
		           in if dPuttableCell gs gbcs cPos
				then mStateChangeGamePlayProg (mStateChangeGBoardCells mst (putStone gs gbcs cPos) ) PuttedCell
				else mst


-----クリックした位置のセルの位置を得る

getClickCellPos :: MState -> KState -> (Maybe (Vector2 GLint)) 
getClickCellPos mst kst = if dClickPosInBoard mst kst 
			then transPosIntoCellPos mst (fmap (getCellPos mst) (clickPos kst) )
			else Nothing

----ボードの相対座標からそのセルの位置を得る
transPosIntoCellPos :: MState -> Maybe (Vector2 GLfloat) -> Maybe (Vector2 GLint)
transPosIntoCellPos mst mv = let tb = displayGameBoard mst
		    		 w = boardWidth tb / (fromIntegral (divBoardNumX mst))
		    		 h = boardHeight tb / (fromIntegral (divBoardNumY mst))				 
			     in case mv of
		Nothing 		-> Nothing
		Just (Vector2 x y)	-> Just (fmap floor (Vector2 (x / w) (y / h)))

			
----クリックした位置のテーブルの相対座標
getCellPos :: MState -> (Vector2 GLfloat) -> (Vector2 GLfloat)
getCellPos mst v = let	tb = displayGameBoard mst
		    	posX = boardPosX tb
		     	posY = boardPosY tb
		   in (-) <$> v <*> (Vector2 posX posY)


----クリックした位置のテーブル内であるか
dClickPosInBoard ::  MState -> KState -> Bool
dClickPosInBoard mst kst = let tb = displayGameBoard mst
			       posX = boardPosX tb
		     	       posY = boardPosY tb
			       w = boardWidth tb
			       h = boardHeight tb
			   in case (clickPos kst) of
		Nothing -> False
		Just x  -> (containIntervalCC2 (Vector2 posX posY) (Vector2 (posX + w) (posY + h)) x) == True


-----反対の色の石
opStone :: GStone -> GStone
opStone gs = case gs of
	SWhite -> SBlack
	SBlack -> SWhite


------ゲーム終了の判定
dEndGame :: MState -> GBoardCells -> Bool 
dEndGame  mst gbcs = not ((existPuttableCell mst SWhite gbcs) && (existPuttableCell mst SBlack gbcs))
				


-----プット可能セルが存在するか
existPuttableCell :: MState -> GStone -> GBoardCells -> Bool 
existPuttableCell mst s gbcs = foldl (||) False (map (dPuttableCell s gbcs) (bCellsList mst)) 	

-----プット可能セルであるか
dPuttableCell :: GStone -> GBoardCells -> (Vector2 GLint) -> Bool 
dPuttableCell s gbcs cPos = (dReversi s gbcs cPos) && (dEmptyCell gbcs cPos)	
			   

-----空セルであるか
dEmptyCell :: GBoardCells -> (Vector2 GLint) -> Bool 
dEmptyCell gbcs cPos = not (Map.member cPos gbcs)			


-----方向ベクトルへの返す石のチェックするためのリストを返す （再帰）
dReversiDList :: GStone -> GBoardCells -> (Vector2 GLint) -> (Vector2 GLint) -> [GStone]
dReversiDList s gbcs v cPos =  let newPos = (+) <$> v <*> cPos

			       in case Map.lookup newPos gbcs of

		Just x	         -> if x == s then [s]
					      else  (opStone s) : (dReversiDList s gbcs v newPos)  	 	
		_		 -> []

-----方向ベクトルへの返す石のチェックする
dReversiD :: GStone -> GBoardCells -> (Vector2 GLint) -> (Vector2 GLint) -> Bool
dReversiD s gbcs v cPos = let checkListD = dReversiDList s gbcs v cPos
			  in 
			  if (length checkListD) < 2 then False
			  			     else if (last checkListD) == s
							then True
							else False
	
		 			
-----ボード全体のセル
bCellsList :: MState -> [(Vector2 GLint)]
bCellsList mst = let w = divBoardNumX mst
		     h = divBoardNumY mst
		 in [(Vector2 i j) | i <- [0..(w - 1)] , j <- [0..(h - 1)]] 
		

 			
-----8方向のベクトル
eightList :: [(Vector2 GLint)]
eightList = [(Vector2 i j) | i <- [(-1) .. 1] , j <- [(-1) .. 1] , (i , j) /= (0 , 0)] 

-----8方向のベクトルへの返す石のチェックする
dReversi :: GStone -> GBoardCells -> (Vector2 GLint) -> Bool
dReversi s gbcs cPos = let allCheckList = map ((flip (dReversiD s gbcs)) cPos) eightList 			
		       in foldl (||) False allCheckList

------方向ベクトルへ石を返す(再帰)
reverseStoneD ::  GStone -> GBoardCells -> (Vector2 GLint) -> (Vector2 GLint) -> GBoardCells
reverseStoneD s gbcs v cPos = if dReversiD s gbcs v cPos
			      then
			      		let newPos = (+) <$> v <*> cPos

			     		in case Map.lookup newPos gbcs of

						Just x	         -> if x == s then gbcs
									      else reverseStoneD s (Map.insert newPos s gbcs) v newPos 
						_		 -> gbcs
			      else gbcs

------石を返す
reverseStone :: GStone -> GBoardCells -> (Vector2 GLint) -> GBoardCells
reverseStone s gbcs cPos = reverseStone' s gbcs cPos eightList

------石を返す	(再帰)
reverseStone' :: GStone -> GBoardCells -> (Vector2 GLint) -> [(Vector2 GLint)] -> GBoardCells
reverseStone' _ gbcs _ [] = gbcs
reverseStone' s gbcs cPos (a : as) = reverseStone' s (reverseStoneD s gbcs a cPos) cPos as


------石を置く処理
putStone :: GStone -> GBoardCells -> (Vector2 GLint) ->  GBoardCells
putStone s gbcs cPos = (Map.insert cPos s (reverseStone s gbcs cPos))

------石の個数を数える
numberStone :: GStone -> GBoardCells -> GLint
numberStone s gbcs = let filteredgbcs = Map.filter (== s) gbcs
		     in fromIntegral (Map.size filteredgbcs)