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

Merge branch 'rework_iqm' into tessallation

Browse Source
This commit is contained in:
Stefan Dresselhaus
2014-08-24 16:40:20 +02:00
parent e5b2a7d620 95b108b0c4
commit 53775c559d
5 changed files with 106 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -33,7 +33,7 @@ import Foreign.Storable (sizeOf)
import Prelude as P hiding (take, null)
import Render.Misc (printPtrAsFloatArray, printPtrAsUByteArray, printPtrAsWord32Array)
import Render.Misc (printPtrAsFloatArray, printPtrAsUByteArray, printPtrAsWord32Array, withVBO, checkError)
-- | helper-function for creating an integral out of [8-Bit Ints]
_w8ToInt :: Integral a => a -> a -> a
@@ -213,28 +213,63 @@ parseIQM :: String -> IO IQM
parseIQM a =
do
f <- B.readFile a
vao <- makeVAO (return ())
tbo <- genObjectName
-- Parse Headers/Offsets
let result = parse (doIQMparse vao tbo) f
raw <- case result of
-- Parse Headers/Offsets to BareIQM
let result = parse doIQMparse f
bare <- case result of
Done _ x -> return x
y -> error $ show y
-- Fill Vertex-Arrays with data of Offsets
let va = vertexArrays raw
va' <- mapM (readInVAO f (num_vertexes.header $ raw)) va
vbo <- mapM toVBOfromVAO va
(tris, trisbo) <- copyTriangles raw f
withVAO vao $ createVAO (zip va' vbo)
-- Fill Vertex-Array with buffer objects and data of Offsets
va' <- mapM (readInVAO f (num_vertexes.bareheader $ bare)) (barevertexArrays bare)
-- create VAO with attached vbos
vao <- makeVAO $ do
-- generate array buffers
--
--for pos,normal,tex:
let initBuffer :: AttribLocation -> IQMVertexArrayType -> [IQMVertexArray] -> IO ()
initBuffer l t vas =
do
-- find array with type t, otherwise abort hard.
let (IQMVertexArray _ _ format num _ dat) = case filter (\(IQMVertexArray ty _ _ _ _ _) -> ty == t) vas of
[b] -> b
_ -> error $ "Current object does not support " ++ (show t)
buf <- genObjectName
-- create buffer and write data
withVBO buf (toBufferTargetfromVAType t) $ do
-- copy data
bufferData (toBufferTargetfromVAType t) $= (fromIntegral num * (fromIntegral.vaSize) format,dat,StaticDraw)
checkError "bufferData vao"
-- tell layout
vertexAttribPointer l $= (ToFloat, VertexArrayDescriptor num Float 0 nullPtr)
initBuffer (AttribLocation 0) IQMPosition va'
initBuffer (AttribLocation 1) IQMNormal va'
initBuffer (AttribLocation 2) IQMTexCoord va'
-- for indices
tbo <- genObjectName
tris <- withVBO tbo ArrayBuffer $ do
let
len = (fromIntegral.num_triangles.bareheader) bare
byteLen = len * 3 * sizeOf (undefined :: Word32)
data' = skipDrop ((fromIntegral.ofs_triangles.bareheader) bare) byteLen f
p <- mallocBytes byteLen
unsafeUseAsCString data' (\s -> copyBytes p s byteLen)
withVBO tbo ElementArrayBuffer $ do
bufferData ElementArrayBuffer $= (fromIntegral byteLen, p, StaticDraw)
checkError "bufferData tris"
return $ castPtr p
putStrLn "Triangles:"
printPtrAsWord32Array tris ((*3).fromIntegral.num_triangles.header $ raw) 3
print raw
return $ raw
{ vertexArrays = va'
, vertexBufferObjects = vbo
, vertexArrayObject = vao
, triangles = tris
, triangleBufferObject = trisbo
printPtrAsWord32Array tris ((*3).fromIntegral.num_triangles.bareheader $ bare) 3
print bare
return $ IQM
{ header = bareheader bare
, texts = baretexts bare
, meshes = baremeshes bare
, vertexArrays = va'
, vertexBufferObjects = []
, vertexArrayObject = vao
, triangles = tris
, triangleBufferObject = tbo
}
createVAO :: [(IQMVertexArray, BufferObject)] -> IO ()
@@ -254,22 +289,6 @@ initVAO l t bo = do
vertexAttribArray l $= Enabled
vertexAttribPointer l $= (ToFloat, VertexArrayDescriptor num Float 0 nullPtr)
copyTriangles :: IQM -> ByteString -> IO (Ptr Word32, BufferObject)
copyTriangles i f =
do
let
len = fromIntegral $ num_triangles $ header i
byteLen = len * 3 * sizeOf (undefined :: Word32)
data' = skipDrop (fromIntegral $ ofs_triangles $ header i) byteLen f
buf = triangleBufferObject i
p <- mallocBytes byteLen
unsafeUseAsCString data' (\s -> copyBytes p s byteLen)
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
toVBOfromVAO :: IQMVertexArray -> IO BufferObject
@@ -316,8 +335,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
-- not allocated and copied. readInVAO has to be called on each one.
doIQMparse :: VertexArrayObject -> BufferObject -> Parser IQM
doIQMparse vao tbo =
doIQMparse :: Parser BareIQM
doIQMparse =
flip evalStateT 0 $ --evaluate parser with state starting at 0
do
h <- readHeader --read header
@@ -328,15 +347,11 @@ doIQMparse vao tbo =
meshes' <- readMeshes $ fromIntegral $ num_meshes h --read meshes
skipToCounter $ ofs_vertexarrays h --skip 0-n bytes to get to Vertex-Arrays
vaf <- readVAFs $ fromIntegral $ num_vertexarrays h --read Vertex-Arrays
return IQM
{ header = h
, texts = filter (not.null) (split (unsafeCoerce '\0') text)
, meshes = meshes'
, vertexArrays = vaf
, vertexBufferObjects = [] --initialized later, after vaf get allocated.
, vertexArrayObject = vao
, triangles = nullPtr --initialized later, after memory gets allocated.
, triangleBufferObject = tbo
return BareIQM
{ bareheader = h
, baretexts = filter (not.null) (split (unsafeCoerce '\0') text)
, baremeshes = meshes'
, barevertexArrays = vaf
}
-- | Helper-Function for Extracting a random substring out of a Bytestring

12
src/Importer/IQM/Types.hs
View File

@@ -116,6 +116,18 @@ data IQM = IQM
, triangleBufferObject :: BufferObject
} deriving (Show, Eq)
-- | Internal format of an unprocessed IQM
--
-- for internal and temporary use only
data BareIQM = BareIQM
{ bareheader :: IQMHeader
, baretexts :: [ByteString]
, baremeshes :: [IQMMesh]
, barevertexArrays :: [IQMVertexArray]
} deriving (Show, Eq)
-- | Different Vertex-Array-Types in IQM
--
-- Custom Types have to be > 0x10 as of specification

17
src/Render/Misc.hs
View File

@@ -8,6 +8,8 @@ import Graphics.Rendering.OpenGL.GL.Shaders
import Graphics.Rendering.OpenGL.GL.StateVar
import Graphics.Rendering.OpenGL.GL.StringQueries
import Graphics.Rendering.OpenGL.GLU.Errors
import Graphics.Rendering.OpenGL.GL.VertexArrayObjects
import Graphics.Rendering.OpenGL.GL.BufferObjects
import Graphics.UI.SDL.Types (Texture)
import System.IO (hPutStrLn, stderr)
import Linear
@@ -163,3 +165,18 @@ genColorData n c = take (length c*n) (cycle c)
chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf a xs = take a xs : chunksOf a (drop a xs)
withVAO :: VertexArrayObject -> IO a -> IO a
withVAO v a = do
bindVertexArrayObject $= Just v
ret <- a
bindVertexArrayObject $= Nothing
return ret
withVBO :: BufferObject -> BufferTarget -> IO a -> IO a
withVBO b t a = do
bindBuffer t $= Just b
ret <- a
bindBuffer t $= Nothing
return ret

21
src/Render/Render.hs
View File

@@ -184,6 +184,9 @@ initMapShader tessFac (buf, vertDes) = do
uni' <- get (activeUniforms objProgram)
putStrLn $ unlines $ "Model-Uniforms: ":map show uni'
putStrLn $ unlines $ ["Model-Indices: ", show (texIndex', normalIndex', vertexIndex')]
currentProgram $= Nothing
checkError "initShader"
let sdata = MapShaderData
{ shdrVertexIndex = vertexIndex
@@ -285,13 +288,17 @@ initRendering = do
-- | renders an IQM-Model at Position with scaling
renderIQM :: IQM -> L.V3 CFloat -> L.V3 CFloat -> IO ()
renderIQM m p@(L.V3 x y z) s@(L.V3 sx sy sz) = do
bindVertexArrayObject $= Just (vertexArrayObject m)
vertexAttribArray (AttribLocation 0) $= Enabled
bindBuffer ElementArrayBuffer $= Just (triangleBufferObject m)
let n = fromIntegral.num_triangles.header $ m
--print $ concat ["drawing ", show n," triangles"]
drawElements Triangles n UnsignedInt nullPtr
checkError "drawing model"
withVAO (vertexArrayObject m) $ do
vertexAttribArray (AttribLocation 0) $= Enabled
checkError "setting array to enabled"
bindBuffer ElementArrayBuffer $= Just (triangleBufferObject m)
checkError "bindBuffer"
let n = fromIntegral.num_triangles.header $ m
--print $ concat ["drawing ", show n," triangles"]
drawElements Triangles n UnsignedInt nullPtr
checkError "drawing model"
bindBuffer ElementArrayBuffer $= Nothing
checkError "unbind buffer"
return ()
renderObject :: MapObject -> IO ()