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

Merge branch 'iqm' into tessallation

Browse Source 
Conflicts:
	Pioneers.cabal
	src/Map/StaticMaps.hs
This commit is contained in:
Stefan Dresselhaus
2014-04-25 21:25:16 +02:00
parent ca831692d2 64d542adf3
commit 782c30a6d5
5 changed files with 361 additions and 111 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8,8 +8,11 @@ module Importer.IQM.Parser (parseIQM) where
import Importer.IQM.Types
import Data.Attoparsec.ByteString.Char8
import Data.Attoparsec.ByteString
import Data.Attoparsec.Binary
import Data.Attoparsec (parse, takeByteString)
import Data.ByteString.Char8 (pack)
import Data.ByteString (split, null)
import Data.ByteString (split, null, ByteString)
import qualified Data.ByteString as B
import Data.Word
import Data.Int
import Unsafe.Coerce
@ -20,72 +23,80 @@ import Control.Monad
import Prelude as P hiding (take, null)
-- | helper-function for creating an integral out of [8-Bit Ints]
w8ToInt :: Integral a => a -> a -> a
w8ToInt i add = 256*i + add
_w8ToInt :: Integral a => a -> a -> a
_w8ToInt i add = 256*i + add
-- | shorthand-function for parsing Word8 into Integrals
parseNum :: (Integral a, Integral b) => [a] -> b
parseNum = (foldl1 w8ToInt) . map fromIntegral
_parseNum :: (Integral a, Integral b) => [a] -> b
_parseNum = foldl1 _w8ToInt . map fromIntegral
-- | read a 16-Bit Int from Parsing-Input and log 2 bytes in our Parsing-Monad
--
-- begins with _ to defeat ghc-warnings. Rename if used!
_int16 :: CParser Int16
_int16 :: CParser Word16
_int16 = do
ret <- lift $ do
a <- anyWord8 :: Parser Word8
b <- anyWord8 :: Parser Word8
return $ parseNum [b,a]
return $ _parseNum [b,a]
modify (+2)
return ret
-- | read a 32-Bit Int from Parsing-Input and log 4 bytes in our Parsing-Monad
int32 :: CParser Int32
int32 = do
_int32 :: CParser Int32
_int32 = do
ret <- lift $ do
a <- anyWord8 :: Parser Word8
b <- anyWord8 :: Parser Word8
c <- anyWord8 :: Parser Word8
d <- anyWord8 :: Parser Word8
return $ parseNum [d,c,b,a]
return $ _parseNum [d,c,b,a]
modify (+4)
return $ ret
return ret
w32leCParser :: CParser Word32
w32leCParser = do
ret <- lift anyWord32le
modify (+4)
return ret
-- | Parser for the header
readHeader :: CParser IQMHeader
readHeader = do
_ <- lift $ string (pack "INTERQUAKEMODEL\0")
v <- int32
-- when v /= 2 then --TODO: error something
size' <- int32
flags' <- int32
num_text' <- int32
ofs_text' <- int32
num_meshes' <- int32
ofs_meshes' <- int32
num_vertexarrays' <- int32
num_vertexes' <- int32
ofs_vertexarrays' <- int32
num_triangles' <- int32
ofs_triangles' <- int32
ofs_adjacency' <- int32
num_joints' <- int32
ofs_joints' <- int32
num_poses' <- int32
ofs_poses' <- int32
num_anims' <- int32
ofs_anims' <- int32
num_frames' <- int32
num_framechannels' <- int32
ofs_frames' <- int32
ofs_bounds' <- int32
num_comment' <- int32
ofs_comment' <- int32
num_extensions' <- int32
ofs_extensions' <- int32
modify (+16)
v <- w32leCParser
lift $ when (v /= 2) $ fail "Version /= 2.\nThis Parser only supports Version 2 of the InterQuake-Model IQM"
-- when v /= 2 then fail parsing.
size' <- w32leCParser
flags' <- w32leCParser
num_text' <- w32leCParser
ofs_text' <- w32leCParser
num_meshes' <- w32leCParser
ofs_meshes' <- w32leCParser
num_vertexarrays' <- w32leCParser
num_vertexes' <- w32leCParser
ofs_vertexarrays' <- w32leCParser
num_triangles' <- w32leCParser
ofs_triangles' <- w32leCParser
ofs_adjacency' <- w32leCParser
num_joints' <- w32leCParser
ofs_joints' <- w32leCParser
num_poses' <- w32leCParser
ofs_poses' <- w32leCParser
num_anims' <- w32leCParser
ofs_anims' <- w32leCParser
num_frames' <- w32leCParser
num_framechannels' <- w32leCParser
ofs_frames' <- w32leCParser
ofs_bounds' <- w32leCParser
num_comment' <- w32leCParser
ofs_comment' <- w32leCParser
num_extensions' <- w32leCParser
ofs_extensions' <- w32leCParser
return IQMHeader { version = v
, filesize = size'
, flags = flags'
, flags = fromIntegral flags'
, num_text = num_text'
, ofs_text = ofs_text'
, num_meshes = num_meshes'
@ -115,12 +126,12 @@ readHeader = do
-- | Parser for Mesh-Structure
readMesh :: CParser IQMMesh
readMesh = do
name <- int32
mat <- int32
fv <- int32
nv <- int32
ft <- int32
nt <- int32
name <- w32leCParser
mat <- w32leCParser
fv <- w32leCParser
nv <- w32leCParser
ft <- w32leCParser
nt <- w32leCParser
return IQMMesh
{ meshName = if name == 0 then Nothing else Just (Mesh name)
, meshMaterial = mat
@ -140,12 +151,32 @@ readMeshes n = do
ms <- readMeshes (n-1)
return $ m:ms
-- | Parser for Mesh-Structure
readVAF :: CParser IQMVertexArray
readVAF = do
vat <- rawEnumToVAT =<< w32leCParser
flags' <- w32leCParser
format <- rawEnumToVAF =<< w32leCParser
size <- w32leCParser
offset <- w32leCParser
return $ IQMVertexArray vat (fromIntegral flags') format (fromIntegral size) offset
-- | helper to read n consecutive Meshes tail-recursive
readVAFs :: Int -> CParser [IQMVertexArray]
readVAFs 1 = do
f <- readVAF
return [f]
readVAFs n = do
f <- readVAF
fs <- readVAFs (n-1)
return $ f:fs
-- | helper-Notation for subtracting 2 integral values of different kind in the precision
-- of the target-kind
(.-) :: forall a a1 a2.
(Num a, Integral a2, Integral a1) =>
a1 -> a2 -> a
(.-) a b = (fromIntegral a) - (fromIntegral b)
(.-) a b = fromIntegral a - fromIntegral b
infix 5 .-
@ -162,18 +193,35 @@ skipToCounter a = do
put d
-- | Parses an IQM-File and handles back the Haskell-Structure
parseIQM :: CParser IQM
parseIQM = do
put 0 --start at offset 0
h <- readHeader --read header
skipToCounter $ ofs_text h --skip 0-n bytes to get to text
text <- lift . take . fromIntegral $ num_text h --read texts
modify . (+) . fromIntegral $ num_text h --put offset forward
skipToCounter $ ofs_meshes h --skip 0-n bytes to get to meshes
meshes' <- readMeshes (fromIntegral (num_meshes h)) --read meshes
return IQM
{ header = h
, texts = filter (not.null) (split (unsafeCoerce '\0') text)
, meshes = meshes'
}
parseIQM :: String -> IO IQM
parseIQM a =
do
f <- B.readFile a
Done _ raw <- return $ parse doIQMparse f
let ret = raw
return ret
doIQMparse :: Parser IQM
doIQMparse =
flip evalStateT 0 $ --evaluate parser with state starting at 0
do
h <- readHeader --read header
skipToCounter $ ofs_text h --skip 0-n bytes to get to text
text <- lift . take . fromIntegral $ num_text h --read texts
modify . (+) . fromIntegral $ num_text h --put offset forward
skipToCounter $ ofs_meshes h --skip 0-n bytes to get to meshes
meshes' <- readMeshes $ fromIntegral $ num_meshes h --read meshes
skipToCounter $ ofs_vertexarrays h
vaf <- readVAFs $ fromIntegral $ num_vertexarrays h --read Vertex-Arrays
_ <- lift takeByteString
return IQM
{ header = h
, texts = filter (not.null) (split (unsafeCoerce '\0') text)
, meshes = meshes'
, vertexArrays = vaf
}
skipDrop :: Int -> Int -> ByteString -> ByteString
skipDrop a b= B.drop b . B.take a

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

@ -1,19 +1,28 @@
-- | Int32 or Int64 - depending on implementation. Format just specifies "uint".
-- 4-Byte in the documentation indicates Int32 - but not specified!
{-# LANGUAGE BangPatterns #-}
-- | Word32 or Word64 - depending on implementation. Format just specifies "uint".
-- 4-Byte in the documentation indicates Word32 - but not specified!
module Importer.IQM.Types where
import Control.Monad.Trans.State.Lazy (StateT)
import Data.Int
import Data.Word
import Data.ByteString
import Data.Attoparsec.ByteString.Char8
import Control.Monad.Trans.State.Lazy (StateT)
import Foreign.Ptr
import Graphics.Rendering.OpenGL.Raw.Types
import Prelude as P
-- | Mesh-Indices to distinguish the meshes referenced
newtype Mesh = Mesh Int32 deriving (Show, Eq)
newtype Mesh = Mesh Word32 deriving (Show, Eq)
-- | State-Wrapped Parser-Monad which is capable of counting the
-- Bytes read for offset-gap reasons
type CParser a = StateT Int64 Parser a
type Flags = GLbitfield -- ^ Alias for UInt32
type Offset = Word32 -- ^ Alias for UInt32
type Index = GLuint -- ^ Alias for UInt32
type NumComponents = GLsizei -- ^ Alias for UInt32
type IQMData = Ptr IQMVertexArrayFormat
-- | Header of IQM-Format.
--
@ -23,33 +32,33 @@ type CParser a = StateT Int64 Parser a
--
-- ofs_* fields are aligned at 4-byte-boundaries
data IQMHeader = IQMHeader
{ version :: Int32 -- ^ Must be 2
, filesize :: Int32
, flags :: Int32
, num_text :: Int32
, ofs_text :: Int32
, num_meshes :: Int32
, ofs_meshes :: Int32
, num_vertexarrays :: Int32
, num_vertexes :: Int32
, ofs_vertexarrays :: Int32
, num_triangles :: Int32
, ofs_triangles :: Int32
, ofs_adjacency :: Int32
, num_joints :: Int32
, ofs_joints :: Int32
, num_poses :: Int32
, ofs_poses :: Int32
, num_anims :: Int32
, ofs_anims :: Int32
, num_frames :: Int32
, num_framechannels :: Int32
, ofs_frames :: Int32
, ofs_bounds :: Int32
, num_comment :: Int32
, ofs_comment :: Int32
, num_extensions :: Int32 -- ^ stored as linked list, not as array.
, ofs_extensions :: Int32
{ version :: !Word32 -- ^ Must be 2
, filesize :: !Word32
, flags :: !Flags
, num_text :: !Word32
, ofs_text :: !Offset
, num_meshes :: !Word32
, ofs_meshes :: !Offset
, num_vertexarrays :: !Word32
, num_vertexes :: !Word32
, ofs_vertexarrays :: !Offset
, num_triangles :: !Word32
, ofs_triangles :: !Offset
, ofs_adjacency :: !Offset
, num_joints :: !Word32
, ofs_joints :: !Offset
, num_poses :: !Word32
, ofs_poses :: !Offset
, num_anims :: !Word32
, ofs_anims :: !Offset
, num_frames :: !Word32
, num_framechannels :: !Word32
, ofs_frames :: !Offset
, ofs_bounds :: !Offset
, num_comment :: !Word32
, ofs_comment :: !Offset
, num_extensions :: !Word32 -- ^ stored as linked list, not as array.
, ofs_extensions :: !Offset
} deriving (Show, Eq)
-- | Format of an IQM-Mesh Structure.
@ -57,13 +66,29 @@ data IQMHeader = IQMHeader
-- Read it like a Header of the Meshes lateron in the Format
data IQMMesh = IQMMesh
{ meshName :: Maybe Mesh
, meshMaterial :: Int32
, meshFirstVertex :: Int32
, meshNumVertexes :: Int32
, meshFirstTriangle :: Int32
, meshNumTriangles :: Int32
, meshMaterial :: Word32
, meshFirstVertex :: Word32
, meshNumVertexes :: Word32
, meshFirstTriangle :: Word32
, meshNumTriangles :: Word32
} deriving (Show, Eq)
-- | Format of IQM-Triangle Structure
data IQMTriangle = IQMTriangle VertexIndex VertexIndex VertexIndex
-- | Type-Alias for Word32 indicating an index on vertices in IQMMesh
type VertexIndex = Word32
-- | Type-Alias for Word32 indicating an index on IQMTriangle
type TriangleIndex = Word32
-- | From the IQM-Format-Description:
--
-- each value is the index of the adjacent triangle for edge 0, 1, and 2, where ~0 (= -1)
-- indicates no adjacent triangle indexes are relative to the iqmheader.ofs_triangles array
-- and span all meshes, where 0 is the first triangle, 1 is the second, 2 is the third, etc.
data IQMAdjacency = IQMAdjacency TriangleIndex TriangleIndex TriangleIndex
-- | Format of a whole IQM-File
--
-- still unfinished!
@ -71,5 +96,82 @@ data IQM = IQM
{ header :: IQMHeader
, texts :: [ByteString]
, meshes :: [IQMMesh]
, vertexArrays :: [IQMVertexArray]
} deriving (Show, Eq)
-- | Different Vertex-Array-Types in IQM
--
-- Custom Types have to be > 0x10 as of specification
data IQMVertexArrayType = IQMPosition
| IQMTexCoord
| IQMNormal
| IQMTangent
| IQMBlendIndexes
| IQMBlendWeights
| IQMColor
| IQMCustomVAT Word32
deriving (Show, Eq)
-- | Lookup-Function for internal enum to VertexArrayFormat
rawEnumToVAT :: Word32 -> CParser IQMVertexArrayType
rawEnumToVAT 0 = return IQMPosition
rawEnumToVAT 1 = return IQMTexCoord
rawEnumToVAT 2 = return IQMNormal
rawEnumToVAT 3 = return IQMTangent
rawEnumToVAT 4 = return IQMBlendIndexes
rawEnumToVAT 5 = return IQMBlendWeights
rawEnumToVAT 6 = return IQMColor
rawEnumToVAT a = return $ IQMCustomVAT a
-- | Vetrex-Array-Format of the data found at offset
data IQMVertexArrayFormat = IQMbyte
| IQMubyte
| IQMshort
| IQMushort
| IQMint
| IQMuint
| IQMhalf
| IQMfloat
| IQMdouble
-- | Unknown Word32
deriving (Show, Eq)
-- | Lookup-Function for internal enum to VertexArrayFormat
rawEnumToVAF :: Word32 -> CParser IQMVertexArrayFormat
rawEnumToVAF 0 = return IQMbyte
rawEnumToVAF 1 = return IQMubyte
rawEnumToVAF 2 = return IQMshort
rawEnumToVAF 3 = return IQMushort
rawEnumToVAF 4 = return IQMint
rawEnumToVAF 5 = return IQMuint
rawEnumToVAF 6 = return IQMhalf
rawEnumToVAF 7 = return IQMfloat
rawEnumToVAF 8 = return IQMdouble
--rawEnumToVAF a = return $ Unknown a
rawEnumToVAF a = fail $ P.concat ["unrecognized enum(",show a,") in VertexArrayFormat"]
-- | A Vertex-Array-Definiton.
--
-- The Vertex starts at Offset and has num_vertexes * NumComponents entries.
--
-- All Vertex-Arrays seem to have the same number of components, just differ in Type, Format
-- and Flags
data IQMVertexArray = IQMVertexArray
IQMVertexArrayType
Flags
IQMVertexArrayFormat
NumComponents
Offset
deriving (Eq)
instance Show IQMVertexArray where
show (IQMVertexArray t fl fo nc off) = "IQMVertexArray (Type: " ++ show t ++
", Flags: " ++ show fl ++
", Format: " ++ show fo ++
", NumComponents: " ++ show nc ++
", Offset: " ++ show off ++
")"

17
src/Main.hs
View File

@ -16,7 +16,6 @@ import Control.Concurrent.STM (TQueue,
newTQueueIO)
import Control.Monad.RWS.Strict (ask, evalRWST, get, liftIO, modify)
import Control.Monad.Trans.State (evalStateT)
import Data.Functor ((<$>))
import Data.Monoid (mappend)
@ -46,17 +45,21 @@ import UI.Callbacks
import Map.Graphics
import Types
import Importer.IQM.Parser
import Data.Attoparsec.Char8 (parseTest)
import qualified Data.ByteString as B
--import Data.Attoparsec.Char8 (parseTest)
--import qualified Data.ByteString as B
-- import qualified Debug.Trace as D (trace)
--------------------------------------------------------------------------------
testParser :: IO ()
testParser = do
f <- B.readFile "sample.iqm"
parseTest (evalStateT parseIQM 0) f
testParser :: String -> IO ()
testParser a = putStrLn . show =<< parseIQM a
{-do
f <- B.readFile a
putStrLn "reading in:"
putStrLn $ show f
putStrLn "parsed:"
parseTest parseIQM f-}
--------------------------------------------------------------------------------