{-Curves.hs; Mun Hon Cheong (mhch295@cse.unsw.edu.au) 2005

This modules is used to generate a biquadratic patch used in the
Q3Map2 format.

The code for this was translated from

http://graphics.cs.brown.edu/games/quake/quake3.html

it can also be found in the source code for Paul's Quake 3 BSP loader

http://www.paulsprojects.net/opengl/q3bsp/q3bsp.html

-}


module Curves (checkForPatch, BSPPatch(..)) where

import Foreign hiding (newArray)
import Data.Array.IArray
-- import Data.Array.MArray (newArray)
import Data.Array.IO
import Graphics.UI.GLUT (GLint, GLsizei)
import Foreign.Storable


data BSPPatch = BSPPatch {
           patchLOD    :: Int,               -- the level of tesselation
           patchPtr    :: Ptr Float,         -- points to patch vertices
           indexPtrPtr :: Ptr (Ptr GLint),  -- points to indices
           numIndexPtr :: Ptr GLsizei       -- the number of indices
           } deriving Show


-- given a face type return a list of patches if the facetype is 2.
-- Otherwise return an empty list.
checkForPatch :: Int -> Int -> (Int, Int) ->
   (Ptr Float, Ptr Float, Ptr Float,Ptr Float, Ptr Word8)
          -> IO [BSPPatch]
checkForPatch faceType startVIndex (width,height) vertData
   |faceType == 2 = do
          patches <- createPatches vertData startVIndex width height 4
          return patches
   |otherwise = return []


-- Create control points for each patch.
-- Each patch has 9 control points.
getControlPointIndices :: Int -> Int -> Int -> [Int]
getControlPointIndices  i width height =
   concat [(create3x3ControlPoints x y)|
                    y <-[0..(((height-1) `div` 2)-1)],
                    x <-[0..(((width-1)  `div` 2)-1)]]
   where
         create3x3ControlPoints x y =
            [(i+((y*2*width)+(x*2))+(row*width)+point) |
                   row   <- [0..2],
                   point <- [0..2]]


-- Take a list of control points and split them into lists of 9
splitControlPoints :: [VertTup] -> [[VertTup]]
splitControlPoints [] = []
splitControlPoints tups = (take 9 tups):(splitControlPoints $ drop 9 tups)


-- gets the control points
getControlPoints  :: (Ptr Float, Ptr Float, Ptr Float, Ptr Float, Ptr Word8) ->
   Int -> Int -> Int -> IO [Array Int VertTup]
getControlPoints vertexData startIndex width height = do
   -- get the indices for the control points
   let indcs = getControlPointIndices  startIndex width  height
   -- get the vertices at those indices
   controlPoints <- mapM (readControlPoints vertexData) indcs
   -- divide the lists into arrays of 9 control points
   return $ map (listArray (0,8)) (splitControlPoints controlPoints)

-- reads the control point information from the vertex arrays
readControlPoints :: (Ptr Float, Ptr Float, Ptr Float,Ptr Float, Ptr Word8) ->
   Int -> IO VertTup
readControlPoints  (vert, uv, lmuv, _, _) i = do
   x   <- peekElemOff vert  vertIndex     -- vertex coord
   y   <- peekElemOff vert (vertIndex+1)
   z   <- peekElemOff vert (vertIndex+2)
   u   <- peekElemOff uv    uvIndex       -- tex coord
   v   <- peekElemOff uv   (uvIndex+1)
   lmu <- peekElemOff lmuv  lmIndex       -- lightmap coord
   lmv <- peekElemOff lmuv (lmIndex+1)
   return (x,y,z,u,v,lmu,lmv)
   where
         vertIndex = i*3
         uvIndex         = i*2
         lmIndex         = i*2


-- write the coordinate, texture coordinate and lightmap coordinates
-- for the cntrol points
writeControlPointData :: [VertTup] -> Int -> Ptr Float -> IO ()
writeControlPointData  [] _ _ = return()
writeControlPointData  ((a,b,c,d,e,f,g):rest) indx ptr = do
   let i = (indx*7)
   pokeElemOff ptr i       a
   pokeElemOff ptr (i+1) b
   pokeElemOff ptr (i+2) c
   pokeElemOff ptr (i+3) d
   pokeElemOff ptr (i+4) e
   pokeElemOff ptr (i+5) f
   pokeElemOff ptr (i+6) g
   writeControlPointData rest (indx+1) ptr

type VertTup = (Float,Float,Float,Float,Float,Float,Float)

