Drezil/pioneers
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

error is gone, object still not there.

Browse Source
This commit is contained in:
Stefan Dresselhaus
2014-08-24 16:39:29 +02:00
parent cb967df9c9
commit 95b108b0c4
2 changed files with 14 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
src/Importer/IQM/Parser.hs
View File

@@ -33,7 +33,7 @@ import Foreign.Storable (sizeOf)
import Prelude as P hiding (take, null) import Prelude as P hiding (take, null)
import Render.Misc (printPtrAsFloatArray, printPtrAsUByteArray, printPtrAsWord32Array, withVBO) import Render.Misc (printPtrAsFloatArray, printPtrAsUByteArray, printPtrAsWord32Array, withVBO, checkError)
-- | helper-function for creating an integral out of [8-Bit Ints] -- | helper-function for creating an integral out of [8-Bit Ints]
_w8ToInt :: Integral a => a -> a -> a _w8ToInt :: Integral a => a -> a -> a
@@ -229,13 +229,16 @@ parseIQM a =
let initBuffer :: AttribLocation -> IQMVertexArrayType -> [IQMVertexArray] -> IO () let initBuffer :: AttribLocation -> IQMVertexArrayType -> [IQMVertexArray] -> IO ()
initBuffer l t vas = initBuffer l t vas =
do do
let (IQMVertexArray _ _ _ num _ dat) = case filter (\(IQMVertexArray ty _ _ _ _ _) -> ty == t) vas of -- find array with type t, otherwise abort hard.
let (IQMVertexArray _ _ format num _ dat) = case filter (\(IQMVertexArray ty _ _ _ _ _) -> ty == t) vas of
[b] -> b [b] -> b
_ -> error $ "Current object does not support " ++ (show t) _ -> error $ "Current object does not support " ++ (show t)
buf <- genObjectName buf <- genObjectName
-- create buffer and write data
withVBO buf (toBufferTargetfromVAType t) $ do withVBO buf (toBufferTargetfromVAType t) $ do
-- copy data -- copy data
bufferData (toBufferTargetfromVAType t) $= ((fromIntegral num),dat,StaticDraw) bufferData (toBufferTargetfromVAType t) $= (fromIntegral num * (fromIntegral.vaSize) format,dat,StaticDraw)
checkError "bufferData vao"
-- tell layout -- tell layout
vertexAttribPointer l $= (ToFloat, VertexArrayDescriptor num Float 0 nullPtr) vertexAttribPointer l $= (ToFloat, VertexArrayDescriptor num Float 0 nullPtr)
initBuffer (AttribLocation 0) IQMPosition va' initBuffer (AttribLocation 0) IQMPosition va'
@@ -251,7 +254,9 @@ parseIQM a =
data' = skipDrop ((fromIntegral.ofs_triangles.bareheader) bare) byteLen f data' = skipDrop ((fromIntegral.ofs_triangles.bareheader) bare) byteLen f
p <- mallocBytes byteLen p <- mallocBytes byteLen
unsafeUseAsCString data' (\s -> copyBytes p s byteLen) unsafeUseAsCString data' (\s -> copyBytes p s byteLen)
bufferData ElementArrayBuffer $= (fromIntegral len*3, p, StaticDraw) withVBO tbo ElementArrayBuffer $ do
bufferData ElementArrayBuffer $= (fromIntegral byteLen, p, StaticDraw)
checkError "bufferData tris"
return $ castPtr p return $ castPtr p
putStrLn "Triangles:" putStrLn "Triangles:"
printPtrAsWord32Array tris ((*3).fromIntegral.num_triangles.bareheader $ bare) 3 printPtrAsWord32Array tris ((*3).fromIntegral.num_triangles.bareheader $ bare) 3

6
src/Render/Render.hs
View File

@@ -290,11 +290,15 @@ 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
withVAO (vertexArrayObject m) $ do withVAO (vertexArrayObject m) $ do
vertexAttribArray (AttribLocation 0) $= Enabled vertexAttribArray (AttribLocation 0) $= Enabled
checkError "setting array to enabled"
bindBuffer ElementArrayBuffer $= Just (triangleBufferObject m) bindBuffer ElementArrayBuffer $= Just (triangleBufferObject m)
checkError "bindBuffer"
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 nullPtr drawElements Triangles n UnsignedInt nullPtr
checkError "drawing model" checkError "drawing model"
bindBuffer ElementArrayBuffer $= Nothing
checkError "unbind buffer"
return () return ()
renderObject :: MapObject -> IO () renderObject :: MapObject -> IO ()