module Data.Obj3D.OpenGL ( Interleaved
                         , InterleavedObj
                         , interleavedArrayFormat
                         , indexArrayFormat
                         , interleaveObj
                         , makeInterleavedArrays
                         , bindInterleavedArrays
                         , drawObject
                         ) 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 Interleaved = Interleaved
    { texCoordS :: GLfloat
    , texCoordT :: GLfloat
    , normalX   :: GLfloat
    , normalY   :: GLfloat
    , normalZ   :: GLfloat
    , vertexX   :: GLfloat
    , vertexY   :: GLfloat
    , vertexZ   :: GLfloat
    } deriving Show

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

type InterleavedObj = (ForeignPtr Interleaved, [(ForeignPtr GLuint, Int)])

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

interleavedArrayFormat :: InterleavedArrays
interleavedArrayFormat = T2fN3fV3f

indexArrayFormat :: DataType
indexArrayFormat = UnsignedInt

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 -> Interleaved
makeVertexData model (v, t, n) = Interleaved tu (-tv) nx ny nz vx vy vz
    where
      (vx, vy, vz) = rtf3 $ genericIndex (objVertices model) v
      (tu, tv) = rtf2 $ if isJust t then genericIndex (objTexCoords model) $ fromJust t else (0, 0)
      (nx, ny, nz) = rtf3 $ if isJust n then genericIndex (objNormals model) $ fromJust n else (0, 0, 0)
      rtf2 (x, y) = (realToFrac x, realToFrac y)
      rtf3 (x, y, z) = (realToFrac x, realToFrac y, realToFrac z)


interleaveObj :: ObjModel -> ([Interleaved], [[Integer]])
interleaveObj model = evalState interleaveObj' (0, M.empty)
    where
      interleaveObj' :: Interleaver ([Interleaved], [[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 InterleavedObj
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 :: InterleavedObj -> IO ()
bindInterleavedArrays (obj, _) = withForeignPtr obj $ interleavedArrays interleavedArrayFormat 0

drawObject :: InterleavedObj -> Int -> IO ()
drawObject (_, bufs) i = withForeignPtr buf $ drawElements Triangles (fromIntegral l) indexArrayFormat
    where
      (buf, l) = bufs!!i