{-
   The BSP (binary space partition) in its full glory.
   Sven Panne 2000.   mailto:Sven.Panne@informatik.uni-muenchen.de
-}
module BSP where

import Array(Array, (!))
import IO(Handle)
import Data.IORef(IORef, newIORef)

import GL(Ptr, GLubyte)

import ClipTree(QContents, qContentsSize, qGetQContents)
import DFace(DFace)
import Geometry
import Plane(QPlane)
import QuakeTypes

---------------------------------------------------------------------------
-- A BSP tree

data BSP =
     BspNode {
        splittingPlane  :: QPlane,
        frontBspChild   :: BSP,
        backBspChild    :: BSP,
        bspBBox         :: QAABBox,       -- NOTE: converted from QAABBoxShort
        bspFaces        :: Slice DFace,
        bspNodeMark     :: IORef Bool }   -- True means "potentially visible"
   | BspLeaf {
        bspContents     :: QContents,
        visiInfo        :: (Int, Ptr GLubyte),   -- HACK
        bspBBox         :: QAABBox,       -- NOTE: converted from QAABBoxShort
        bspMarkSurfaces :: Slice Qushort,
        ambientLevels   :: Ambient,
        leafId          :: Int }          -- for checking visibility

{-
instance Show BSP where
   showsPrec p (BspNode sp fc bc bb fa _ ) =
      showParen (p >= 9) $ shows ("BspNode", sp, (fc, bc), bb, fa)
   showsPrec p (BspLeaf bc vi bb fa am li) =
      showParen (p >= 9) $ shows ("BspLeaf", bc, vi, (bb, fa, am, li))
-}

qGetBspTrees ::  Array Int RawLeaf -> Array Int QPlane -> Array Int DFace
             -> Ptr GLubyte -> Lump -> IO (Array Int BSP)
qGetBspTrees leaves planes faces visibility lump = do
   rawBspNodes <- readLumpAWith (qGetRawBspNode planes faces) lump rawBspNodeSize
   let bBoxSToF (AABBox { aABBoxMin = pMin, aABBoxMax = pMax }) =
          AABBox { aABBoxMin = pSToF pMin, aABBoxMax = pSToF pMax }
       pSToF (Point x y z) = Point (fromIntegral x) (fromIntegral y) (fromIntegral z)
       cook (RawBspNode { rawBspSplittingPlane = plane, rawBspFront = front, rawBspBack = back,
                          rawBspBBox = bBox, rawBspFaces = theFaces, rawBspNodeMark = mark}) =
          BspNode {
             splittingPlane = plane,
             frontBspChild  = son front,
             backBspChild   = son back,
             bspBBox        = bBoxSToF bBox,
             bspFaces       = theFaces,
             bspNodeMark    = mark }
       son x | x < 0     = let idx     =  fromIntegral (-(x+1))
                               rawLeaf = leaves ! idx
                           in BspLeaf {
                                 bspContents     = rawLeafContents rawLeaf,
                                 visiInfo        = (fromIntegral (rawLeafVisiOffs rawLeaf), visibility),
                                 bspBBox         = bBoxSToF (rawLeafBBox rawLeaf),
                                 bspMarkSurfaces = rawLeafMarkSurfaces rawLeaf,
                                 ambientLevels   = rawAmbientLevels rawLeaf,
                                 leafId          = idx }
             | otherwise = bspTrees ! fromIntegral x
       bspTrees = fmap cook rawBspNodes
   return bspTrees

---------------------------------------------------------------------------
-- A handy intermediate structure for building BSP nodes from a file.

data RawBspNode = RawBspNode {
   rawBspSplittingPlane :: QPlane,
   rawBspFront          :: Qshort,       -- front child index; a negative number means -(leaves+1), not a node
   rawBspBack           :: Qshort,       -- back child node
   rawBspBBox           :: QAABBoxShort, -- bounding box, slightly exaggerated (multiples of 8?)
   rawBspFaces          :: Slice DFace,  -- all faces in the splitting plane
   rawBspNodeMark       :: IORef Bool    -- True means "potentially visible"
 }

instance Show RawBspNode where
   showsPrec p (RawBspNode sp f b bb fa _) =
      showParen (p >= 9) $ shows ("RawBspNode", sp, (f, b), bb, fa)

rawBspNodeSize :: Int
rawBspNodeSize = qintSize + 2*qshortSize + qAABBoxShortSize + 2*qushortSize

qGetRawBspNode :: Array Int QPlane -> Array Int DFace -> Handle -> IO RawBspNode
qGetRawBspNode planes faces h = do
   planeIndex <- qGetQint h
   front      <- qGetQshort h
   back       <- qGetQshort h
   bBox       <- qGetQAABBoxShort h
   firstFace  <- qGetQushort h
   numFaces   <- qGetQushort h
   mark       <- newIORef False
   return $ RawBspNode {
      rawBspSplittingPlane = planes ! fromIntegral planeIndex,
      rawBspFront          = front,
      rawBspBack           = back,
      rawBspBBox           = bBox,
      rawBspFaces          = slice firstFace numFaces faces,
      rawBspNodeMark       = mark }

---------------------------------------------------------------------------
-- A raw BSP tree leaf. Note: Leaf 0 is the generic QContentsSolid leaf,
-- used for all solid areas, all other leaves need visibility info.

data RawLeaf = RawLeaf {
   rawLeafContents     :: QContents,
   rawLeafVisiOffs     :: Qint,           -- beginning of visibility list, -1 = no visibility info
   rawLeafBBox         :: QAABBoxShort,   -- for frustum culling
   rawLeafMarkSurfaces :: Slice Qushort,
   rawAmbientLevels    :: Ambient
 } deriving Show

rawLeafSize :: Int
rawLeafSize = qContentsSize + qintSize + qAABBoxShortSize + 2*qushortSize + ambientSize

qGetRawLeaf :: Array Int Qushort -> Handle -> IO RawLeaf
qGetRawLeaf markSurfaces h = do
   contents         <- qGetQContents h
   visiOffs         <- qGetQint h
   bBox             <- qGetQAABBoxShort h
   firstMarkSurface <- qGetQushort h
   numMarkSurfaces  <- qGetQushort h
   levels           <- qGetAmbient h
   return (RawLeaf {
      rawLeafContents     = contents,
      rawLeafVisiOffs     = visiOffs,
      rawLeafBBox         = bBox,
      rawLeafMarkSurfaces = slice firstMarkSurface numMarkSurfaces markSurfaces,
      rawAmbientLevels    = levels })

---------------------------------------------------------------------------
-- Automatic ambient sound levels

data Ambient = Ambient {
   ambientWater, ambientSky, ambientSlime, ambientLava :: Qbyte
 } deriving Show

ambientSize :: Int
ambientSize = 4 * qbyteSize

qGetAmbient :: Handle -> IO Ambient
qGetAmbient h = do
   water <- qGetQbyte h
   sky   <- qGetQbyte h
   slime <- qGetQbyte h
   lava  <- qGetQbyte h
   return $ Ambient {
      ambientWater = water,
      ambientSky   = sky,
      ambientSlime = slime,
      ambientLava  = lava }
