content: {- Visibility.hs; Mun Hon Cheong (mhch295@cse.unsw.edu.au) 2005
  
  Visibility tests with BSP
  
  (A lot of the code is rewritten from the collision detection module)
  
  -}
  
  module Visibility where
  
  import Matrix (Vec3,
                 crossProd,
                 dotProd,
                 mapTup,
                 normalise,
                 vectorAdd,
                 vectorMult,
                 vectorSub)
  import BSP -- (bsPlaneNorm, bsPlaneDist, numOfBrushSides, textureType, brushside, BSPBrushSide(..), tree, planeNormal, dist, Tree(..))
  import Collision(CollisionType(..))
  
  
  epsilon :: Double
  epsilon = 0.03125
  
  getOffset :: CollisionType -> Vec3 -> Double
  getOffset (Box _ _ extents) plane = getBoxOffs extents plane
  getOffset (SphereT rad) _ = rad
  
  getBoxOffs :: Vec3 -> Vec3 -> Double
  getBoxOffs (x,y,z) (x1,y1,z1) =
     (abs (x*x1))+(abs (y*y1))+(abs (z*z1))
  
  
  -------------------------------------------------------------------------------
  -- visibility tests
  
  aiVisTest :: BSPMap -> Vec3 -> Double -> Vec3 -> Int -> Bool
  aiVisTest bsp currentPos angle targetPos range =
    case (fieldTest currentPos angle targetPos range) of
       False -> False
       _ -> rayTest bsp currentPos targetPos
  
  
  -- test if the objct lies wihitn the field of view
  fieldTest :: (Double,Double,Double) ->Double ->
    (Double,Double,Double) -> Int -> Bool
  fieldTest  (x,y,z) angle (ox,oy,oz) range =
    (distance < (realToFrac range)  &&
    (horizangle <= 30) &&
    (abs verticalangle) <= 60 ) || distance < 300
    where
      distance = sqrt (((x-ox)^(2 :: Int))+((y-oy)^(2 :: Int))+((z-oz)^(2 :: Int)))
      horizanglei =
         let ha=acos $ dotProd (normalise $ vectorSub (ox,0,oz) (x,0,z)) (1,0,0)
         in case (oz > z) of
            False -> (ha*180/pi)
            True  -> (360 - (ha*180/pi))
      horizangle =
         min (abs (horizanglei - angle))  (abs (horizanglei - (angle + 360)))
      verticalangle =
         let va=acos $ dotProd (normalise $ vectorSub (ox,oy,oz) (x,y,z)) (0,1,0)
         in ((va*180/pi)-90)
  
  
  -- fires rays to the target to determine visibility
  rayTest :: BSPMap ->  Vec3 -> Vec3 -> Bool
  rayTest bsp (x,y,z) vec2@(_,_,_) =
    let
     (x1,y1,z1) = normalise $ crossProd (vectorSub vec2 (x,y+30,z)) (0,1,0)
     (x2,y2,z2) = normalise $ crossProd (vectorSub vec2 (x,y+30,z)) (x1,y1,z1)
     v1 = vectorAdd vec2 (vectorMult (x1-x2,y1-y2,z1-z2) 45)
     v2 = vectorAdd vec2 (vectorMult (x1+x2,y1+y2,z1+z2) 45)
     v3 = vectorAdd vec2 (vectorMult (-x1-x2,-y1-y2,-z1-z2) 45)
     in case (snd $ clipRay2 bsp vec2 (x,y,z) (0,0,0)) of
         False -> True
         _ -> case (snd $ clipRay2 bsp v1 (x,y+30,z) (0,0,0)) of
                False -> True
                _ -> case (snd $ clipRay2 bsp v2 (x,y+30,z)(0,0,0)) of
                       False -> True
                       _ -> case (snd $ clipRay2 bsp v3 (x,y+30,z)(0,0,0)) of
                              False -> True
                              _ ->case(snd $ clipRay2 bsp v3 (x,y+30,z)(0,0,0))of
                                      False -> True
                                      True -> False
  
  
  createSphere :: Double ->  CollisionType
  createSphere rad = SphereT rad
  
  
  clipRay2 :: BSPMap -> Vec3 -> Vec3 ->  Vec3 -> (Vec3, Bool)
  clipRay2 mp pos oldpos (_,_,_) =
    let (colPos,collided,_,_) = traceo (createSphere 0) mp oldpos pos
    in (colPos, collided)
  
  
  traceo ::  CollisionType -> BSPMap ->
     Vec3 -> Vec3 -> (Vec3,Bool,Bool,Bool)
  traceo cType mp start end
    | (newRatio /= 1.0) =
          (vectorAdd start
              (vectorMult (vectorSub end start) newRatio),hasCol,step,grounded)
    | otherwise = (end,False,step,grounded)
    where
       (hasCol,step,grounded,newRatio,(_,_,_)) =
           fixCheck $ (checkNode cType (False,False,False,1.0, (0.0,0.0,0.0))
              (tree mp) 0.0 1.0 start end)
       fixCheck x =
          case x of
            (Just a) ->  a
            Nothing  -> (False,False,False,1.0, (0.0,0.0,0.0))
  
  
  {-
  drawTest :: BSPMap ->  Vec3 -> Vec3 ->IO()
  drawTest bsp vec1@(x,y,z) vec2@(ox,oy,oz) = do
    let (x1,y1,z1) = normalise $ crossProd (vectorSub vec2 (x,y+30,z)) (0,1,0)
    let (x2,y2,z2) = normalise $ crossProd (vectorSub vec2 (x,y+30,z)) (x1,y1,z1)
    let (a1,b1,c1) = vectorAdd vec2 (vectorMult (x1-x2,y1-y2,z1-z2) 45)
    let (a2,b2,c2) = vectorAdd vec2 (vectorMult (x1+x2,y1+y2,z1+z2) 45)
    let (a3,b3,c3) = vectorAdd vec2 (vectorMult (-x1-x2,-y1-y2,-z1-z2) 45)
    let (a4,b4,c4) = vectorAdd vec2 (vectorMult (-x1+x2,-y1+y2,-z1+z2) 45)
    pointSize $= 13
    unsafeRenderPrimitive Points $ do
       vertex (Vertex3 a1 b1 c1)
       vertex (Vertex3 a2 b2 c2)
       vertex (Vertex3 a3 b3 c3)
       vertex (Vertex3 a4 b4 c4)
  -}
  
  -------------------------------------------------------------------------------
  --  check for collisions with brushes
  
  
  checkBrushes:: CollisionType -> (Bool, Bool, Bool, Double,Vec3)  ->
     Tree -> Vec3 -> Vec3 -> Maybe (Bool, Bool, Bool, Double, Vec3)
  checkBrushes cType _ (Leaf leaf) start end =
     checkBrush start end cType (leafBrushes leaf)
  
  
  checkBrush :: Vec3-> Vec3 -> CollisionType ->
     [BSPBrush] -> Maybe (Bool,Bool,Bool,Double,Vec3)
  checkBrush _ _ _ [] = Just (False,False,False,0,(0,0,0))
  checkBrush start end cType (brush:brushes) =
       let res = checkBrush'  start end cType brush
       in case (res) of
           Just (True,_,_,_,_) -> res
           _ -> checkBrush start end cType brushes
  
  
  checkBrush' :: Vec3-> Vec3 -> CollisionType ->
     BSPBrush -> Maybe (Bool,Bool,Bool,Double,Vec3)
  checkBrush'  start end cType brush
       |((numOfBrushSides brush) > 0) && ((textureType brush)==1) =
         let colout =
               checkBrushSides start end
                  cType False False False False (-1.0)
                     (1.0) (0,0,0) (brushSides brush)
         in case colout of
            Just (out,collided,step,grounded,startR,endR,newNorm) ->
                case (startR < endR && startR > -1  && out) of
                   True -> Just (collided,step,grounded,fixRatio startR,newNorm)
                   _    -> Nothing
            _ -> Nothing
       |otherwise = Nothing
       where
          fixRatio x
             | x < 0.0 = 0.0
             | otherwise = x
  
  
  checkBrushSides ::  Vec3 -> Vec3 -> CollisionType-> Bool -> Bool ->
     Bool -> Bool -> Double -> Double -> Vec3 -> [BSPBrushSide] ->
       (Maybe (Bool,Bool,Bool,Bool,Double,Double,Vec3))
  checkBrushSides  (_,_,_) (_,_,_) _
    out collided step ground startR endR cNorm [] =
       Just (out,collided,step,ground,startR,endR,cNorm)
  checkBrushSides  start@(x,_,z) end@(x1,_,z1) cType
    out collided step ground startR endR cNorm (b:bs)
       | startDist >  0 && endDist >  0 = Nothing
       | startDist <= 0 && endDist <= 0 = continue
       | startDist > endDist =
             case (ratio1 > startR) of
                True -> (checkBrushSides start end cType
                            checkout True mayStep grounded
                                ratio1 endR (bsPlaneNorm b) bs)
                _    -> continue
       | otherwise =
             case (ratio2 < endR) of
                True -> (checkBrushSides start end cType
                            checkout collided step ground
                                startR ratio2 cNorm bs)
                _    -> continue
       where
          checkout
              | startDist > 0 = True
              | otherwise = out
          mayStep
              | ((x /= x1 || z /= z1) && planey /= 1) = True
              | otherwise = step
          grounded
              | planey >= 0.2 = True
              | otherwise = ground
          planey = get2nd3 (bsPlaneNorm b)
          ratio1     = (startDist - epsilon) / (startDist - endDist)
          ratio2     = (startDist + epsilon) / (startDist - endDist)
          continue  = checkBrushSides start end cType
                         checkout collided step ground
                             startR endR cNorm bs
          startDist = vDist start cType (bsPlaneNorm b) (bsPlaneDist b)
          endDist = vDist end cType  (bsPlaneNorm b) (bsPlaneDist b)
          get2nd3 (_,a,_) = a
  
  
  vDist :: Vec3 -> CollisionType -> Vec3 -> Double  ->  Double
  vDist vec box@(Box _ _ _) pnorm pdist =
     (dotProd (vectorAdd vec (getVOffs pnorm box)) pnorm) - pdist
  vDist vec (SphereT rad) pnorm pdist =
     (dotProd vec pnorm) - (pdist + rad)
  
  
  getVOffs:: Vec3 -> CollisionType  -> Vec3
  getVOffs (p1,p2,p3) (Box (x,y,z) (x1,y1,z1) _) =
     (chooseMin' p1 x x1,chooseMin' p2 y y1, chooseMin' p3 z z1)
     where
        chooseMin' p mn mx
          | p < 0 = mx
          | otherwise = mn
  
  
  
  
  -------------------------------------------------------------------------------
  
  
  -- recurse down a nodes
  checkNode :: CollisionType -> (Bool,Bool,Bool,Double,Vec3) ->
     Tree -> Double-> Double -> Vec3 -> Vec3 -> Maybe (Bool,Bool,Bool,Double,Vec3)
  checkNode cType cState (Leaf leaf) _ _ start end =
     checkBrushes cType cState (Leaf leaf)  start end
  checkNode cType cState (Branch node left right) startRatio endRatio start end =
     let sDist = (dotProd (planeNormal node) start) - (dist node)
         eDist = (dotProd (planeNormal node) end)   - (dist node)
     in recurse sDist eDist
     where
        boffset = getOffset cType (planeNormal node)
        recurse sDist eDist
           | (sDist >= boffset && eDist >= boffset)             =
              checkNode cType cState left  sDist eDist start end
           | (sDist < ((-1)*boffset) && eDist < ((-1)*boffset)) =
              checkNode cType cState right sDist eDist start end
           | otherwise =
              split cType cState sDist eDist
                 startRatio endRatio start end
                    (Branch node left right)
  
  
  -- splits a vector if it lies on both side of
  -- the splitting plane
  split :: CollisionType -> (Bool,Bool,Bool,Double,Vec3) ->
     Double -> Double -> Double -> Double -> Vec3 -> Vec3 ->
        Tree -> Maybe (Bool,Bool,Bool,Double,Vec3)
  split cType cState startDist endDist startRatio
     endRatio start end (Branch node left right)
         |startDist < endDist =
           let result1 = checkNode cType cState
                            right startRatio (middleR r1) start (middleV r1)
           in case (result1) of
               Just (True,_,_,_,_) -> result1
               _ -> let result2 =
                          checkNode  cType cState left
                           (middleR r2) endRatio (middleV r2) end
                    in case (result2) of
                         Just (True,_,_,_,_) -> result2
                         _                   -> Nothing
         |startDist > endDist =
           let result1 = checkNode  cType cState
                            left  startRatio (middleR r2) start (middleV r2)
           in case (result1) of
               Just (True,_,_,_,_) -> result1
               _ -> let result2 =
                          checkNode  cType cState right
                           (middleR r1) endRatio   (middleV r1) end
                    in case (result2) of
                         Just (True,_,_,_,_) -> result2
                         _                   -> Nothing
         |otherwise =
           let result1 = checkNode  cType cState
                            left  startRatio (middleR 1.0) start (middleV 1.0)
           in case (result1) of
               Just (True,_,_,_,_) -> result1
               _ -> let result2 =
                          checkNode  cType cState right
                           (middleR 0.0) endRatio   (middleV 0.0) end
                    in case (result2) of
                         Just (True,_,_,_,_) -> result2
                         _                   -> Nothing
         where
            inverseDist = 1.0/(startDist - endDist)
            boffset     = getOffset cType (planeNormal node)
            r1          = fixDouble $ (startDist - boffset - epsilon)*inverseDist
            r2          = fixDouble $ (startDist + boffset + epsilon)*inverseDist
            middleR     = getMiddleRatio startRatio endRatio
            middleV     = getHalfVec start end
            fixDouble x
               | x < 0.0 = 0.0
               | x > 1.0 = 1.0
               | otherwise = x
  
  
  -- gets the middle of 2 ratios
  getMiddleRatio :: Double -> Double -> Double -> Double
  getMiddleRatio startRatio endRatio ratio =
         startRatio + (ratio * (endRatio - startRatio))
  
  
  -- gets half a vector
  getHalfVec :: Vec3 -> Vec3 -> Double -> Vec3
  getHalfVec start end ratio =
         vectorAdd start (mapTup (ratio*) (vectorSub end start))
  
  