added ArrayBufferObject for TriangleIndex
This commit is contained in:
parent
c9ef745a72
commit
40c0e3ef00
@ -19,6 +19,7 @@ import Graphics.Rendering.OpenGL.GL.BufferObjects
|
|||||||
import Graphics.Rendering.OpenGL.GL.VertexArrays
|
import Graphics.Rendering.OpenGL.GL.VertexArrays
|
||||||
import Graphics.Rendering.OpenGL.GL.VertexArrayObjects
|
import Graphics.Rendering.OpenGL.GL.VertexArrayObjects
|
||||||
import Graphics.Rendering.OpenGL.GL.VertexSpec
|
import Graphics.Rendering.OpenGL.GL.VertexSpec
|
||||||
|
import Graphics.Rendering.OpenGL.GL.ObjectName
|
||||||
import Data.Word
|
import Data.Word
|
||||||
import Data.Int
|
import Data.Int
|
||||||
import Unsafe.Coerce
|
import Unsafe.Coerce
|
||||||
@ -213,8 +214,9 @@ parseIQM a =
|
|||||||
do
|
do
|
||||||
f <- B.readFile a
|
f <- B.readFile a
|
||||||
vao <- makeVAO (return ())
|
vao <- makeVAO (return ())
|
||||||
|
tbo <- genObjectName
|
||||||
-- Parse Headers/Offsets
|
-- Parse Headers/Offsets
|
||||||
let result = parse (doIQMparse vao) f
|
let result = parse (doIQMparse vao tbo) f
|
||||||
raw <- case result of
|
raw <- case result of
|
||||||
Done _ x -> return x
|
Done _ x -> return x
|
||||||
y -> error $ show y
|
y -> error $ show y
|
||||||
@ -222,7 +224,7 @@ parseIQM a =
|
|||||||
let va = vertexArrays raw
|
let va = vertexArrays raw
|
||||||
va' <- mapM (readInVAO f (num_vertexes.header $ raw)) va
|
va' <- mapM (readInVAO f (num_vertexes.header $ raw)) va
|
||||||
vbo <- mapM toVBOfromVAO va
|
vbo <- mapM toVBOfromVAO va
|
||||||
tris <- copyTriangles raw f
|
(tris, trisbo) <- copyTriangles raw f
|
||||||
withVAO vao $ createVAO (zip va' vbo)
|
withVAO vao $ createVAO (zip va' vbo)
|
||||||
putStrLn "Triangles:"
|
putStrLn "Triangles:"
|
||||||
printPtrAsWord32Array tris ((*3).fromIntegral.num_triangles.header $ raw) 3
|
printPtrAsWord32Array tris ((*3).fromIntegral.num_triangles.header $ raw) 3
|
||||||
@ -232,6 +234,7 @@ parseIQM a =
|
|||||||
, vertexBufferObjects = vbo
|
, vertexBufferObjects = vbo
|
||||||
, vertexArrayObject = vao
|
, vertexArrayObject = vao
|
||||||
, triangles = tris
|
, triangles = tris
|
||||||
|
, triangleBufferObject = trisbo
|
||||||
}
|
}
|
||||||
|
|
||||||
createVAO :: [(IQMVertexArray, BufferObject)] -> IO ()
|
createVAO :: [(IQMVertexArray, BufferObject)] -> IO ()
|
||||||
@ -251,16 +254,20 @@ initVAO l t bo = do
|
|||||||
vertexAttribArray l $= Enabled
|
vertexAttribArray l $= Enabled
|
||||||
vertexAttribPointer l $= (ToFloat, VertexArrayDescriptor num Float 0 nullPtr)
|
vertexAttribPointer l $= (ToFloat, VertexArrayDescriptor num Float 0 nullPtr)
|
||||||
|
|
||||||
copyTriangles :: IQM -> ByteString -> IO (Ptr Word32)
|
copyTriangles :: IQM -> ByteString -> IO (Ptr Word32, BufferObject)
|
||||||
copyTriangles i f =
|
copyTriangles i f =
|
||||||
do
|
do
|
||||||
let
|
let
|
||||||
len = fromIntegral $ num_triangles $ header i
|
len = fromIntegral $ num_triangles $ header i
|
||||||
byteLen = len * 3 * sizeOf (undefined :: Word32)
|
byteLen = len * 3 * sizeOf (undefined :: Word32)
|
||||||
data' = skipDrop (fromIntegral $ ofs_triangles $ header i) byteLen f
|
data' = skipDrop (fromIntegral $ ofs_triangles $ header i) byteLen f
|
||||||
|
buf = triangleBufferObject i
|
||||||
p <- mallocBytes byteLen
|
p <- mallocBytes byteLen
|
||||||
unsafeUseAsCString data' (\s -> copyBytes p s byteLen)
|
unsafeUseAsCString data' (\s -> copyBytes p s byteLen)
|
||||||
return $ castPtr p
|
bindBuffer ElementArrayBuffer $= Just buf
|
||||||
|
bufferData ElementArrayBuffer $= (fromIntegral len*3, p, StaticDraw)
|
||||||
|
bindBuffer ElementArrayBuffer $= Nothing
|
||||||
|
return $ (castPtr p, buf)
|
||||||
|
|
||||||
|
|
||||||
-- | Creates a BufferObject on the Graphicscard for each BufferObject
|
-- | Creates a BufferObject on the Graphicscard for each BufferObject
|
||||||
@ -309,8 +316,8 @@ readInVAO d vcount (IQMVertexArray type' a format num offset ptr) =
|
|||||||
--
|
--
|
||||||
-- Consumes the String only once, thus in O(n). But all Data-Structures are
|
-- Consumes the String only once, thus in O(n). But all Data-Structures are
|
||||||
-- not allocated and copied. readInVAO has to be called on each one.
|
-- not allocated and copied. readInVAO has to be called on each one.
|
||||||
doIQMparse :: VertexArrayObject -> Parser IQM
|
doIQMparse :: VertexArrayObject -> BufferObject -> Parser IQM
|
||||||
doIQMparse vao =
|
doIQMparse vao tbo =
|
||||||
flip evalStateT 0 $ --evaluate parser with state starting at 0
|
flip evalStateT 0 $ --evaluate parser with state starting at 0
|
||||||
do
|
do
|
||||||
h <- readHeader --read header
|
h <- readHeader --read header
|
||||||
@ -329,6 +336,7 @@ doIQMparse vao =
|
|||||||
, vertexBufferObjects = [] --initialized later, after vaf get allocated.
|
, vertexBufferObjects = [] --initialized later, after vaf get allocated.
|
||||||
, vertexArrayObject = vao
|
, vertexArrayObject = vao
|
||||||
, triangles = nullPtr --initialized later, after memory gets allocated.
|
, triangles = nullPtr --initialized later, after memory gets allocated.
|
||||||
|
, triangleBufferObject = tbo
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Helper-Function for Extracting a random substring out of a Bytestring
|
-- | Helper-Function for Extracting a random substring out of a Bytestring
|
||||||
|
@ -113,6 +113,7 @@ data IQM = IQM
|
|||||||
, vertexBufferObjects :: [BufferObject]
|
, vertexBufferObjects :: [BufferObject]
|
||||||
, vertexArrayObject :: VertexArrayObject
|
, vertexArrayObject :: VertexArrayObject
|
||||||
, triangles :: Ptr Word32
|
, triangles :: Ptr Word32
|
||||||
|
, triangleBufferObject :: BufferObject
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
-- | Different Vertex-Array-Types in IQM
|
-- | Different Vertex-Array-Types in IQM
|
||||||
|
@ -15,7 +15,7 @@ import qualified Control.Monad.RWS.Strict as RWS (get)
|
|||||||
import Control.Concurrent.STM (readTVarIO)
|
import Control.Concurrent.STM (readTVarIO)
|
||||||
import Data.Distributive (distribute, collect)
|
import Data.Distributive (distribute, collect)
|
||||||
-- FFI
|
-- FFI
|
||||||
import Foreign (Ptr, castPtr, with)
|
import Foreign (Ptr, castPtr, with, nullPtr)
|
||||||
import Foreign.C (CFloat)
|
import Foreign.C (CFloat)
|
||||||
|
|
||||||
import Map.Graphics
|
import Map.Graphics
|
||||||
@ -286,9 +286,11 @@ initRendering = do
|
|||||||
renderIQM :: IQM -> L.V3 CFloat -> L.V3 CFloat -> IO ()
|
renderIQM :: IQM -> L.V3 CFloat -> L.V3 CFloat -> IO ()
|
||||||
renderIQM m p@(L.V3 x y z) s@(L.V3 sx sy sz) = do
|
renderIQM m p@(L.V3 x y z) s@(L.V3 sx sy sz) = do
|
||||||
bindVertexArrayObject $= Just (vertexArrayObject m)
|
bindVertexArrayObject $= Just (vertexArrayObject m)
|
||||||
|
vertexAttribArray (AttribLocation 0) $= Enabled
|
||||||
|
bindBuffer ElementArrayBuffer $= Just (triangleBufferObject m)
|
||||||
let n = fromIntegral.num_triangles.header $ m
|
let n = fromIntegral.num_triangles.header $ m
|
||||||
--print $ concat ["drawing ", show n," triangles"]
|
--print $ concat ["drawing ", show n," triangles"]
|
||||||
drawElements Triangles n UnsignedInt (triangles m)
|
drawElements Triangles n UnsignedInt nullPtr
|
||||||
checkError "drawing model"
|
checkError "drawing model"
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user