module Cube (cubeSet,eventButtonSet , eventFrame , counterSet) where import Graphics.Rendering.OpenGL import Graphics.UI.GLUT import Control.Applicative import States import VectorMaps import TipTileMaps import qualified Data.Map as Map ------四角形の描画 cube :: DState -> MState -> TipTile -> TextureObject -> IO () cube dst mst ttile tObj = do let tb = mainTable dst w = (tableWidth tb) / (fdivTileNum mst) h = (tableHeight tb) / (fdivTileNum mst) textureBinding Texture2D $= Just tObj texture Texture2D $= Enabled renderPrimitive Quads $ mapM_ vertextex ( map (vertexVectorTb tb mst ttile) [ (0 , 0.0 , (rdivTileNum mst) , (rdivTileNum mst)) ,(0 , h , (rdivTileNum mst) , 0) , ( w, h, 0 , 0),( w , 0 , 0 , (rdivTileNum mst))]) texture Texture2D $= Disabled ------四角形の描画--テクスチャ指定 cubeSet :: DState -> MState -> TexObjGrp -> TipTile -> IO () cubeSet dst mst tObGp ttile = if tileID ttile == (-1) then cube dst mst ttile (getTextureObj KeyTexTiles tObGp 1 ) else cube dst mst ttile (getTextureObj KeyTexTiles tObGp 0 ) ------ボタンの描画 eventButton:: EButton -> TextureObject -> IO () eventButton ebtn tObj = do let w = (buttonWidth ebtn) h = (buttonHeight ebtn) textureBinding Texture2D $= Just tObj texture Texture2D $= Enabled renderPrimitive Quads $ mapM_ vertextex ( map (vertexVector ebtn ) [ (0 , 0 , 0 , 1) ,(0 , h , 0 , 0.0) , ( w, h, 1.0 , 0.0),( w , 0 , 1 , 1)]) texture Texture2D $= Disabled ------ボタンの描画--テクスチャ指定 eventButtonSet :: TexObjGrp -> MState -> EButton -> IO () eventButtonSet tObGp mst ebtn = eventButton ebtn (getTextureObj (texObjKey ebtn) tObGp (eventButtonTexID mst ebtn)) ------イベントによるボタンテクスチャIDの指定 eventButtonTexID :: MState -> EButton -> Int eventButtonTexID mst ebtn | (texObjKey ebtn) == KeyTexReset = 0 | (texObjKey ebtn) == KeyTexLine = eventButtonLineTexID mst | (texObjKey ebtn) == KeyTexAdd = eventButtonLineAddID ebtn | otherwise = 0 ------AddボタンのテクスチャID eventButtonLineAddID :: EButton -> Int eventButtonLineAddID ebtn | buttonType ebtn == DivPlusButton = 0 | buttonType ebtn == DivMinusButton = 1 | otherwise = 0 ------FrameLineボタンのテクスチャID eventButtonLineTexID :: MState -> Int eventButtonLineTexID mst = let eventM = events mst eFrameFlag = mStateGetEventFlag mst EFrame in if eFrameFlag == (Just True) then 1 else 0 ------フレーム枠の描画 eventFrame :: Table -> MState -> IO () eventFrame tb mst = do mapM_ (eventFrameLineX tb mst) [0..(fdivTileNum mst) ] mapM_ (eventFrameLineY tb mst) [0..(fdivTileNum mst) ] ------フレーム枠の描画 eventFrameLineX :: Table -> MState -> GLfloat -> IO () eventFrameLineX tb mst i = do let tbW = (tableWidth tb) tbH = (tableWidth tb) renderPrimitive Lines $ mapM_ (vertifyLine tb) ( [ (i * tbW / (fdivTileNum mst) , 0 ) ,(i * tbW / (fdivTileNum mst) , tbH )]) ------フレーム枠の描画 eventFrameLineY :: Table -> MState -> GLfloat -> IO () eventFrameLineY tb mst j = do let tbW = (tableWidth tb) tbH = (tableWidth tb) renderPrimitive Lines $ mapM_ (vertifyLine tb) ( [ ( 0 , j * tbH / (fdivTileNum mst) ) ,(tbW , j * tbH / (fdivTileNum mst) )]) vertifyLine :: Table -> (GLfloat , GLfloat) -> IO () vertifyLine tb (x , y) = do let tbX = tableX tb tbY = tableY tb vt = vectorAdd (Vector2 x y) (Vector2 (tbX - 1) (tbY - 1)) vertex (setVertex vt) ------カウンター描画 counterSet :: TexObjGrp -> Counter -> IO () counterSet tOGp cnt = do let dList = getDegitNumList (counterNumDegit cnt) (counterValue cnt) mapM_ (counterElement cnt tOGp) dList ------カウンター描画 counterElement :: Counter -> TexObjGrp -> (Int , GLint) -> IO () counterElement cnt tOGp (i , di) = do let w = ((tableWidth (counterContainer cnt)) - (counterMargin cnt) * 2) / ((fromIntegral (counterNumDegit cnt) )+ 1) h = (tableHeight (counterContainer cnt)) - (counterMargin cnt) * 2 ndcnt = (counterNumDegit cnt) tObj = getTextureObj (counterTexKey cnt) tOGp (fromIntegral di) dPos = (Vector2 (w * (fromIntegral (ndcnt - i)) + (counterMargin cnt)) (counterMargin cnt)) textureBinding Texture2D $= Just tObj texture Texture2D $= Enabled renderPrimitive Quads $ mapM_ vertextex ( map (vertexVectorContainer (counterContainer cnt) dPos) [ (0 , 0 , 0 , 1) ,(0 , h , 0 , 0.0) , ( w, h, 1 , 0),( w , 0 , 1 , 1)]) texture Texture2D $= Disabled ------桁のリスト （再帰） getDegitNumList :: Int -> GLint -> [(Int , GLint)] getDegitNumList m a | a < 0 = [(0 , 10)] | m < 0 = [] | a >= (tpm * 10) = (getDegitNumList m (a - 1)) | otherwise = (m , ( a `quot` tpm) ) : (getDegitNumList (m - 1) (a `rem` tpm)) where tpm = (fromIntegral (10 ^ m)) :: GLint ------コンテナ座標と与えられた位置ベクトルを移動した後、座標とテクスチャ座標を分離してベクトルのペアを返す vertexVectorContainer :: Table -> (Vector2 GLfloat) -> (GLfloat ,GLfloat,GLfloat ,GLfloat) -> ((Vector2 GLfloat) , (Vector2 GLfloat)) vertexVectorContainer con v (x ,y, a ,b) = let cPosX = tableX con cPosY = tableY con in (vectorAdd v (vectorAdd (Vector2 x y) (Vector2 cPosX cPosY)) , (Vector2 a b)) ------座標とテクスチャ座標のペアからrenderPrimitiveで使うIOアクションを返す vertextex :: ((Vector2 GLfloat) , (Vector2 GLfloat)) -> IO () vertextex vt = if (vectorElementY (snd vt)) >= 0 then do texCoord (setTexCoord (snd vt)) vertex (setVertex (fst vt)) else do vertex (setVertex (fst vt)) ------与えられた位置ベクトルだけ移動した後、座標とテクスチャ座標を分離してベクトルのペアを返す vertexVector :: EButton -> (GLfloat ,GLfloat,GLfloat ,GLfloat) -> ((Vector2 GLfloat) , (Vector2 GLfloat)) vertexVector ebtn (x,y,a,b) = ( (vectorAdd (Vector2 x y) (buttonPosition ebtn)) , (Vector2 a b)) ------テーブル座標分と与えられた位置ベクトル分だけ移動した後、座標とテクスチャ座標を分離してベクトルのペアを返す vertexVectorTb :: Table -> MState -> TipTile -> (GLfloat ,GLfloat,GLfloat ,GLfloat) -> ((Vector2 GLfloat) , (Vector2 GLfloat)) vertexVectorTb tb mst ttile (x,y,a,b) = let tPos = tilePosition ttile texPos = texPosition ttile in ((vectorAdd (Vector2 x y) (transTileIntoPosition tb mst tPos)) , (vectorAdd (Vector2 ((rdivTileNum mst) - a) b) (transTileIntoTexCoord texPos mst))) setVertex :: (Vector2 GLfloat) -> (Vertex2 GLfloat) setVertex (Vector2 x y) = (Vertex2 x y) setTexCoord :: (Vector2 GLfloat) -> (TexCoord2 GLfloat) setTexCoord (Vector2 x y) = (TexCoord2 x y)