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

fixed bits & pieces here and there

Browse Source 
refs #482 @20m
refs #470 @15m
This commit is contained in:
Stefan Dresselhaus
2014-05-20 08:57:42 +02:00
parent cea71238f1
commit 9c33af543c
4 changed files with 28 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -268,16 +268,17 @@ toBufferTargetfromVAType _ = ArrayBuffer
-- is needed in term of computation.
readInVAO :: ByteString -> IQMVertexArray -> IO IQMVertexArray
readInVAO d (IQMVertexArray type' a format num offset ptr) =
do
let
byteLen = fromIntegral num * vaSize format
data' = skipDrop (fromIntegral offset) byteLen d
unless (ptr == nullPtr) $ error $ "Error reading Vertex-Array: Double Read of " ++ show type'
p <- mallocBytes byteLen
putStrLn $ concat ["Allocating ", show byteLen, " Bytes at ", show p]
unsafeUseAsCString data' (\s -> copyBytes p s byteLen)
return $ IQMVertexArray type' a format num offset $ castPtr p
do
let
byteLen = fromIntegral num * vaSize format
data' = skipDrop (fromIntegral offset) byteLen d
unless (ptr == nullPtr) $ error $ "Error reading Vertex-Array: Double Read of " ++ show type'
p <- mallocBytes byteLen
putStrLn $ concat ["Allocating ", show num,"x",show (vaSize format)," = ", show byteLen, " Bytes at ", show p, " for ", show type']
putStrLn $ concat ["Filling with: ", show data', " starting at ", show offset]
unsafeUseAsCString data' (\s -> copyBytes p s byteLen)
return $ IQMVertexArray type' a format num offset $ castPtr p
-- | Real internal Parser.
--
@@ -308,5 +309,8 @@ doIQMparse vao =
-- by the Offsets provided.
--
-- O(1).
skipDrop :: Int -> Int -> ByteString -> ByteString
skipDrop a b= B.drop b . B.take a
skipDrop :: Int -- ^ Bytes to drop
-> Int -- ^ Bytes to take
-> ByteString
-> ByteString
skipDrop a b= B.take b . B.drop a

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

@@ -194,7 +194,7 @@ data IQMVertexArray = IQMVertexArray
IQMVertexArrayFormat
NumComponents
Offset
IQMData
IQMData
deriving (Eq)
instance Show IQMVertexArray where
show (IQMVertexArray t fl fo nc off dat) = "IQMVertexArray (Type: " ++ show t ++

18
src/Render/Render.hs
View File

@@ -180,8 +180,9 @@ initMapShader tessFac (buf, vertDes) = do
checkError "PositionOffset"
att' <- get (activeAttribs objProgram)
putStrLn $ unlines $ "Model-Attributes: ":map show att'
uni' <- get (activeUniforms objProgram)
putStrLn $ unlines $ "Model-Uniforms: ":map show uni'
putStrLn $ unlines $ ["Model-Indices: ", show (texIndex', normalIndex', vertexIndex')]
checkError "initShader"
let sdata = MapShaderData
@@ -285,9 +286,10 @@ 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)
glDrawArrays gl_TRIANGLES 0 3
return ()
bindVertexArrayObject $= Just (vertexArrayObject m)
let n = num_vertexes $ header m
glDrawArrays gl_TRIANGLES 0 (fromIntegral n)
return ()
renderObject :: MapObject -> IO ()
renderObject (MapObject model pos@(L.V3 x y z) _{-state-}) =
@@ -485,21 +487,15 @@ render = do
checkError "setting up shadowmap-program"
--set up projection (= copy from state)
--TODO: Fix width/depth
mat44ToGPU frust projmo "mapObjects-projection"
--set up camera
--TODO: Fix magic constants... and camPos
let ! cam = getCam camPos zDist' xa ya
mat44ToGPU cam vmatmo "mapObjects-cam"
--set up normal--Mat transpose((model*camera)^-1)
--needed?
--set up normal
let normal' = (case L.inv33 (fmap (^. L._xyz) cam ^. L._xyz) of
(Just a) -> a
Nothing -> L.eye3) :: L.M33 CFloat
nmap = collect id normal' :: L.M33 CFloat --transpose...
mat33ToGPU nmap nmatmo "mapObjects-nmat"
mapM_ renderObject (state ^. gl.glMap.mapObjects)