{-
   The Quake 1 BSP file structure.
   Sven Panne 2000.   mailto:Sven.Panne@informatik.uni-muenchen.de
-}
module BspTree where

import Array(Array, (!))
import Monad(when)
import IO(Handle, hGetPosn)
import List(isPrefixOf)

import QuakeTypes
import Entity(Entity, readEntities)
import MipTex(qGetTextures, QPalette, QColorMap, LightLevel)
import Plane(qGetQPlane, qPlaneSize)
import ClipTree(ClipTree, qGetClipTrees)
import DFace(qGetTexInfo, texInfoSize, DFace, dFaceSize, qGetDFace)
import BSP(BSP, qGetBspTrees, RawLeaf, rawLeafSize, qGetRawLeaf)
import Entity(Entity(..), EntityClass)
-- import HOpenGL

---------------------------------------------------------------------------
-- The order of lumps in a BSP file is not the order in which they are needed.
-- Here the dependencies and one of the possible orders:
--
--    lump         | needs
--    -------------+----------------------------------------
--    entities     | nothing
--    planes       | nothing
--    textures     | nothing
--    vertices     | nothing
--    visibility   | nothing
--    texInfos     | textures
--    lightMaps    | nothing
--    clipTrees    | *recursive*, planes
--    edges        | vertices
--    surfEdges    | edges
--    faces        | planes, surfEdges, texInfos, lightMaps
--    markSurfaces | nothing
--    leaves       | visibility, markSurfaces
--    nodes        | *recursive*, planes, faces, leaves
--    models       | nodes, clipTrees, faces

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

data BspTree = BspTree {
   entities     :: [Entity],
   models       :: Array Int Model,
   leaves       :: Array Int RawLeaf,   -- referenced from PVS
   edges        :: Array Int QEdge      -- for wireframe only
 } -- deriving Show


-- ATTENTION: You probably go blind if you look at the following code too closely...
readBspTree :: QPalette -> QColorMap -> LightLevel -> Handle -> IO BspTree
readBspTree palette colorMap lightLevel h = do
   header          <- qGetHeader h

   putStrLn "Loading entities..."
   theEntities     <- readEntities (lumpEntities header)
   putStrLn "Loading planes..."
   thePlanes       <- readLumpAWith qGetQPlane (lumpPlanes header) qPlaneSize
   putStrLn "Loading texture objects..."
   theTexObjs      <- qGetTextures palette colorMap lightLevel (lumpTextures header)
   putStrLn "Loading vertices..."
   theVertices     <- readLumpAWith qGetQPoint (lumpVertices header) qPointSize
   putStrLn "Loading visibility info..."
   theVisibility   <- loadLumpBytes (lumpVisibility header)
   putStrLn "Loading texture information..."
   theTexInfos     <- readLumpAWith (qGetTexInfo theTexObjs) (lumpTexInfos header) texInfoSize
   putStrLn "Loading light maps..."
   theLightMaps    <- loadLumpBytes (lumpLightMaps header)
   putStrLn "Loading clip trees..."
   theClipTrees    <- qGetClipTrees thePlanes (lumpClipTrees header)
   putStrLn "Loading edges..."
   theEdges        <- readLumpAWith (readEdge theVertices) (lumpEdges header) dEdgeSize
   putStrLn "Loading surface edges..."
   theSurfEdges    <- readLumpAWith (readSurfEdge theEdges) (lumpSurfEdges header) qintSize
   putStrLn "Loading faces..."
   theFaces        <- readLumpAWith (qGetDFace thePlanes theSurfEdges theTexInfos theLightMaps) (lumpFaces header) dFaceSize
   putStrLn "Loading mark surfaces..."
   theMarkSurfaces <- readLumpAWith qGetQushort (lumpMarkSurfaces header) qushortSize
   putStrLn "Loading leaves..."
   theLeaves       <- readLumpAWith (qGetRawLeaf theMarkSurfaces) (lumpLeaves header) rawLeafSize
   putStrLn "Loading BSP trees..."
   theBspTrees     <- qGetBspTrees theLeaves thePlanes theFaces theVisibility (lumpNodes header)
   putStrLn "Loading models..."
   theModels       <- readLumpAWith (qGetModel theBspTrees theClipTrees theFaces) (lumpModels header) dModelSize

   return $ BspTree {
      entities = theEntities,
      models   = theModels,
      leaves   = theLeaves,
      edges    = theEdges }

---------------------------------------------------------------------------
-- The structure of a .bsp file header mainly consists of offset/length
-- pairs of its 15 parts.

bspVersionNo :: Qint
bspVersionNo = 29

data Header = Header {
   bspVersion :: Qint,
   lumpEntities,
   lumpPlanes,
   lumpTextures,
   lumpVertices,
   lumpVisibility,
   lumpNodes,
   lumpTexInfos,
   lumpFaces,
   lumpLightMaps,
   lumpClipTrees,
   lumpLeaves,
   lumpMarkSurfaces,
   lumpEdges,
   lumpSurfEdges,
   lumpModels :: Lump
 }   deriving Show

