module Stones (dboardSet , eventFrame , dstoneSet) where
 
import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import Control.Applicative  
import States
import VectorMaps
import qualified Data.Map as Map
import Constant (gCell)
				

------ボードの描画
dboard :: MState -> TextureObject -> IO ()
dboard mst tObj = do
	let tb = displayGameBoard mst
	    w = (boardWidth tb)
	    h = (boardHeight tb)
	    x = (boardPosX tb)
	    y = (boardPosY tb)
	    v = (Vector2 x y)
	textureBinding Texture2D $= Just tObj
	texture Texture2D $= Enabled
	
	renderPrimitive Quads $ mapM_ (vertextex v) [ (0 , 0.0 , 0 , 0)  ,(0 , h , 1 , 0) , ( w, h, 1 , 1),( w , 0 , 0 , 1)]
	texture Texture2D $= Disabled


------ボードの描画--テクスチャ指定
dboardSet :: MState -> TexObjGrp -> Int -> IO ()
dboardSet mst tObGp id = let texboard = (\(Just x) -> x) (Map.lookup KeyTexGameBoard tObGp)
			 in if id < length texboard
				then dboard mst (getTextureObj KeyTexGameBoard tObGp id )
				else dboard mst (getTextureObj KeyTexGameBoard tObGp 0 )


------フレーム枠の描画
eventFrame :: MState -> IO ()
eventFrame mst = do 
		
	mapM_ (eventFrameLineX mst) [0..(fdivBoardNumX mst) ]
	mapM_ (eventFrameLineY mst) [0..(fdivBoardNumY mst) ]
	


------フレーム枠の描画
eventFrameLineX :: MState -> GLfloat -> IO ()
eventFrameLineX mst i = do
	let tb = displayGameBoard mst
	    w = (boardWidth tb)
	    h = (boardHeight tb)
	
	renderPrimitive Lines $ mapM_ (vertifyLine mst) ( [ (i * w / (fdivBoardNumX mst) , 0 )  ,(i * w / (fdivBoardNumY mst) , h )]) 
				
------フレーム枠の描画
eventFrameLineY :: MState -> GLfloat -> IO ()
eventFrameLineY mst j = do
	let tb = displayGameBoard mst
	    w = (boardWidth tb)
	    h = (boardHeight tb)
	
	renderPrimitive Lines $ mapM_ (vertifyLine mst) ( [ ( 0 , j * h / (fdivBoardNumX mst) )  ,(w , j * h / (fdivBoardNumY mst) )]) 

vertifyLine :: MState -> (GLfloat , GLfloat) -> IO ()
vertifyLine mst (x , y) = do
	let tb = displayGameBoard mst
	    posX = (boardPosX tb)
	    posY = (boardPosY tb)
	    vt = (+) <$> (Vector2 x y) <*> (Vector2 (posX ) (posY )) 

	vertex (setVertex vt)

-----指定したIDのセルの位置ベクトルを求める
getCellPos :: MState -> (Vector2 GLint) -> (Vector2 GLfloat) 
getCellPos mst (Vector2 i j) = 	let 	tb = displayGameBoard mst
		      			posX = boardPosX tb
		       			posY = boardPosY tb
		       			w = boardWidth tb
	 	      			h = boardHeight tb
		       			cellW = w / (fdivBoardNumX mst)
		       			cellH = h / (fdivBoardNumY mst) 
		   	      	in (Vector2 (posX + cellW * (fromIntegral i)) (posY + cellH * (fromIntegral j)))

