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

rewrote Parser

Browse Source 
now uses Parser a in Combination with StateT Int64 a yielding
type CParser a = StateT Int64 Parser a

So now the parser Counts how many Bytes get read. This can be
used by the get-function to get the currently read bytes.
This commit is contained in:
Nicole Dresselhaus 2014-04-15 06:43:49 +02:00
parent 6104e7349b
commit b0e78033e5
3 changed files with 111 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,98 +1,108 @@
{-# LANGUAGE RankNTypes #-}
module Importer.IQM.Parser where module Importer.IQM.Parser where
import Importer.IQM.Types import Importer.IQM.Types
import Data.Attoparsec.ByteString.Char8 import Data.Attoparsec.ByteString.Char8
import Data.Attoparsec.ByteString import Data.Attoparsec.ByteString
import Data.Attoparsec
import Data.ByteString.Char8 (pack) import Data.ByteString.Char8 (pack)
import Data.ByteString (split, null) import Data.ByteString (split, null)
import Data.Word import Data.Word
import Data.Int import Data.Int
import Data.List (foldl1)
import Foreign.C.Types
import Unsafe.Coerce import Unsafe.Coerce
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Control.Monad
import Prelude as P hiding (take, null) import Prelude as P hiding (take, null)
w8Toint :: Integral a => a -> a -> a w8ToInt :: Integral a => a -> a -> a
w8Toint i add = 256*i + add w8ToInt i add = 256*i + add
parseNum :: (Integral a, Integral b) => [a] -> b
parseNum = (foldl1 w8ToInt) . map fromIntegral
int16 :: Parser Int16 int16 :: CParser Int16
int16 = do int16 = do
ret <- lift $ do
a <- anyWord8 :: Parser Word8 a <- anyWord8 :: Parser Word8
b <- anyWord8 :: Parser Word8 b <- anyWord8 :: Parser Word8
return $ foldl1 w8Toint $ map fromIntegral [b,a] return $ parseNum [b,a]
modify (+2)
return ret
int32 :: Parser Int32 int32 :: CParser Int32
int32 = do int32 = do
ret <- lift $ do
a <- anyWord8 :: Parser Word8 a <- anyWord8 :: Parser Word8
b <- anyWord8 :: Parser Word8 b <- anyWord8 :: Parser Word8
c <- anyWord8 :: Parser Word8 c <- anyWord8 :: Parser Word8
d <- anyWord8 :: Parser Word8 d <- anyWord8 :: Parser Word8
return $ foldl1 w8Toint $ map fromIntegral [d,c,b,a] return $ parseNum [d,c,b,a]
modify (+4)
return $ ret
readHeader :: CParser IQMHeader
readHeader = do readHeader = do
string (pack "INTERQUAKEMODEL\0") _ <- lift $ string (pack "INTERQUAKEMODEL\0")
v <- int32 v <- int32
-- when v /= 2 then --TODO: error something -- when v /= 2 then --TODO: error something
size <- int32 size' <- int32
flags <- int32 flags' <- int32
num_text <- int32 num_text' <- int32
ofs_text <- int32 ofs_text' <- int32
num_meshes <- int32 num_meshes' <- int32
ofs_meshes <- int32 ofs_meshes' <- int32
num_vertexarrays <- int32 num_vertexarrays' <- int32
num_vertexes <- int32 num_vertexes' <- int32
ofs_vertexarrays <- int32 ofs_vertexarrays' <- int32
num_triangles <- int32 num_triangles' <- int32
ofs_triangles <- int32 ofs_triangles' <- int32
ofs_adjacency <- int32 ofs_adjacency' <- int32
num_joints <- int32 num_joints' <- int32
ofs_joints <- int32 ofs_joints' <- int32
num_poses <- int32 num_poses' <- int32
ofs_poses <- int32 ofs_poses' <- int32
num_anims <- int32 num_anims' <- int32
ofs_anims <- int32 ofs_anims' <- int32
num_frames <- int32 num_frames' <- int32
num_framechannels <- int32 num_framechannels' <- int32
ofs_frames <- int32 ofs_frames' <- int32
ofs_bounds <- int32 ofs_bounds' <- int32
num_comment <- int32 num_comment' <- int32
ofs_comment <- int32 ofs_comment' <- int32
num_extensions <- int32 num_extensions' <- int32
ofs_extensions <- int32 ofs_extensions' <- int32
return (IQMHeader { version = v return IQMHeader { version = v
, filesize = size , filesize = size'
, flags = flags , flags = flags'
, num_text = num_text , num_text = num_text'
, ofs_text = ofs_text , ofs_text = ofs_text'
, num_meshes = num_meshes , num_meshes = num_meshes'
, ofs_meshes = ofs_meshes , ofs_meshes = ofs_meshes'
, num_vertexarrays = num_vertexarrays , num_vertexarrays = num_vertexarrays'
, num_vertexes = num_vertexes , num_vertexes = num_vertexes'
, ofs_vertexarrays = ofs_vertexarrays , ofs_vertexarrays = ofs_vertexarrays'
, num_triangles = num_triangles , num_triangles = num_triangles'
, ofs_triangles = ofs_triangles , ofs_triangles = ofs_triangles'
, ofs_adjacency = ofs_adjacency , ofs_adjacency = ofs_adjacency'
, num_joints = num_joints , num_joints = num_joints'
, ofs_joints = ofs_joints , ofs_joints = ofs_joints'
, num_poses = num_poses , num_poses = num_poses'
, ofs_poses = ofs_poses , ofs_poses = ofs_poses'
, num_anims = num_anims , num_anims = num_anims'
, ofs_anims = ofs_anims , ofs_anims = ofs_anims'
, num_frames = num_frames , num_frames = num_frames'
, num_framechannels = num_framechannels , num_framechannels = num_framechannels'
, ofs_frames = ofs_frames , ofs_frames = ofs_frames'
, ofs_bounds = ofs_bounds , ofs_bounds = ofs_bounds'
, num_comment = num_comment , num_comment = num_comment'
, ofs_comment = ofs_comment , ofs_comment = ofs_comment'
, num_extensions = num_extensions , num_extensions = num_extensions'
, ofs_extensions = ofs_extensions , ofs_extensions = ofs_extensions'
} }
, 16+27*4)
readMesh :: Parser IQMMesh readMesh :: CParser IQMMesh
readMesh = do readMesh = do
name <- int32 name <- int32
mat <- int32 mat <- int32
@ -109,7 +119,7 @@ readMesh = do
, meshNumTriangles = nt , meshNumTriangles = nt
} }
readMeshes :: Int -> Parser [IQMMesh] readMeshes :: Int -> CParser [IQMMesh]
readMeshes 1 = do readMeshes 1 = do
m <- readMesh m <- readMesh
return [m] return [m]
@ -118,15 +128,26 @@ readMeshes n = do
ms <- readMeshes (n-1) ms <- readMeshes (n-1)
return $ m:ms return $ m:ms
parseIQM :: Parser IQM (.-) :: forall a a1 a2.
(Num a, Integral a2, Integral a1) =>
a1 -> a2 -> a
(.-) a b = (fromIntegral a) - (fromIntegral b)
infix 5 .-
parseIQM :: CParser IQM
parseIQM = do parseIQM = do
(h,soFar) <- readHeader put 0
take $ (fromIntegral (ofs_text h)) - soFar h <- readHeader
text <- take $ fromIntegral $ num_text h soFar <- get
meshes <- readMeshes (fromIntegral (num_meshes h)) _ <- lift $ take $ ofs_text h .- soFar
text <- lift $ take $ fromIntegral $ num_text h
soFar <- get
_ <- lift $ take $ ofs_meshes h .- soFar
meshes' <- readMeshes (fromIntegral (num_meshes h))
return IQM return IQM
{ header = h { header = h
, texts = filter (not.null) (split (unsafeCoerce '\0') text) , texts = filter (not.null) (split (unsafeCoerce '\0') text)
, meshes = meshes , meshes = meshes'
} }

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