qGetHeader :: Handle -> IO Header
qGetHeader h = do
   start <- hGetPosn h
   bVersion <- qGetQint h
   when (bVersion /= bspVersionNo)
        (ioError (userError ("Expected .bsp version " ++ show bspVersionNo ++
                             ", not " ++ show bVersion)))
   lEntities     <- qGetLump start h
   lPlanes       <- qGetLump start h
   lTextures     <- qGetLump start h
   lVertices     <- qGetLump start h
   lVisibility   <- qGetLump start h
   lNodes        <- qGetLump start h
   lTexInfos     <- qGetLump start h
   lFaces        <- qGetLump start h
   lLightMaps    <- qGetLump start h
   lClipTrees    <- qGetLump start h
   lLeaves       <- qGetLump start h
   lMarkSurfaces <- qGetLump start h
   lEdges        <- qGetLump start h
   lSurfEdges    <- qGetLump start h
   lModels       <- qGetLump start h
   return $ Header {
      bspVersion       = bVersion,
      lumpEntities     = lEntities,
      lumpPlanes       = lPlanes,
      lumpTextures     = lTextures,
      lumpVertices     = lVertices,
      lumpVisibility   = lVisibility,
      lumpNodes        = lNodes,
      lumpTexInfos     = lTexInfos,
      lumpFaces        = lFaces,
      lumpLightMaps    = lLightMaps,
      lumpClipTrees    = lClipTrees,
      lumpLeaves       = lLeaves,
      lumpMarkSurfaces = lMarkSurfaces,
      lumpEdges        = lEdges,
      lumpSurfEdges    = lSurfEdges,
      lumpModels       = lModels }

---------------------------------------------------------------------------
-- An edge is stored as a pair of vertex indices.

dEdgeSize :: Int
dEdgeSize = 2 * qushortSize

readEdge :: Array Qushort QPoint -> Handle -> IO QEdge
readEdge vertices h = do
   vertexIndexFrom <- qGetQushort h
   vertexIndexTo   <- qGetQushort h
   return (QEdge (vertices ! vertexIndexFrom) (vertices ! vertexIndexTo))

---------------------------------------------------------------------------
-- A surface edge is stored as a Qint index into the edge array. A negative
-- index means "swap vertices" of edge with negated index.

readSurfEdge :: Array Int QEdge -> Handle -> IO QEdge
readSurfEdge edges h = do
  edgeIndex <- qGetQint h
  return (if edgeIndex > 0
             then edges ! fromIntegral edgeIndex
             else case edges ! fromIntegral (-edgeIndex) of
                     QEdge vertexFrom vertexTo -> QEdge vertexTo vertexFrom)

---------------------------------------------------------------------------
-- The whole level consists of one or more models. The first model is always
-- the level itself, and the other models are smaller parts within the level,
-- like moving bars, zones for trigerring something, etc.

maxMapHulls :: Int
maxMapHulls = 4   -- ???

data Model = Model {
   modelBBox   :: QAABBox,
   modelOrigin :: QPoint,
   bspTree     :: BSP,
   clipTree0   :: ClipTree,
   clipTree1   :: ClipTree,
   visLeaves   :: Qint,     -- not including the solid leaf 0
   modelFaces  :: Slice DFace
 } -- deriving Show

dModelSize :: Int
dModelSize = qAABBoxSize + qPointSize + (maxMapHulls+3)*qintSize

qGetModel :: Array Int BSP -> Array Int ClipTree -> Array Int DFace -> Handle -> IO Model
qGetModel bspTrees clipTrees faces h = do
   theModelBBox   <- qGetQAABBox h
   theModelOrigin <- qGetQPoint h
   nodeIndices    <- qGetN maxMapHulls qGetQint h
   theVisLeaves   <- qGetQint h
   firstFace      <- qGetQint h
   numFaces       <- qGetQint h
   return $ Model {
      modelBBox   = theModelBBox,
      modelOrigin = theModelOrigin,
      bspTree     = bspTrees  ! fromIntegral (nodeIndices !! 0),   -- strange...
      clipTree0   = clipTrees ! fromIntegral (nodeIndices !! 1),
      clipTree1   = clipTrees ! fromIntegral (nodeIndices !! 2),
      visLeaves   = theVisLeaves,
      modelFaces  = slice firstFace numFaces faces }

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

getEntitiesOfClass :: EntityClass -> BspTree -> [Entity]
getEntitiesOfClass classname theBspTree =
   [ entity | entity@(Entity cn _) <- entities theBspTree, classname == cn ]

getEntitiesStartingWith :: EntityClass -> BspTree -> [Entity]
getEntitiesStartingWith classPrefix theBspTree =
   [ entity | entity@(Entity cn _) <- entities theBspTree, classPrefix `isPrefixOf` cn ]