------石の描画
stone :: MState -> TextureObject -> (Vector2 GLint) -> IO ()
stone mst tObj (Vector2 i j) = do
	let gCellMarginX = cellMarginX gCell
	    gCellMarginY = cellMarginY gCell		
	    tb = displayGameBoard mst
	    w = (boardWidth tb)
	    h = (boardHeight tb)
	    x = (boardPosX tb)
	    y = (boardPosY tb)
	    
            cellW = w / (fdivBoardNumX mst)
            cellH = h / (fdivBoardNumY mst)
	    cellX = x + cellW * (fromIntegral i)
	    cellY = y + cellH * (fromIntegral j)
	    
            cellW' = cellW - gCellMarginX * 2
            cellH' = cellH - gCellMarginY * 2
	    cellX' = cellX + gCellMarginX
	    cellY' = cellY + gCellMarginY
	textureBinding Texture2D $= Just tObj
	texture Texture2D $= Enabled
	
	--renderPrimitive Quads $ mapM_ (vertextex v) [ (0 , 0.0 , 0 , 0)  ,(0 , cellH , 1 , 0) , ( cellW, cellH, 1 , 1),(cellW , 0 , 0 , 1)]
	renderPrimitive Polygon $ mapM_ circletex (zip (circleInRect circleVertexNum cellX' cellY' cellW' cellH') (cycle [(0,0),(1,0),(1,1),(0,1)]  ) )
	
	texture Texture2D $= Disabled


------石の描画--テクスチャ指定
dstoneSet :: MState -> TexObjGrp -> (Vector2 GLint) -> IO ()
dstoneSet mst tObGp v = let texstone = (\(Just x) -> x) (Map.lookup KeyTexStone tObGp)
			    gCells   = gBoardCells mst
			  
		        in
			case (Map.lookup v gCells) of
		Nothing 	-> return ()
		Just SBlack 	-> stone mst (getTextureObj KeyTexStone tObGp 0 ) v 
		Just SWhite	-> stone mst (getTextureObj KeyTexStone tObGp 1 ) v		


-----与えられたベクトル分だけ移動した後、座標とテクスチャ座標を分離してベクトルのペアを返す
vertexVector:: (Vector2 GLfloat) -> (GLfloat ,GLfloat,GLfloat ,GLfloat) -> ((Vector2 GLfloat) , (Vector2 GLfloat))
vertexVector  v (x ,y, a ,b) = (((+) <$> v <*> (Vector2 x y)), (Vector2 a b))


------座標とテクスチャタプルからrenderPrimitiveで使うIOアクションを返す
vertextex :: (Vector2 GLfloat) -> (GLfloat ,GLfloat,GLfloat ,GLfloat) -> IO ()
vertextex v vt = 	let vertexpair = vertexVector v vt
		 	    vTex = (snd vertexpair)
		    	    vVet = (fst vertexpair)	
	       		in do
			texCoord (setTexCoord vTex) 
			vertex (setVertex vVet)

------座標とテクスチャタプルからrenderPrimitiveで使うIOアクションを返す
circletex :: ((Vector2 GLfloat) , (GLfloat ,GLfloat)) -> IO ()
circletex (v , (a , b)) = let vTex = (Vector2 a b)

	       		  in do
			
			texCoord (setTexCoord vTex) 
			vertex (setVertex v)
									

							
												

setVertex :: (Vector2 GLfloat) -> (Vertex2 GLfloat)
setVertex (Vector2 x y) = (Vertex2 x y) 

setTexCoord :: (Vector2 GLfloat) -> (TexCoord2 GLfloat)
setTexCoord (Vector2 x y) = (TexCoord2 x y) 



-----四角形のなかに内接する円の点
circleInRect :: GLint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> [(Vector2 GLfloat)]
circleInRect n x y w h = let centerP = Vector2 (x + w / 2) (y + h / 2)
			     r = min (w / 2)  (h / 2)
		         in circlePoints n centerP r




-----円周を構成する点
circlePoints :: GLint -> (Vector2 GLfloat) -> GLfloat -> [(Vector2 GLfloat)]
circlePoints n centerP r = map (vectorAdd centerP) [(Vector2 (r * cos (2 * pi * (fromIntegral i) / (fromIntegral n))) (r * sin (2 * pi * (fromIntegral i) / (fromIntegral n)))) | i <- [1..n]]


-----円周の分割数
circleVertexNum :: GLint
circleVertexNum = 20