module Data.Obj3D.GL ( InterleavedObj
                     , interleavedArrayFormat
                     , indexArrayFormat
                     , interleaveObj
                     , makeInterleavedArrays
                     , bindInterleavedArrays
                     , drawObject
                     , GLuint
                     , ForeignPtr
                     ) where

import Data.Obj3D

import Control.Arrow
import Control.Monad.State
import Data.Function (on)
import Data.List (genericIndex, sortBy)
import Data.Maybe
import Graphics.Rendering.OpenGL.GL (GLfloat, GLuint)
import Graphics.Rendering.OpenGL.GL.BeginEnd (PrimitiveMode(..))
import Graphics.Rendering.OpenGL.GL.VertexArrays (DataType(..), InterleavedArrays(..), interleavedArrays, drawElements)
import Foreign.ForeignPtr
import Foreign.Marshal.Array (pokeArray)
import Foreign.Ptr
import Foreign.Storable

import qualified Data.Map as M


data InterleavedObj = InterleavedObj
    { texCoordS :: GLfloat
    , texCoordT :: GLfloat
    , normalX   :: GLfloat
    , normalY   :: GLfloat
    , normalZ   :: GLfloat
    , vertexX   :: GLfloat
    , vertexY   :: GLfloat
    , vertexZ   :: GLfloat
    } deriving Show

instance Storable InterleavedObj where
    sizeOf _ = 8 * sizeOf (undefined :: GLfloat)
    alignment _ = alignment (undefined :: GLfloat)
    
    peek _ = fail "Can't read InterleavedObj"
    
    poke ptr obj = pokeArray (castPtr ptr) $ map ($ obj) [texCoordS, texCoordT, normalX, normalY, normalZ, vertexX, vertexY, vertexZ]

interleavedArrayFormat :: InterleavedArrays
interleavedArrayFormat = T2fN3fV3f

indexArrayFormat :: DataType
indexArrayFormat = UnsignedInt


type Interleaver a = State (Integer, M.Map FaceVertex Integer) a


getIndex :: FaceVertex -> Interleaver Integer
getIndex v = do
  ix <- gets $ M.lookup v . snd
  case ix of
    Just i  -> return i
    Nothing -> do
               i <- gets $ fst
               modify $ (+1) *** (M.insert v i)
               return i

makeVertexData :: ObjModel -> FaceVertex -> InterleavedObj
makeVertexData model (v, t, n) = InterleavedObj ts tt nx ny nz vx vy vz
    where
      (vx, vy, vz) = genericIndex (objVertices model) v
      (ts, tt) = if isJust t then genericIndex (objTexCoords model) $ fromJust t else (0, 0)
      (nx, ny, nz) = if isJust n then genericIndex (objNormals model) $ fromJust n else (0, 0, 0)


interleaveObj :: ObjModel -> ([InterleavedObj], [[Integer]])
interleaveObj model = evalState interleaveObj' (0, M.empty)
    where
      interleaveObj' :: Interleaver ([InterleavedObj], [[Integer]])
      interleaveObj' = do
        indices <- forM (objFaces model) $ mapM getIndex . concatMap (\(v1, v2, v3) -> [v1, v2, v3])
        
        packedVertices <- gets $ map fst . sortBy (compare `on` snd) . M.toList . snd
        
        return (map (makeVertexData model) packedVertices, indices)

makeInterleavedArrays :: ObjModel -> IO (ForeignPtr InterleavedObj, [(ForeignPtr GLuint, Int)])
makeInterleavedArrays model = do
  let (vertexdata, indices) = interleaveObj model
  
  interleavedptr <- mallocForeignPtrArray $ length vertexdata
  withForeignPtr interleavedptr $ \ptr -> pokeArray ptr vertexdata
  
  indexptrs <- forM indices $ \objindices -> do
                                indexptr <- mallocForeignPtrArray $ length objindices
                                withForeignPtr indexptr $ \ptr -> pokeArray ptr $ map fromIntegral objindices
                                return (indexptr, length objindices)
  
  return (interleavedptr, indexptrs)

bindInterleavedArrays :: ForeignPtr InterleavedObj -> IO ()
bindInterleavedArrays obj = withForeignPtr obj $ interleavedArrays interleavedArrayFormat 0

drawObject :: ForeignPtr GLuint -> Int -> IO ()
drawObject buf l = withForeignPtr buf $ drawElements Triangles (fromIntegral l) indexArrayFormat