@ -2,9 +2,11 @@ module Importer.IQM.Types where
import Data.Int import Data.Int
import Data.ByteString import Data.ByteString
import Data.Attoparsec.ByteString.Char8
import Control.Monad.Trans.State.Lazy (StateT)
newtype Mesh = Mesh Int32 deriving (Show, Eq) newtype Mesh = Mesh Int32 deriving (Show, Eq)
newtype CParser a = Parser (a, Int64) type CParser a = StateT Int64 Parser a
-- Int32 or Int64 - depending on implementation. Format just specifies "uint". -- Int32 or Int64 - depending on implementation. Format just specifies "uint".
-- 4-Byte indicates Int32 -- 4-Byte indicates Int32

6
src/Main.hs
View File

@ -22,6 +22,8 @@ import Control.Concurrent.STM (TQueue,
import Control.Monad.RWS.Strict (RWST, ask, asks, import Control.Monad.RWS.Strict (RWST, ask, asks,
evalRWST, get, liftIO, evalRWST, get, liftIO,
modify, put) modify, put)
import Control.Monad.Trans.Class
import Control.Monad.Trans.State (evalStateT)
import Data.Distributive (distribute, collect) import Data.Distributive (distribute, collect)
-- FFI -- FFI
@ -70,8 +72,10 @@ import qualified Debug.Trace as D (trace)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
testParser :: IO ()
testParser = do testParser = do
B.readFile "sample.iqm" >>= parseTest parseIQM f <- B.readFile "sample.iqm"
parseTest (evalStateT parseIQM 0) f
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------