diff --git a/src/Importer/IQM/Parser.hs b/src/Importer/IQM/Parser.hs index 09efd9a..932d0a2 100644 --- a/src/Importer/IQM/Parser.hs +++ b/src/Importer/IQM/Parser.hs @@ -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 - a <- anyWord8 :: Parser Word8 - b <- anyWord8 :: Parser Word8 - return $ foldl1 w8Toint $ map fromIntegral [b,a] - -int32 :: Parser Int32 + ret <- lift $ do + a <- anyWord8 :: Parser Word8 + b <- anyWord8 :: Parser Word8 + return $ parseNum [b,a] + modify (+2) + return ret + +int32 :: CParser Int32 int32 = 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] + 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] + 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] @@ -117,16 +127,27 @@ readMeshes n = do m <- readMesh 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' } - \ No newline at end of file + diff --git a/src/Importer/IQM/Types.hs b/src/Importer/IQM/Types.hs index 8222e85..7dabaf6 100644 --- a/src/Importer/IQM/Types.hs +++ b/src/Importer/IQM/Types.hs @@ -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 @@ -57,4 +59,4 @@ data IQM = IQM , texts :: [ByteString] , meshes :: [IQMMesh] } deriving (Show, Eq) - \ No newline at end of file + diff --git a/src/Main.hs b/src/Main.hs index a8283e4..4a32161 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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 --------------------------------------------------------------------------------