packages feed

immutaball-core-0.1.0.4.1: Immutaball/Share/Level/Parser.hs

{-# OPTIONS_GHC -fno-warn-tabs #-}  -- Support tab indentation better, for a better default of no warning if tabs are used: https://dmitryfrank.com/articles/indent_with_tabs_align_with_spaces .
-- Enable warnings:
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

-- Level/Parser.hs.

{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE ScopedTypeVariables, NondecreasingIndentation, ExistentialQuantification #-}

module Immutaball.Share.Level.Parser
	(
		-- * parsing
		parseLevelFile,
		levelFileParser,
		levelFileParser',
		parseByte,
		parsei32Native,
		parsei32BE,
		parsei32LE,
		parsef32dLE,
		parsen,
		parseCString,
		parseVec2fd,
		parseVec3fd,
		parseVec4fd,

		parseDict,
		parseMtrl,
		parseVert,
		parseEdge,
		parseSide,
		parseTexc,
		parseOffs,
		parseGeom,
		parseLump,
		parseNode,
		parsePath,
		parseBody,
		parseItem,
		parseGoal,
		parseJump,
		parseSwch,
		parseBill,
		parseBall,
		parseView,

		-- * optional low-level parsing
		unsafeParseLevelFileRaw,
		w32ToFloat,

		-- * exceptions
		LevelIBParseException(..),
		levelIBParseExceptionToException,
		levelIBParseExceptionFromException,
		UndersizedLevelIBParseException(..),
		MissingSOLMagicIBParseException(..),
		UnsupportedSOLVersionIBParseException(..),
		OversizedLevelIBParseException(..),
		ParseErrorLevelIBParseException(..)
	) where

import Prelude ()
import Immutaball.Prelude

import Control.Arrow
import Control.Exception
import Control.Lens
import Control.Monad
import Data.Bits
import Data.Coerce
import Data.Function hiding (id, (.))
import Data.Int
import Data.Typeable
import Data.Word
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
import Text.Printf

import Data.Array
import Data.Array.IArray as IA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified SDL.Raw.Enum as Raw
import Text.Parsec as P

import Immutaball.Share.Level.Base
import Immutaball.Share.Math
import Immutaball.Share.Utils

-- Low-level imports.
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString.Unsafe as UB

-- * optional low-level parsing

-- | Uses low-level memory management.
--
-- It does _some_ length checking but still does some memory reading without
-- checking for length of the input data (and only afterward reading).
--
-- We don't use this.
unsafeParseLevelFileRaw :: String -> BS.ByteString -> Either LevelIBParseException LevelIB
unsafeParseLevelFileRaw inputName inputContents
	| inputSize < lengthSolSize =
		Left . errSize $ "Error: parseLevelFile: the data string does not have enough data to read the header with lengths!"
	| otherwise = unsafePerformIO $
		UB.unsafeUseAsCString inputContents $ \inputPtr_ -> do
			let (inputPtr :: Ptr Sol) = castPtr inputPtr_
			(lengthSol :: Sol) <- peekSolLengths inputPtr

			-- Check magic.
			if' ((lengthSol^.solMagic)   /= solMagicConstant) (return . Left . errMagic   $ printf "Error: parseLevelFile: input ‘%s’ is missing the 4 SOL magic bytes.  Is it a SOL file?  0x%04X /= 0x%04X." inputName (lengthSol^.solMagic) solMagicConstant) $ do

			-- Check version.
			if' ((lengthSol^.solVersion) /= solVersionCurr)   (return . Left . errVersion $ printf "Error: parseLevelFile: SOL file input ‘%s’ has an unsupported version.  Its code %d /= %d." inputName (lengthSol^.solVersion) solVersionCurr) $ do

			-- Now we know the lengths, so we can calculate the size of the data we require.
			let neededSizeMin = sizeOfExistingSolMin lengthSol
			let neededSizeMax = sizeOfExistingSolMax lengthSol
			let actualSize = inputSize
			if' (actualSize < neededSizeMin) (return . Left . errSize $ printf "Error: parseLevelFile: we parsed the lengths, but the data is too small to parse the file: input ‘%s’ has size %d < %d" inputName inputSize neededSizeMin) $ do

			-- Also check for oversize.
			if' (actualSize > neededSizeMax) (return . Left . errBigSize $ printf "Error: parseLevelFile: we parsed the lengths, but the data is larger than expected: input ‘%s’ has size %d > %d; recommend aborting in case data is corrupted" inputName inputSize neededSizeMax) $ do

			-- Now parse the sol now that we validated the size.
			-- This is unsafe since we don't know if we have enough data, but we at least know we're somewhat within the bounds.
			sol <- peekSol inputPtr

			-- Now check the exact length.
			let neededSize = sizeOfExistingSol sol
			if' (actualSize < neededSize) (return . Left . errSize $ printf "Error: parseLevelFile: we parsed the lengths, but the data is too small to parse the file (exact size): input ‘%s’ has size %d < %d" inputName inputSize neededSize) $ do
			if' (actualSize > neededSize) (return . Left . errBigSize $ printf "Error: parseLevelFile: we parsed the lengths, but the data is larger than expected (exact size): input ‘%s’ has size %d > %d; recommend aborting in case data is corrupted" inputName inputSize neededSize) $ do

			-- Return our parsed Sol.
			return $ Right sol
	where
		lengthSolSize :: Int
		lengthSolSize = sizeOfEmptySol emptySol
		inputSize = BS.length inputContents
		errSize = LevelIBParseException . UndersizedLevelIBParseException
		errBigSize = LevelIBParseException . OversizedLevelIBParseException
		errMagic = LevelIBParseException . MissingSOLMagicIBParseException
		errVersion = LevelIBParseException . UnsupportedSOLVersionIBParseException

w32ToFloat :: Word32 -> Float
w32ToFloat w32 = unsafePerformIO $ do
	-- GHC doesn't support coerce between Word32 and Float.
	-- Just malloc a new cfloat.
	{-
	let (f32 :: Float)  = coerce w32
	-}
	(cfloat :: ForeignPtr CFloat) <- mallocForeignPtr
	(cf32 :: CFloat) <- withForeignPtr cfloat $ \cfloatPtr -> poke (castPtr cfloatPtr) w32 >> peek cfloatPtr
	let (f32 :: Float) = coerce cf32
	return f32

-- * exceptions

data LevelIBParseException = forall e. Exception e => LevelIBParseException e
instance Show LevelIBParseException where
	show (LevelIBParseException e) = show e
instance Exception LevelIBParseException
levelIBParseExceptionToException :: Exception e => e -> SomeException
levelIBParseExceptionToException = toException . LevelIBParseException
levelIBParseExceptionFromException :: Exception e => SomeException -> Maybe e
levelIBParseExceptionFromException x = do
	LevelIBParseException a <- fromException x
	cast a

-- | The input data was not big enough.
data UndersizedLevelIBParseException = UndersizedLevelIBParseException String
instance Exception UndersizedLevelIBParseException where
	toException = levelIBParseExceptionToException
	fromException = levelIBParseExceptionFromException
instance Show UndersizedLevelIBParseException where
	show (UndersizedLevelIBParseException msg) = msg

-- | The file does not start with the 4 SOL magic bytes.
data MissingSOLMagicIBParseException = MissingSOLMagicIBParseException String
instance Exception MissingSOLMagicIBParseException where
	toException = levelIBParseExceptionToException
	fromException = levelIBParseExceptionFromException
instance Show MissingSOLMagicIBParseException where
	show (MissingSOLMagicIBParseException msg) = msg

-- | The SOL version is not supported.
data UnsupportedSOLVersionIBParseException = UnsupportedSOLVersionIBParseException String
instance Exception UnsupportedSOLVersionIBParseException where
	toException = levelIBParseExceptionToException
	fromException = levelIBParseExceptionFromException
instance Show UnsupportedSOLVersionIBParseException where
	show (UnsupportedSOLVersionIBParseException msg) = msg

-- | The input data was bigger than expected.
data OversizedLevelIBParseException = OversizedLevelIBParseException String
instance Exception OversizedLevelIBParseException where
	toException = levelIBParseExceptionToException
	fromException = levelIBParseExceptionFromException
instance Show OversizedLevelIBParseException where
	show (OversizedLevelIBParseException msg) = msg

-- | The input data was bigger than expected.
data ParseErrorLevelIBParseException = ParseErrorLevelIBParseException ParseError
instance Exception ParseErrorLevelIBParseException where
	toException = levelIBParseExceptionToException
	fromException = levelIBParseExceptionFromException
instance Show ParseErrorLevelIBParseException where
	show (ParseErrorLevelIBParseException parseError) = show parseError

-- * parsing

parseLevelFile :: String -> BL.ByteString -> Either LevelIBParseException LevelIB
parseLevelFile inputName inputContents = LevelIBParseException . ParseErrorLevelIBParseException +++ id $ parse levelFileParser inputName inputContents

parseByte :: Parsec BL.ByteString () Word8
parseByte = truncateAsciiChar <$> anyChar
	& P.try <?> "parseByte expected a w8"
	where
		truncateAsciiChar :: Char -> Word8
		truncateAsciiChar = toEnum . fromEnum

parsei32Native :: Parsec BL.ByteString () Int32
parsei32Native = (<?> "parsei32Native expected an i32") . P.try $ do
	byte0_ <- parseByte
	byte1_ <- parseByte
	byte2_ <- parseByte
	byte3_ <- parseByte
	let (byte0, byte1, byte2, byte3) = if' (Raw.SDL_BYTEORDER == Raw.SDL_BIG_ENDIAN) (byte0_, byte1_, byte2_, byte3_) (byte3_, byte2_, byte1_, byte0_)
	let (w32 :: Word32) = ((fromIntegral byte0 `shiftL` 24) .|. (fromIntegral byte1 `shiftL` 16) .|. (fromIntegral byte2 `shiftL` 8) .|. (fromIntegral byte3 `shiftL` 0))
	let (i32 :: Int32)  = fromIntegral w32
	return $ i32

parsei32BE :: Parsec BL.ByteString () Int32
parsei32BE = (<?> "parsei32BE expected an i32") . P.try $ do
	byte0 <- parseByte
	byte1 <- parseByte
	byte2 <- parseByte
	byte3 <- parseByte
	let (w32 :: Word32) = ((fromIntegral byte0 `shiftL` 24) .|. (fromIntegral byte1 `shiftL` 16) .|. (fromIntegral byte2 `shiftL` 8) .|. (fromIntegral byte3 `shiftL` 0))
	let (i32 :: Int32)  = fromIntegral w32
	return $ i32

parsei32LE :: Parsec BL.ByteString () Int32
parsei32LE = (<?> "parsei32LE expected an i32") . P.try $ do
	byte3 <- parseByte
	byte2 <- parseByte
	byte1 <- parseByte
	byte0 <- parseByte
	let (w32 :: Word32) = ((fromIntegral byte0 `shiftL` 24) .|. (fromIntegral byte1 `shiftL` 16) .|. (fromIntegral byte2 `shiftL` 8) .|. (fromIntegral byte3 `shiftL` 0))
	let (i32 :: Int32)  = fromIntegral w32
	return $ i32

parsef32dLE :: Parsec BL.ByteString () Double
parsef32dLE = (<?> "parsef32dLE expected an f32") . P.try $ do
	byte3 <- parseByte
	byte2 <- parseByte
	byte1 <- parseByte
	byte0 <- parseByte
	let (w32 :: Word32) = ((fromIntegral byte0 `shiftL` 24) .|. (fromIntegral byte1 `shiftL` 16) .|. (fromIntegral byte2 `shiftL` 8) .|. (fromIntegral byte3 `shiftL` 0))
	let (fl  :: Float)  = w32ToFloat w32
	let (d   :: Double) = realToFrac fl
	return $ d

parsen :: forall a. Parsec BL.ByteString () a -> Int32 -> Parsec BL.ByteString () (Array Int32 a)
parsen parseElem n
	| n <= 0 = return emptyArray
	| otherwise = (<?> (printf "parsen _ %d expected an array" n)) . P.try $ do
		as <- flip fix 0 $ \me idx -> do
			if' (idx >= n) (return []) $ do
			a <- parseElem
			(a:) <$> me (idx+1)
		return $ IA.listArray (0, n-1) as
	where
		emptyArray :: Array Int32 a
		emptyArray = IA.listArray (0, -1) []

parseCString :: Int -> Parsec BL.ByteString () String
parseCString n
	| n <= 0 = return []
	| otherwise = (<?> (printf "parseCString %d expected a CString" n)) . P.try $ do
		cs <- (\me -> me 0 False) . fix $ \me idx isTerminated -> do
			if' (idx >= n) (return []) $ do
			b <- parseByte
			let c = asciiChar b
			if' (isTerminated || b == 0) (me (idx+1) True) $ do
			(c:) <$> me (idx+1) isTerminated
		let str = cs
		return $ str
	where
		asciiChar :: Word8 -> Char
		asciiChar = toEnum . fromEnum

parseVec2fd :: Parsec BL.ByteString () (Vec2 Double)
parseVec2fd = Vec2 <$> parsef32dLE <*> parsef32dLE
	& P.try <?> "parseVec2fd expected a Vec2f"

parseVec3fd :: Parsec BL.ByteString () (Vec3 Double)
parseVec3fd = Vec3 <$> parsef32dLE <*> parsef32dLE <*> parsef32dLE
	& P.try <?> "parseVec3fd expected a Vec3f"

parseVec4fd :: Parsec BL.ByteString () (Vec4 Double)
parseVec4fd = Vec4 <$> parsef32dLE <*> parsef32dLE <*> parsef32dLE <*> parsef32dLE
	& P.try <?> "parseVec4fd expected a Vec4f"

levelFileParser :: Parsec BL.ByteString () LevelIB
levelFileParser = levelFileParser' True

levelFileParser' :: Bool -> Parsec BL.ByteString () LevelIB
levelFileParser' isEof = (<?> "levelFileParser expected a sol") . P.try $ do
	magic   <- parsei32LE & P.try <?> "levelFileParser expected magic"
	when (magic   /= solMagicConstant) . unexpected $ printf "Error: levelFileParser: expected the 4 SOL starter bytes; found 0x%04X, /= 0x%04X" magic solMagicConstant
	version <- parsei32LE & P.try <?> "levelFileParser expected version"
	when (version /= solVersionCurr  ) . unexpected $ printf "Error: levelFileParser: unsupported SOL version; found %d, /= %d" version solVersionCurr

	ac <- parsei32LE & P.try <?> "levelFileParser expected ac"
	dc <- parsei32LE & P.try <?> "levelFileParser expected dc"
	mc <- parsei32LE & P.try <?> "levelFileParser expected mc"
	vc <- parsei32LE & P.try <?> "levelFileParser expected vc"
	ec <- parsei32LE & P.try <?> "levelFileParser expected ec"
	sc <- parsei32LE & P.try <?> "levelFileParser expected sc"
	tc <- parsei32LE & P.try <?> "levelFileParser expected tc"
	oc <- parsei32LE & P.try <?> "levelFileParser expected oc"
	gc <- parsei32LE & P.try <?> "levelFileParser expected gc"
	lc <- parsei32LE & P.try <?> "levelFileParser expected lc"
	nc <- parsei32LE & P.try <?> "levelFileParser expected nc"
	pc <- parsei32LE & P.try <?> "levelFileParser expected pc"
	bc <- parsei32LE & P.try <?> "levelFileParser expected bc"
	hc <- parsei32LE & P.try <?> "levelFileParser expected hc"
	zc <- parsei32LE & P.try <?> "levelFileParser expected zc"
	jc <- parsei32LE & P.try <?> "levelFileParser expected jc"
	xc <- parsei32LE & P.try <?> "levelFileParser expected xc"
	rc <- parsei32LE & P.try <?> "levelFileParser expected rc"
	uc <- parsei32LE & P.try <?> "levelFileParser expected uc"
	wc <- parsei32LE & P.try <?> "levelFileParser expected wc"
	ic <- parsei32LE & P.try <?> "levelFileParser expected ic"

	av <- parsen parseByte  ac & (fmap (coerce . (fromIntegral :: Word8 -> Int8)) <$>) & P.try <?> "levelFileParser expected av"
	dv <- parsen parseDict  dc & P.try <?> "levelFileParser expected dv"
	mv <- parsen parseMtrl  mc & P.try <?> "levelFileParser expected mv"
	vv <- parsen parseVert  vc & P.try <?> "levelFileParser expected vv"
	ev <- parsen parseEdge  ec & P.try <?> "levelFileParser expected ev"
	sv <- parsen parseSide  sc & P.try <?> "levelFileParser expected sv"
	tv <- parsen parseTexc  tc & P.try <?> "levelFileParser expected tv"
	ov <- parsen parseOffs  oc & P.try <?> "levelFileParser expected ov"
	gv <- parsen parseGeom  gc & P.try <?> "levelFileParser expected gv"
	lv <- parsen parseLump  lc & P.try <?> "levelFileParser expected lv"
	nv <- parsen parseNode  nc & P.try <?> "levelFileParser expected nv"
	pv <- parsen parsePath  pc & P.try <?> "levelFileParser expected pv"
	bv <- parsen parseBody  bc & P.try <?> "levelFileParser expected bv"
	hv <- parsen parseItem  hc & P.try <?> "levelFileParser expected hv"
	zv <- parsen parseGoal  zc & P.try <?> "levelFileParser expected zv"
	jv <- parsen parseJump  jc & P.try <?> "levelFileParser expected jv"
	xv <- parsen parseSwch  xc & P.try <?> "levelFileParser expected xv"
	rv <- parsen parseBill  rc & P.try <?> "levelFileParser expected rv"
	uv <- parsen parseBall  uc & P.try <?> "levelFileParser expected uv"
	wv <- parsen parseView  wc & P.try <?> "levelFileParser expected wv"
	iv <- parsen parsei32LE ic & P.try <?> "levelFileParser expected iv"

	if' isEof eof (pure ()) & P.try <?> "levelFileParser expected end of input."

	return $ Sol {
		_solMagic   = magic,
		_solVersion = version,

		_solAc = ac,
		_solDc = dc,
		_solMc = mc,
		_solVc = vc,
		_solEc = ec,
		_solSc = sc,
		_solTc = tc,
		_solOc = oc,
		_solGc = gc,
		_solLc = lc,
		_solNc = nc,
		_solPc = pc,
		_solBc = bc,
		_solHc = hc,
		_solZc = zc,
		_solJc = jc,
		_solXc = xc,
		_solRc = rc,
		_solUc = uc,
		_solWc = wc,
		_solIc = ic,

		_solAv = av,
		_solDv = dv,
		_solMv = mv,
		_solVv = vv,
		_solEv = ev,
		_solSv = sv,
		_solTv = tv,
		_solOv = ov,
		_solGv = gv,
		_solLv = lv,
		_solNv = nv,
		_solPv = pv,
		_solBv = bv,
		_solHv = hv,
		_solZv = zv,
		_solJv = jv,
		_solXv = xv,
		_solRv = rv,
		_solUv = uv,
		_solWv = wv,
		_solIv = iv
	}

parseDict :: Parsec BL.ByteString () Dict
parseDict = Dict <$> parsei32LE <*> parsei32LE
	& P.try <?> "parseDict expected a Dict"

parseMtrl :: Parsec BL.ByteString () Mtrl
parseMtrl = (<?> "parsePath expected a Path") . P.try $ do
	d <- parseVec4fd
	a <- parseVec4fd
	s <- parseVec4fd
	e <- parseVec4fd
	h <- parsef32dLE

	let angle = 0.0

	fl <- parsei32LE

	f <- parseCString solPathMax

	alphaFunc <- if' ((fl .&. mtrlFlagAlphaTest) /= 0) parsei32LE  (pure 0  )
	alphaRef  <- if' ((fl .&. mtrlFlagAlphaTest) /= 0) parsef32dLE (pure 0.0)

	return $ Mtrl {
		_mtrlD = d,
		_mtrlA = a,
		_mtrlS = s,
		_mtrlE = e,
		_mtrlH = h,

		_mtrlAngle = angle,

		_mtrlFl = fl,
		_mtrlF  = f,

		_mtrlAlphaFunc = alphaFunc,
		_mtrlAlphaRef  = alphaRef
	}

parseVert :: Parsec BL.ByteString () Vert
parseVert = Vert <$> parseVec3fd
	& P.try <?> "parseVert expected a Vert"

parseEdge :: Parsec BL.ByteString () Edge
parseEdge = Edge <$> parsei32LE <*> parsei32LE
	& P.try <?> "parseEdge expected an Edge"

parseSide :: Parsec BL.ByteString () Side
parseSide = Side <$> parseVec3fd <*> parsef32dLE
	& P.try <?> "parseSide expected a Side"

parseTexc :: Parsec BL.ByteString () Texc
parseTexc = Texc <$> parseVec2fd
	& P.try <?> "parseTexc expected a Texc"

parseOffs :: Parsec BL.ByteString () Offs
parseOffs = Offs <$> parsei32LE <*> parsei32LE <*> parsei32LE
	& P.try <?> "parseOffs expected an Offs"

parseGeom :: Parsec BL.ByteString () Geom
parseGeom = Geom <$> parsei32LE <*> parsei32LE <*> parsei32LE <*> parsei32LE
	& P.try <?> "parseGeom expected a Geom"

parseLump :: Parsec BL.ByteString () Lump
parseLump = Lump <$> parsei32LE <*> parsei32LE <*> parsei32LE <*> parsei32LE <*> parsei32LE <*> parsei32LE <*> parsei32LE <*> parsei32LE <*> parsei32LE
	& P.try <?> "parseLump expected a Lump"

parseNode :: Parsec BL.ByteString () Node
parseNode = Node <$> parsei32LE <*> parsei32LE <*> parsei32LE <*> parsei32LE <*> parsei32LE
	& P.try <?> "parseNode expected a Node"

-- Irregular encoding.
parsePath :: Parsec BL.ByteString () Path
parsePath = (<?> "parsePath expected a Path") . P.try $ do
	p   <- parseVec3fd
	t   <- parsef32dLE
	pi_ <- parsei32LE
	f   <- parsei32LE
	s   <- parsei32LE
	fl  <- parsei32LE

	e        <- if' ((fl .&. pathFlagOriented) /= 0) parseVec4fd (return $ Vec4 0.0 0.0 0.0 0.0)
	(p0, p1) <- if' ((fl .&. pathFlagParented) /= 0) ((,) <$> parsei32LE <*> parsei32LE) (return $ (0, 0))

	let tm = round $ (1000.0*t)

	let p1' = if' (p1 < 0) p0 p1

	return $ Path {
		_pathP  = p,
		_pathE  = e,
		_pathT  = t,
		_pathTm = tm,

		_pathPi = pi_,
		_pathF  = f,
		_pathS  = s,

		_pathFl = fl,

		_pathP0 = p0,
		_pathP1 = p1'
	}

parseBody :: Parsec BL.ByteString () Body
parseBody = Body <$> parsei32LE <*> parsei32LE <*> parsei32LE <*> parsei32LE <*> parsei32LE <*> parsei32LE <*> parsei32LE
	& P.try <?> "parseBody expected a Body"

parseItem :: Parsec BL.ByteString () Item
parseItem = (((\item -> item & (itemP1 .~ (if' (item^.itemP1 < 0) (item^.itemP0) (item^.itemP1)))) <$>) $ Item <$>
	parseVec3fd <*> parsei32LE <*> parsei32LE <*> parsei32LE <*> parsei32LE)
	& P.try <?> "parseItem expected an Item"

parseGoal :: Parsec BL.ByteString () Goal
parseGoal = (((\goal -> goal & (goalP1 .~ (if' (goal^.goalP1 < 0) (goal^.goalP0) (goal^.goalP1)))) <$>) $ Goal <$>
	parseVec3fd <*> parsef32dLE <*> parsei32LE <*> parsei32LE)
	& P.try <?> "parseGoal expected a Goal"

parseJump :: Parsec BL.ByteString () Jump
parseJump = (((\jump -> jump & (jumpP1 .~ (if' (jump^.jumpP1 < 0) (jump^.jumpP0) (jump^.jumpP1)))) <$>) $ Jump <$>
	parseVec3fd <*> parseVec3fd <*> parsef32dLE <*> parsei32LE <*> parsei32LE)
	& P.try <?> "parseJump expected a Jump"

-- Irregular encoding.
parseSwch :: Parsec BL.ByteString () Swch
parseSwch = (<?> "parseSwch expected a Swch") . P.try $ do
	p   <- parseVec3fd
	r   <- parsef32dLE
	pi_ <- parsei32LE

	t      <- parsef32dLE
	_skip0 <- parsef32dLE
	let tm = round $ 1000.0*t
	f      <- parsei32LE
	_skip1 <- parsei32LE
	i      <- parsei32LE

	p0 <- parsei32LE
	p1 <- parsei32LE

	let p1' = if' (p1 < 0) p0 p1

	return $ Swch {
		_swchP  = p,
		_swchR  = r,
		_swchPi = pi_,

		_swchT  = t,
		_swchTm = tm,
		_swchF  = f,
		_swchI  = i,

		_swchP0 = p0,
		_swchP1 = p1'
	}

parseBill :: Parsec BL.ByteString () Bill
parseBill = (((\bill -> bill & (billP1 .~ (if' (bill^.billP1 < 0) (bill^.billP0) (bill^.billP1)))) <$>) $ Bill <$>
	parsei32LE <*> parsei32LE <*> parsef32dLE <*> parsef32dLE <*>
	parseVec3fd <*> parseVec3fd <*>
	parseVec3fd <*> parseVec3fd <*> parseVec3fd <*>
	parseVec3fd <*>
	parsei32LE <*> parsei32LE)
	& P.try <?> "parseBill expected a Bill"

parseBall :: Parsec BL.ByteString () Ball
parseBall = Ball <$> parseVec3fd <*> parsef32dLE
	& P.try <?> "parseBall expected a Ball"

parseView :: Parsec BL.ByteString () View
parseView = View <$> parseVec3fd <*> parseVec3fd
	& P.try <?> "parseView expected a View"