{-
   Clip trees (calles "clip nodes" by qutils) are BSPs which are not used
   for rendering, but only as a first primitive collision check.
   Sven Panne 2000.   mailto:Sven.Panne@informatik.uni-muenchen.de
-}
module ClipTree where

import Array(Array, (!))
import IO(Handle)
import Monad(liftM)
import Plane(QPlane)
import QuakeTypes

---------------------------------------------------------------------------

data ClipTree =
     ClipNode {
        clipPlane_   :: QPlane,   -- the identifier clipPlane is already used by HOpenGL
        clipFront    :: ClipTree,
        clipBack     :: ClipTree }
   | ClipLeaf {
        clipContents :: QContents }
   deriving Show

qGetClipTrees :: Array Int QPlane -> Lump -> IO (Array Int ClipTree)
qGetClipTrees planes lump = do
   rawClipNodes <- readLumpAWith (qGetRawClipNode planes) lump rawClipNodeSize
   let cook (RawClipNode plane front back) =
          ClipNode {
             clipPlane_ = plane,
             clipFront  = son front,
             clipBack   = son back }
       son x | x < 0     = ClipLeaf { clipContents = qintToQContents (fromIntegral x) }
             | otherwise = clipTrees ! fromIntegral x
       clipTrees = fmap cook rawClipNodes
   return clipTrees

---------------------------------------------------------------------------

data RawClipNode =
   RawClipNode QPlane
               Qshort   -- front child, negative numbers are contents
               Qshort   -- back child
   deriving Show

rawClipNodeSize :: Int
rawClipNodeSize = qintSize + 2 * qshortSize

qGetRawClipNode :: Array Int QPlane -> Handle -> IO RawClipNode
qGetRawClipNode planes h = do
   planeIndex <- qGetQint   h
   frontIndex <- qGetQshort h
   backIndex  <- qGetQshort h
   return $ RawClipNode (planes ! fromIntegral planeIndex) frontIndex backIndex

---------------------------------------------------------------------------
-- Contents of a clip/BSP tree leaf
-- NOTE: The order of the constructors is important. Quake 1 uses negative
-- numbers for the contents, e.g. -1 for empty and -6 for sky.

data QContents =
     QContentsEmpty
   | QContentsSolid
   | QContentsWater
   | QContentsSlime
   | QContentsLava
   | QContentsSky
   deriving (Enum, Show)

qintToQContents :: Qint -> QContents
qintToQContents = toEnum . fromIntegral . negate . (+1)

qContentsSize :: Int
qContentsSize = qintSize

qGetQContents :: Handle -> IO QContents
qGetQContents = liftM qintToQContents . qGetQint