-- multiplies a set of floats by n
mul7 :: VertTup -> Float -> VertTup
mul7 (a,b,c,d,e,f,g) n = ((n*a),(n*b),(n*c),(n*d),(n*e),(n*f),(n*g))


-- adds to sets of floats together
add7 :: VertTup -> VertTup -> VertTup
add7 (u1,u2,u3,u4,u5,u6,u7) (v1,v2,v3,v4,v5,v6,v7) =
            (u1+v1,u2+v2,u3+v3,u4+v4,u5+v5,u6+v6,u7+v7)


-- create a set of patches
createPatches :: (Ptr Float, Ptr Float, Ptr Float, Ptr Float, Ptr Word8) ->
   Int -> Int -> Int -> Int -> IO [BSPPatch]
createPatches vertData startVert width height tesselation = do
   controlPoints <- getControlPoints vertData startVert width height
   patches <- mapM (createPatch tesselation) controlPoints
   return patches


createPatch :: Int -> Array Int VertTup -> IO BSPPatch
createPatch tesselation controlPoints  = do
   ptr <- mallocBytes (((tesselation+1)*(tesselation+1))*28)
   createPatch' tesselation ptr controlPoints
   createPatch'' tesselation ptr controlPoints
   (numiptr,iptrptr)<- generateIndices tesselation
   return (BSPPatch {
                    patchLOD = tesselation,
                    patchPtr = ptr,
                    indexPtrPtr = iptrptr,
                    numIndexPtr = numiptr
                 })


createPatch' ::Int ->  Ptr Float -> Array Int VertTup -> IO()
createPatch' tess ptr arr = do
   let patchVerts = map (bezier tess (arr!0) (arr!3) (arr!6)) [0..tess]
   writeControlPointData patchVerts 0 ptr


createPatch'' ::Int ->  Ptr Float -> Array Int VertTup -> IO()
createPatch'' tess ptr arr = do
   mapM_        (createPatch''' tess ptr arr) [1..tess]


createPatch''' ::Int -> Ptr Float -> Array Int VertTup -> Int -> IO()
createPatch''' tess ptr arr u = do
   let tup1 = bezier tess (arr!0) (arr!1) (arr!2) u
   let tup2 = bezier tess (arr!3) (arr!4) (arr!5) u
   let tup3 = bezier tess (arr!6) (arr!7) (arr!8) u
   let patchVerts = map (bezier tess tup1 tup2 tup3) [0..tess]
   writeControlPointData patchVerts 0 (plusPtr ptr (((tess+1)*u)*28))


bezier :: Int -> VertTup -> VertTup -> VertTup -> Int -> VertTup
bezier tes cp1 cp2 cp3 i = add7 (add7 d1 d2) d3
   where
         d1 = mul7 cp1 ((1-p)*(1-p))
         d2 = mul7 cp2 ((1-p)*p*2)
         d3 = mul7 cp3 (p*p)
         p  = (realToFrac i)/(realToFrac tes)


-- generate indices
generateIndices :: Int -> IO (Ptr GLsizei, Ptr (Ptr GLint))
generateIndices tess = do
   indexArray <- newArray (0,((tess*(tess+1)*2)-1)) 0
   let pt1 = [ ((((row*(tess+1))+point)*2)+1, fromIntegral ((row*(tess+1))+point)) |
                         row<-[0..(tess-1)],
                         point<-[0..tess]]
   let pt2 = [ ((((row*(tess+1))+point)*2), fromIntegral (((row+1)*(tess+1))+point)) |
                         row<-[0..(tess-1)],
                         point<-[0..tess]]
   mapM_ (writeIndices indexArray) pt1
   mapM_ (writeIndices indexArray) pt2
   indexList <- (getElems indexArray)
   indexPtr <- mallocBytes ((tess * (tess+1)*2) * (sizeOf (undefined :: GLint)))
   pokeArray indexPtr indexList
   numArrayIndicesPtr <- mallocBytes (tess * (sizeOf (undefined :: GLsizei)))
   pokeArray numArrayIndicesPtr (map (\_->(fromIntegral (2*(tess+1)))) [0..(tess-1)])
   indexptrptr <- mallocBytes (tess * (sizeOf (undefined :: Ptr GLint)))
   let ptrPtr = map (plusPtr indexPtr) [((sizeOf (undefined :: GLint)) * (row*2*(tess+1))) | row <-[0..(tess-1)]]
   pokeArray indexptrptr ptrPtr
   return (numArrayIndicesPtr, indexptrptr)


-- writes the indices to memory
writeIndices :: IOUArray Int GLint -> (Int,GLint) -> IO ()
writeIndices indcs (pos,content) = writeArray indcs pos content