rewrote Parser
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:
parent
6104e7349b
commit
b0e78033e5
@ -1,98 +1,108 @@
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module Importer.IQM.Parser where
|
||||
|
||||
import Importer.IQM.Types
|
||||
import Data.Attoparsec.ByteString.Char8
|
||||
import Data.Attoparsec.ByteString
|
||||
import Data.Attoparsec
|
||||
import Data.ByteString.Char8 (pack)
|
||||
import Data.ByteString (split, null)
|
||||
import Data.Word
|
||||
import Data.Int
|
||||
import Data.List (foldl1)
|
||||
import Foreign.C.Types
|
||||
import Unsafe.Coerce
|
||||
import Control.Monad.Trans.State
|
||||
import Control.Monad.Trans.Class
|
||||
import Control.Monad
|
||||
|
||||
import Prelude as P hiding (take, null)
|
||||
|
||||
w8Toint :: Integral a => a -> a -> a
|
||||
w8Toint i add = 256*i + add
|
||||
w8ToInt :: Integral a => a -> a -> a
|
||||
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
|
||||
ret <- lift $ do
|
||||
a <- 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
|
||||
ret <- lift $ do
|
||||
a <- anyWord8 :: Parser Word8
|
||||
b <- anyWord8 :: Parser Word8
|
||||
c <- 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
|
||||
string (pack "INTERQUAKEMODEL\0")
|
||||
_ <- 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
|
||||
return (IQMHeader { version = v
|
||||
, filesize = size
|
||||
, flags = flags
|
||||
, num_text = num_text
|
||||
, ofs_text = ofs_text
|
||||
, num_meshes = num_meshes
|
||||
, ofs_meshes = ofs_meshes
|
||||
, num_vertexarrays = num_vertexarrays
|
||||
, num_vertexes = num_vertexes
|
||||
, ofs_vertexarrays = ofs_vertexarrays
|
||||
, num_triangles = num_triangles
|
||||
, ofs_triangles = ofs_triangles
|
||||
, ofs_adjacency = ofs_adjacency
|
||||
, num_joints = num_joints
|
||||
, ofs_joints = ofs_joints
|
||||
, num_poses = num_poses
|
||||
, ofs_poses = ofs_poses
|
||||
, num_anims = num_anims
|
||||
, ofs_anims = ofs_anims
|
||||
, num_frames = num_frames
|
||||
, num_framechannels = num_framechannels
|
||||
, ofs_frames = ofs_frames
|
||||
, ofs_bounds = ofs_bounds
|
||||
, num_comment = num_comment
|
||||
, ofs_comment = ofs_comment
|
||||
, num_extensions = num_extensions
|
||||
, ofs_extensions = ofs_extensions
|
||||
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
|
||||
return IQMHeader { version = v
|
||||
, filesize = size'
|
||||
, flags = flags'
|
||||
, num_text = num_text'
|
||||
, ofs_text = ofs_text'
|
||||
, num_meshes = num_meshes'
|
||||
, ofs_meshes = ofs_meshes'
|
||||
, num_vertexarrays = num_vertexarrays'
|
||||
, num_vertexes = num_vertexes'
|
||||
, ofs_vertexarrays = ofs_vertexarrays'
|
||||
, num_triangles = num_triangles'
|
||||
, ofs_triangles = ofs_triangles'
|
||||
, ofs_adjacency = ofs_adjacency'
|
||||
, num_joints = num_joints'
|
||||
, ofs_joints = ofs_joints'
|
||||
, num_poses = num_poses'
|
||||
, ofs_poses = ofs_poses'
|
||||
, num_anims = num_anims'
|
||||
, ofs_anims = ofs_anims'
|
||||
, num_frames = num_frames'
|
||||
, num_framechannels = num_framechannels'
|
||||
, ofs_frames = ofs_frames'
|
||||
, ofs_bounds = ofs_bounds'
|
||||
, num_comment = num_comment'
|
||||
, ofs_comment = ofs_comment'
|
||||
, num_extensions = num_extensions'
|
||||
, ofs_extensions = ofs_extensions'
|
||||
}
|
||||
, 16+27*4)
|
||||
|
||||
readMesh :: Parser IQMMesh
|
||||
readMesh :: CParser IQMMesh
|
||||
readMesh = do
|
||||
name <- int32
|
||||
mat <- int32
|
||||
@ -109,7 +119,7 @@ readMesh = do
|
||||
, meshNumTriangles = nt
|
||||
}
|
||||
|
||||
readMeshes :: Int -> Parser [IQMMesh]
|
||||
readMeshes :: Int -> CParser [IQMMesh]
|
||||
readMeshes 1 = do
|
||||
m <- readMesh
|
||||
return [m]
|
||||
@ -118,15 +128,26 @@ readMeshes n = do
|
||||
ms <- readMeshes (n-1)
|
||||
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
|
||||
(h,soFar) <- readHeader
|
||||
take $ (fromIntegral (ofs_text h)) - soFar
|
||||
text <- take $ fromIntegral $ num_text h
|
||||
meshes <- readMeshes (fromIntegral (num_meshes h))
|
||||
put 0
|
||||
h <- readHeader
|
||||
soFar <- get
|
||||
_ <- 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
|
||||
{ header = h
|
||||
, texts = filter (not.null) (split (unsafeCoerce '\0') text)
|
||||
, meshes = meshes
|
||||
, meshes = meshes'
|
||||
}
|
||||
|
||||
@ -2,9 +2,11 @@ module Importer.IQM.Types where
|
||||
|
||||
import Data.Int
|
||||
import Data.ByteString
|
||||
import Data.Attoparsec.ByteString.Char8
|
||||
import Control.Monad.Trans.State.Lazy (StateT)
|
||||
|
||||
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".
|
||||
-- 4-Byte indicates Int32
|
||||
|
||||
@ -22,6 +22,8 @@ import Control.Concurrent.STM (TQueue,
|
||||
import Control.Monad.RWS.Strict (RWST, ask, asks,
|
||||
evalRWST, get, liftIO,
|
||||
modify, put)
|
||||
import Control.Monad.Trans.Class
|
||||
import Control.Monad.Trans.State (evalStateT)
|
||||
import Data.Distributive (distribute, collect)
|
||||
|
||||
-- FFI
|
||||
@ -70,8 +72,10 @@ import qualified Debug.Trace as D (trace)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
testParser :: IO ()
|
||||
testParser = do
|
||||
B.readFile "sample.iqm" >>= parseTest parseIQM
|
||||
f <- B.readFile "sample.iqm"
|
||||
parseTest (evalStateT parseIQM 0) f
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user