module MainState (newMState ) where

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

-----新しいMStateの作成
newMState :: MState -> KState -> MState
newMState mst kst  = (eventAllAct  (maingameProg mst kst) kst) 





-------イベント実行
eventAct ::   MState -> EventKey -> MState 
eventAct mst ekey = case ekey of
--		EReset 	-> eventResetButton mst dst
		_	-> mst

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



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

	PuttedCell -> nextTurn mst
	

				
-----ターンに対応する石の取得
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 = let s = playerStone mst
			       gbcs = gBoardCells mst
			       gs = getTurnStone mst gturn
					
		           in case (getClickCellPos mst kst) of 
		Nothing -> mst
		Just x  -> if dPuttableCell gs gbcs x
				then mStateChangeGamePlayProg (mStateChangeGBoardCells mst (putStone gs gbcs x) ) 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) == (Vector2 True True)


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

-----プット可能セルが存在するか
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))