module DisplayState (newDState) where
import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT

import Cube
import Action
import States
import VectorMaps
import Collision

------上昇落下でテクスチャの区別

data TextureFreeFall = FreeFallUpTexFlag | FreeFallDownTexFlag

------壁の設定
walls:: WState -> (Vector3 PBound)
walls wst = (Vector3 (PBound ((-1.0) / (windowWH wst)) (1.0 / (windowWH wst))) (PBound (-1.0) 3.0)  (PBound (-1.0) 1.0))

------エレベータフラグが立つ高さ
elevatorStartHeight:: WState -> GLfloat
elevatorStartHeight wst =  (minBorder (vectorElementY (walls wst))) + 0.01

------エレベータ終了の高さ
elevatorEndHeight:: WState -> GLfloat
elevatorEndHeight wst = (minBorder (vectorElementY (walls wst))) + 1.8

------エレベータ上昇速度
elevatorVelocity:: (Vector3 GLfloat)
elevatorVelocity = (Vector3 0 0.0002 0)

------反発係数
wallsrefc :: (Vector3 GLfloat)
wallsrefc = Vector3 1.0  0.9 1.0

------
newDState :: DState -> KState -> WState -> DState
newDState dst kst wst = nextDState dst wst


------DState中のBObjectすべてに動作と衝突を適用したDStateを返す
nextDState :: DState -> WState -> DState
nextDState dst wst = DState $ collisionWithBObjects [ nextAction bOb wst | bOb <- (bObjs dst)]



------動作選択
nextAction :: BObject -> WState -> BObject
nextAction bOb wst  = case (newActionID bOb wst) of
			FreeFall -> freeFallAct bOb wst
			Elevator -> elevatorAct bOb wst


------自由落下
freeFallAct :: BObject -> WState -> BObject
freeFallAct bOb wst = 	let 	opos = objPosition bOb
				vel = objVelocity bOb
				acc = objAccele bOb
				velocity =  newVelocity3 (walls wst) wallsrefc opos  acc vel
      				oposition = nextPosition3  opos vel
				tex = objTexture bOb
		in  BObject oposition velocity acc (objWidth bOb) (newActionID bOb wst) (textureChange bOb tex)

------エレベーター動作
elevatorAct :: BObject -> WState -> BObject
elevatorAct bOb wst = 	let 	opos = objPosition bOb
				vel = objVelocity bOb
				acc = objAccele bOb
      				oposition = nextPosition3  opos elevatorVelocity
				velocity = vel
				tex = objTexture bOb
		in  BObject oposition velocity acc (objWidth bOb) (newActionID bOb wst) (textureChange bOb tex)




------現在のActionIDから次のActionIDの指定関数の決定
newActionID :: BObject -> WState -> ActionID
newActionID bOb wst= case (objActionID bOb) of
		Elevator  ->	newActionIDElevator bOb wst
		FreeFall  ->	newActionIDFreeFall bOb wst



------自由落下中の次のActionIDの決定
newActionIDFreeFall :: BObject -> WState -> ActionID
newActionIDFreeFall bOb wst= case (elevatorCheck bOb wst) of 			
		True	-> Elevator 			--;エレベーター
		False	-> FreeFall 			--;自由落下

------エレベーター中の次のActionIDの決定
newActionIDElevator :: BObject -> WState -> ActionID
newActionIDElevator bOb wst= case (elevatorEndCheck bOb wst) of 			
		True	-> FreeFall 			--;エレベーター
		False	-> Elevator 			--;自由落下

------エレベーター動作をするかの判定
elevatorCheck :: BObject -> WState -> Bool
elevatorCheck bOb wst= if ((vectorElementY $ objPosition bOb) < (elevatorStartHeight wst)) && ((abs . vectorElementY $ objVelocity bOb) < 0.0001)
			then	True
			else	False

------エレベーター動作を終了するかの判定
elevatorEndCheck :: BObject -> WState -> Bool
elevatorEndCheck bOb wst= if ((vectorElementY $ objPosition bOb) >= (elevatorEndHeight wst))
			then	True
			else	False


------BObjectの状態によってテクスチャの変更

textureChange :: BObject -> TexObjDataID -> TexObjDataID
textureChange bObj tObjID = case (textureChangeBoundFlag bObj) of	
			FreeFallUpTexFlag 	-> (TexObjDataID (texGroup tObjID) 1)
			FreeFallDownTexFlag     -> (TexObjDataID (texGroup tObjID) 0) 
 



------テクスチャの変更の判定
textureChangeBoundFlag :: BObject -> TextureFreeFall
textureChangeBoundFlag bObj = if ((objActionID bObj) == FreeFall ) && ((vectorElementY $ objVelocity bObj) > 0.0)	
					then FreeFallUpTexFlag									
					else FreeFallDownTexFlag