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
|
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
|
||||||
a <- anyWord8 :: Parser Word8
|
ret <- lift $ do
|
||||||
b <- anyWord8 :: Parser Word8
|
a <- anyWord8 :: Parser Word8
|
||||||
return $ foldl1 w8Toint $ map fromIntegral [b,a]
|
b <- anyWord8 :: Parser Word8
|
||||||
|
return $ parseNum [b,a]
|
||||||
int32 :: Parser Int32
|
modify (+2)
|
||||||
|
return ret
|
||||||
|
|
||||||
|
int32 :: CParser Int32
|
||||||
int32 = do
|
int32 = do
|
||||||
a <- anyWord8 :: Parser Word8
|
ret <- lift $ do
|
||||||
b <- anyWord8 :: Parser Word8
|
a <- anyWord8 :: Parser Word8
|
||||||
c <- anyWord8 :: Parser Word8
|
b <- anyWord8 :: Parser Word8
|
||||||
d <- anyWord8 :: Parser Word8
|
c <- anyWord8 :: Parser Word8
|
||||||
return $ foldl1 w8Toint $ map fromIntegral [d,c,b,a]
|
d <- anyWord8 :: Parser Word8
|
||||||
|
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]
|
||||||
@ -117,16 +127,27 @@ readMeshes n = do
|
|||||||
m <- readMesh
|
m <- readMesh
|
||||||
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'
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -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
|
||||||
@ -57,4 +59,4 @@ data IQM = IQM
|
|||||||
, texts :: [ByteString]
|
, texts :: [ByteString]
|
||||||
, meshes :: [IQMMesh]
|
, meshes :: [IQMMesh]
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user