{-
   Quake faces, i.e. textured lightmapped convex polygons
   Sven Panne 2000.   mailto:Sven.Panne@informatik.uni-muenchen.de
-}
module DFace where

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

---------------------------------------------------------------------------
-- The following was hard to extract from the qutils, the Quake Specs, and the
-- qdevel mailing list (well, at least for me...): Quake 1 uses naturally
-- aligned textures (NATs). For conversion to texture coordinates this means
-- that the 3D vertex is projected onto the s/t plane and shifted by an
-- offset. The s/t planes are alway one of the six major planes (north, west,
-- south, east, top, bottom). A cute analogy from the Quake Level Design
-- Handbook (rephrased): The textures are a fixed carpet with an orientation
-- given by the s/t vectors and shifted by the offsets, and the faces are just
-- like windows looking onto the carpet. A consequence of NATs: If you look
-- directly down onto a horizontal floor and a ramp, both having the same s/t
-- vectors, the texels on the ramp are denser than those on the floor. The
-- level designer can change this by scaling s/t. Note for OpenGL: The
-- textures must repeat in both directions.

data TexInfo = TexInfo {
   vectorS :: QVector,   -- TODO: Replace these 4 fields by a 2D frame?
   offsetS :: Qfloat,
   vectorT :: QVector,
   offsetT :: Qfloat,
   mipTex  :: MipTex,    -- in file Qint, index into miptex array
   skyFlag :: Bool       -- in file Qint, only bit 1 used for sky or slime
 } deriving Show         --     (no lightmap, no 256 subdivision)

texInfoSize :: Int
texInfoSize = 2*(qPointSize+qfloatSize) + 2*qintSize

qGetTexInfo :: Array Int MipTex -> Handle -> IO TexInfo
qGetTexInfo mipTexs h = do
   theVectorS  <- qGetQVector h
   theOffsetS  <- qGetQfloat h
   theVectorT  <- qGetQVector h
   theOffsetT  <- qGetQfloat h
   mipTexIndex <- qGetQint h
   flags       <- qGetQint h
   return $ TexInfo {
      vectorS = theVectorS,
      offsetS = theOffsetS,
      vectorT = theVectorT,
      offsetT = theOffsetT,
      mipTex  = mipTexs ! fromIntegral mipTexIndex,
      skyFlag = flags /= 0 }

---------------------------------------------------------------------------
-- Faces are convex polygons covering the original planes. This distinction
-- is necessary for most graphic APIs, because they seldom handle concave
-- polygons.

maxLightMaps :: Int
maxLightMaps = 4

data DFace = DFace {
   facePlane       :: QPlane,
   frontIsTextured :: Bool,                  -- the plane normal's side is textured
   faceEdges       :: [QEdge],
   texInfo         :: TexInfo,
   lightStyles     :: [Qbyte],               -- always maxLightMaps elements
   lightMap        :: Maybe TextureName,     -- no Show instance for TextureName!
   stCoords        :: [TexCoord2 Qfloat],    -- cache for s/t texture coordinates
   lmCoords        :: [TexCoord2 Qfloat]     -- cache for s/t lightmap coordinates
 }

instance Show DFace where
   showsPrec p face = showParen (p >= 9) (showString"DFace " .  shows (facePlane face))

dFaceSize :: Int
dFaceSize = 4*qshortSize + 2*qintSize + maxLightMaps*qbyteSize

