249 lines
8.7 KiB
Haskell
249 lines
8.7 KiB
Haskell
{-# LANGUAGE RankNTypes #-}
|
|
|
|
-- | Parser for IQM-Files
|
|
--
|
|
-- Assumes that the file is stored with 32-Bit-BigEndian-Ints
|
|
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.ByteString.Char8 (pack)
|
|
import Data.ByteString (split, null, ByteString)
|
|
import Data.ByteString.Unsafe (unsafeUseAsCString)
|
|
import qualified Data.ByteString as B
|
|
import Data.Word
|
|
import Data.Int
|
|
import Unsafe.Coerce
|
|
import Control.Monad.Trans.State
|
|
import Control.Monad.Trans.Class
|
|
import Control.Monad
|
|
import Foreign.Ptr
|
|
import Foreign.Marshal.Alloc
|
|
import Foreign.Marshal.Utils
|
|
|
|
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
|
|
|
|
-- | shorthand-function for parsing Word8 into Integrals
|
|
_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 Word16
|
|
_int16 = do
|
|
ret <- lift $ do
|
|
a <- anyWord8 :: Parser Word8
|
|
b <- anyWord8 :: Parser Word8
|
|
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
|
|
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
|
|
|
|
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")
|
|
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 = fromIntegral 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'
|
|
}
|
|
|
|
-- | Parser for Mesh-Structure
|
|
readMesh :: CParser IQMMesh
|
|
readMesh = do
|
|
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
|
|
, meshFirstVertex = fv
|
|
, meshNumVertexes = nv
|
|
, meshFirstTriangle = ft
|
|
, meshNumTriangles = nt
|
|
}
|
|
|
|
-- | helper to read n consecutive Meshes tail-recursive
|
|
readMeshes :: Int -> CParser [IQMMesh]
|
|
readMeshes 1 = do
|
|
m <- readMesh
|
|
return [m]
|
|
readMeshes n = do
|
|
m <- readMesh
|
|
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 nullPtr
|
|
|
|
-- | 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
|
|
|
|
infix 5 .-
|
|
|
|
-- | skips (=drops) all input until the internal counter is at a given bytecount
|
|
--
|
|
-- Fails the parser if given bytecount is lower than the internal counter as we
|
|
-- read sequentially and do not do backtracking
|
|
skipToCounter :: Integral a => a -> CParser ()
|
|
skipToCounter a = do
|
|
let d = fromIntegral a
|
|
c <- get
|
|
when (d < c) $ fail "wanting to skip to counter already passed"
|
|
_ <- lift $ take $ d .- c
|
|
put d
|
|
|
|
-- | Parses an IQM-File and handles back the Haskell-Structure
|
|
parseIQM :: String -> IO IQM
|
|
parseIQM a =
|
|
do
|
|
f <- B.readFile a
|
|
putStrLn "Before Parse:"
|
|
putStrLn $ show f
|
|
putStrLn "Real Parse:"
|
|
r <- return $ parse doIQMparse f
|
|
raw <- case r of
|
|
Done _ x -> return x
|
|
y -> error $ show y
|
|
let ret = raw
|
|
return ret
|
|
|
|
readInVAO :: IQMVertexArray -> ByteString -> IO IQMVertexArray
|
|
readInVAO (IQMVertexArray type' a format num offset ptr) d =
|
|
do
|
|
let
|
|
byteLen = (fromIntegral num)*(vaSize format)
|
|
data' = skipDrop (fromIntegral offset) byteLen d
|
|
|
|
when (not (ptr == nullPtr)) $ error $ "Error reading Vertex-Array: Double Read of " ++ show type'
|
|
p <- mallocBytes byteLen
|
|
unsafeUseAsCString data' (\s -> copyBytes p s byteLen)
|
|
p' <- unsafeCoerce p
|
|
return (IQMVertexArray type' a format num offset p')
|
|
|
|
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 --skip 0-n bytes to get to Vertex-Arrays
|
|
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
|