module Collision
(
collisionWithBObjects
) where

import Graphics.Rendering.OpenGL
import Control.Applicative 
import States
import VectorMaps

-----2つのBObectが衝突しているか否かの判定
dBObjectCollision :: BObject -> BObject -> Bool
dBObjectCollision bObj bObj2 = 	let dwidth = (objWidth bObj) + (objWidth bObj2)
				in anyElementUnderConst (bObjectCenterDVector bObj bObj2) (Vector3 dwidth dwidth dwidth) 

-----2つのBObectの中心間の差のベクトル
bObjectCenterDVector :: BObject -> BObject -> (Vector3 GLfloat)
bObjectCenterDVector bObj bObj2 = vectorSubtract (objPosition bObj) (objPosition bObj2)

-----ベクトルの各要素の絶対値が基準以下の数であるか
anyElementUnderConst :: (Vector3 GLfloat) -> (Vector3 GLfloat) -> Bool
anyElementUnderConst (Vector3 x y z) (Vector3 a b c)= if (abs x) <= a && (abs y) < b && (abs z) < c
						then	True
						else	False  

-----衝突　(再帰)
collisionWithBObjects :: [BObject] ->[BObject]
collisionWithBObjects [a] = [a] 
collisionWithBObjects (bObj:tBObj) = (foldl ( fstcollisionWithOneBObject ) bObj tBObj) : (collisionWithBObjects (map (snd . collisionWithOneBObject bObj) tBObj))

-----
fstcollisionWithOneBObject :: BObject -> BObject -> BObject
fstcollisionWithOneBObject bObj1 bObj2 = fst(collisionWithOneBObject bObj1 bObj2)


-----BObject同士の衝突
collisionWithOneBObject :: BObject -> BObject -> (BObject , BObject)
collisionWithOneBObject bObj1 bObj2 = 	let 	dObjsVector = vectorNomalize ( bObjectCenterDVector bObj1 bObj2)  
						velBObj1' = vectorInnerProduct (objVelocity bObj1) dObjsVector
						velBObj2' = vectorInnerProduct (objVelocity bObj2) dObjsVector
						velBObjdV = vectorScalar (velBObj1' - velBObj2') dObjsVector

					in	if (dBObjectCollision bObj1 bObj2)  == True	
						then
							(bObjectVelocityChange bObj1 (vectorSubtract (objVelocity bObj1) velBObjdV) , bObjectVelocityChange bObj2 (vectorAdd (objVelocity bObj2) velBObjdV))
						else
							(bObj1 ,bObj2)

-----速さの異なるBObjectの作成
bObjectVelocityChange :: BObject -> (Vector3 GLfloat) -> BObject
bObjectVelocityChange bObj vel = 	let 	bObjPos = objPosition	bObj
						bObjAcc = objAccele	bObj	
						bObjWid = objWidth	bObj
						bObjTex = objTexture 	bObj
						
					in
						BObject bObjPos vel bObjAcc bObjWid FreeFall bObjTex