qGetDFace :: Array Int QPlane -> Array Int QEdge -> Array Int TexInfo -> Ptr GLubyte -> Handle -> IO DFace
qGetDFace planes surfEdges texInfos lightMaps h = do
   planeIndex <- qGetQshort h
   side       <- qGetQshort h
   firstEdge  <- qGetQint h
   numEdges   <- qGetQshort h
   texInfoIdx <- qGetQshort h
   styles     <- qGetN maxLightMaps qGetQbyte h
   lightOff   <- qGetQint h   -- -1 means no light map, otherwise start of [numstyles*surfsize] samples

   let fPlane  = planes ! fromIntegral planeIndex
       fEdges  = lSlice firstEdge numEdges surfEdges
       tInfo   = texInfos ! fromIntegral texInfoIdx
       mip     = mipTex tInfo

       (sCoords, lmSSize, lmSTexSize, lmSCoords) = calcTexCoords fEdges (vectorS tInfo) (offsetS tInfo) (textureWidth  mip)
       (tCoords, lmTSize, lmTTexSize, lmTCoords) = calcTexCoords fEdges (vectorT tInfo) (offsetT tInfo) (textureHeight mip)

   lMap <- if lightOff < 0
              then return Nothing
              else liftM Just (getLightMap lmSSize lmSTexSize lmTSize lmTTexSize lightMaps (fromIntegral lightOff))

   return $ DFace {
      facePlane       = fPlane,
      frontIsTextured = side == 0,
      faceEdges       = fEdges,
      texInfo         = tInfo,
      lightStyles     = styles,
      lightMap        = lMap,
      stCoords        = zipWith TexCoord2 sCoords   tCoords,
      lmCoords        = zipWith TexCoord2 lmSCoords lmTCoords }


calcTexCoords :: [QEdge] -> QVector -> Qfloat -> Qint -> ([Qfloat], GLsizei, GLsizei, [Qfloat])
calcTexCoords fEdges vector offset size = (texCoords, lmSize, lmTexSize, lmCoords)
   where -- Project vertices onto s/t plane.
         coords      = [ ((v `pSub` worldOrigin) `dot` vector) + offset  | QEdge v _ <- fEdges ]
         mini        = minimum coords
         maxi        = maximum coords

         -- On some cards texture coordinates are represented by *very* few bits
         -- (14 on 3Dfx?), so we try to keep texture coordinates small by subtracting
         -- the integer part of the average of min and max. Using the integer part of
         -- the real average is a recommended technique, but this should not make a
         -- big difference in practice.
         fSize       = (fromIntegral size)::Qfloat
         fTruncate x = fromIntegral ((truncate x)::Int)
         intAverage  = fTruncate ((maxi + mini) / (2 * fSize))
         texCoords   = [ x / fSize - intAverage | x <- coords ]
		 
         -- The light map is sampled every 16 texels.
         mini16      = floor   (mini / 16)
         maxi16      = ceiling (maxi / 16)
         lmSize      = maxi16 - mini16 + 1
         -- OpenGL restriction
         lmTexSize   = nextPowerOf2 lmSize

         -- A lot of frustration has gone into the calculation of light map
         -- coordinates. The formula below is a  slightly rearranged answer
         -- from Ales Mlakar to my question in algorithms@3dgamedev.com.
         lmCoords = [ ((x / 16) - fromIntegral mini16 + 0.5) / fromIntegral lmTexSize | x <- coords ]

nextPowerOf2 :: (Num a, Ord a) => a -> a
nextPowerOf2 n = head . dropWhile (<n) . iterate (*2) $ 1

-- very wasteful... (e.g. 17*17 light map is put into 32*32 texture)
getLightMap :: GLsizei -> GLsizei -> GLsizei -> GLsizei -> Ptr GLubyte -> Int -> IO TextureName
getLightMap lmSSize lmSTexSize lmTSize lmTTexSize lightMaps lightOff = do
   let numTexels = fromIntegral (lmSSize    * lmTSize)
       numBytes  = fromIntegral (lmSTexSize * lmTTexSize)

   -- TODO: Replace with texSubImage2D?
   lightTexture <- mallocArray numBytes
   mapM_ (\((u,v),i) -> do val <- peekElemOff lightMaps (lightOff + i)
                           pokeElemOff lightTexture (u+v) (val :: GLubyte))
         (zip [ (u,v) | u <- [0, fromIntegral lmSTexSize .. numBytes - 1],
                        v <- [0 .. fromIntegral lmSSize - 1] ]
              [ 0 .. numTexels - 1])

   texName <- liftM head (genTextures 1)
   bindTexture Texture2d texName
   mapM_ (texParameter Texture2d) [ TextureWrap S Clamp,
                                    TextureWrap T Clamp,
                                    TextureFilters Linear Linear ]
   texImage2D Texture2d 0 Rgb' lmSTexSize lmTTexSize 0
              (PixelDescriptor Luminance UnsignedByte (castPtr lightTexture))
   free lightTexture
   return texName
