darkplaces-demo (empty) → 0.1
raw patch · 12 files changed
+1838/−0 lines, 12 filesdep +basedep +binarydep +bytestringsetup-changed
Dependencies added: base, binary, bytestring, containers, criterion, darkplaces-demo, darkplaces-text, data-binary-ieee754, directory, mtl, optparse-applicative, regex-tdfa, transformers
Files
- LICENSE +339/−0
- Setup.hs +2/−0
- benchmarks/bench-parser.hs +58/−0
- darkplaces-demo.cabal +77/−0
- src/DarkPlaces/Binary.hs +93/−0
- src/DarkPlaces/Demo.hs +61/−0
- src/DarkPlaces/DemoMetadata.hs +127/−0
- src/DarkPlaces/PacketParser.hs +466/−0
- src/DarkPlaces/ProtocolConstants.hs +336/−0
- src/DarkPlaces/Types.hs +147/−0
- test_data/eac_cup_ex2perts_vs_schlitzerbos_asgy_gib_warehouse.dem too large to diff
- utils/DemoInfo.hs +132/−0
+ LICENSE view
@@ -0,0 +1,339 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Lesser General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License along+ with this program; if not, write to the Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmarks/bench-parser.hs view
@@ -0,0 +1,58 @@+module Main where+import Criterion.Main+import Prelude hiding (getLine)+import Control.Applicative+import qualified Data.ByteString.Lazy as BL+import Control.Monad.Trans.State.Lazy+import DarkPlaces.PacketParser+import DarkPlaces.Demo+import Data.Word+import Data.Binary.Get+import Data.Either+++testDemo :: String+testDemo = "test_data/eac_cup_ex2perts_vs_schlitzerbos_asgy_gib_warehouse.dem"+++parseDemo1 :: FilePath -> IO [[Either Word8 DPServerPacket]]+parseDemo1 file_name = do+ file_data <- BL.readFile file_name+ return $ parseFile file_data+ where+ msgs input = map snd $ runGet getDemoMessages (BL.drop 3 input)+ parseMsg x s = runGet (runStateT parsePackets s) x+ parseData (x:xs) s = let (xr, s') = parseMsg x s+ in xr : parseData xs s'+ parseData [] _ = []+ parseFile input = parseData (msgs input) defaultDemoState+++parseDemo2 :: FilePath -> IO [[Either Word8 DPServerPacket]]+parseDemo2 file_name = do+ file_data <- BL.readFile file_name+ return $ parseFile $ BL.drop 3 file_data+ where+ parseFile file_chunks = go (messages file_chunks) defaultDemoState+ messages demo_data = map snd $ rights $ iterDemoMessages demo_data+ goMessages msg s = runGet (runStateT parsePackets s) msg+ go (x:xs) s = let (res, s') = goMessages x s+ in res: go xs s'++ go [] _ = []++++packet_stream :: [[Either Word8 DPServerPacket]] -> [DPServerPacket]+packet_stream msgs = concat $ rights <$> msgs++main :: IO ()+main = defaultMain [+ bgroup "full" [+ bench "length" $ nfIO $ length . packet_stream <$> parseDemo1 testDemo,+ bench "head" $ whnfIO $ head . packet_stream <$> parseDemo1 testDemo,+ bench "last" $ whnfIO $ last . packet_stream <$> parseDemo1 testDemo],+ bgroup "iter" [+ bench "length" $ nfIO $ length . packet_stream <$> parseDemo2 testDemo,+ bench "head" $ whnfIO $ head . packet_stream <$> parseDemo2 testDemo,+ bench "last" $ whnfIO $ last . packet_stream <$> parseDemo2 testDemo]]
+ darkplaces-demo.cabal view
@@ -0,0 +1,77 @@+name: darkplaces-demo+version: 0.1+license: GPL-2+license-file: LICENSE+author: Slava Bacherikov+maintainer: slava@bacher09.org+homepage: https://github.com/bacher09/darkplaces-demo+bug-reports: https://github.com/bacher09/darkplaces-demo/issues+category: Game+build-type: Simple+extra-source-files: test_data/*.dem+cabal-version: >=1.10+copyright: (c) Slava Bacherikov 2015+stability: alpha+synopsis: Utility and parser for DarkPlaces demo files+description: ++ Curently this package supports only reading some sorts of+ info from darkplaces demo file.++library+ exposed-modules: DarkPlaces.Demo,+ DarkPlaces.Types,+ DarkPlaces.PacketParser,+ DarkPlaces.DemoMetadata++ other-modules: DarkPlaces.ProtocolConstants,+ DarkPlaces.Binary+ -- other-modules: + -- other-extensions: + build-depends: base >=4.7 && <4.8,+ bytestring >=0.10 && <0.11,+ binary >=0.7 && <0.8,+ transformers >=0.3 && <0.4,+ data-binary-ieee754 >=0.4 && <0.5,+ containers >=0.5 && <0.6,+ regex-tdfa >=1.1++ hs-source-dirs: src+ ghc-options: -O2 -funbox-strict-fields -Wall -fno-warn-name-shadowing+ ghc-prof-options: -prof -auto-all -rtsopts -fprof-auto -caf-all+ default-language: Haskell2010++executable demoinfo+ main-is: DemoInfo.hs++ hs-source-dirs: utils++ build-depends: base >=4.7 && <4.8,+ bytestring >=0.10 && <0.11,+ optparse-applicative >= 0.10 && < 0.12,+ directory >= 1.2,+ mtl >= 2.1 && < 2.3,+ darkplaces-demo,+ darkplaces-text++ ghc-options: -O2 -Wall -fno-warn-name-shadowing+ ghc-prof-options: -prof -auto-all -fprof-auto -caf-all++ default-language: Haskell2010++benchmark bench-darkplaces-demo+ type: exitcode-stdio-1.0+ hs-source-dirs: benchmarks+ main-is: bench-parser.hs+ ghc-options: -O2 -Wall -fno-warn-name-shadowing+ default-language: Haskell2010+ build-depends: base >=4.7 && <4.8,+ bytestring >=0.10 && <0.11,+ transformers >=0.3 && <0.4,+ binary >=0.7 && <0.8,+ darkplaces-demo,+ criterion++source-repository head+ type: git+ location: https://github.com/bacher09/darkplaces-demo
+ src/DarkPlaces/Binary.hs view
@@ -0,0 +1,93 @@+module DarkPlaces.Binary where+import Control.Applicative+import qualified Data.ByteString.Lazy as BL+import Prelude hiding (getLine)+import Data.Binary.Get+import Data.Binary.IEEE754+import Data.Int+import DarkPlaces.Types+++maxTrackLen :: Int64+maxTrackLen = 8+++getQVector :: Get QVector+getQVector = consQVector <$> getFloat32le <*> getFloat32le <*> getFloat32le+++getLine :: Get BL.ByteString+getLine = do+ b <- getWord8+ if b == 10 -- 10 is '\n'+ then return $ BL.singleton b+ else BL.cons' b <$> getLine+++getLineLimited :: Int64 -> Get BL.ByteString+getLineLimited limit | limit <= 0 = fail "Line to long"+ | otherwise = do+ b <- getWord8+ if b == 10+ then return $ BL.singleton b+ else BL.cons' b <$> getLineLimited (limit - 1)+++getStringList :: Get [BL.ByteString]+getStringList = do+ str <- getLazyByteStringNul+ if BL.null str+ then return []+ else (str :) <$> getStringList+++-- signed char+getInt8 :: Get Int8+getInt8 = fromIntegral <$> getWord8++-- signed short+getInt16le :: Get Int16+getInt16le = fromIntegral <$> getWord16le++-- signed int+getInt32le :: Get Int32+getInt32le = fromIntegral <$> getWord32le++getAngle8i :: Get Float+getAngle8i = (360.0 / 256.0 *) . fromIntegral <$> getInt8++getAngle16i :: Get Float+getAngle16i = (360.0 / 65536.0 *) . fromIntegral <$> getInt16le++getCord16i :: Get Float+getCord16i = fromIntegral <$> getInt16le++-- unsigned char to int+getWord8asInt :: Get Int+getWord8asInt = fromIntegral <$> getWord8++-- signed char to int+getInt8asInt :: Get Int+getInt8asInt = fromIntegral <$> getInt8++getInt16asInt :: Get Int+getInt16asInt = fromIntegral <$> getInt16le++getWord16asInt :: Get Int+getWord16asInt = fromIntegral <$> getWord16le++getLineAndRemaining :: Get (BL.ByteString, Int64)+getLineAndRemaining = getLine >>= \l -> bytesRead >>= \b -> return (l, b)++getLineLAndRemaining :: Int64 -> Get (BL.ByteString, Int64)+getLineLAndRemaining n = getLineLimited n >>= \l -> bytesRead >>= \b -> return (l, b)++splitAtTrack :: BL.ByteString -> Either ErrorInfo (BL.ByteString, BL.ByteString)+splitAtTrack file_data = case either_track of+ Left (_, offset, msg) -> Left (offset, msg)+ Right (_, _, (line, drop_bytes)) -> Right (line, BL.drop drop_bytes file_data)+ where+ either_track = runGetOrFail (getLineLAndRemaining maxTrackLen) file_data++skipTrack :: BL.ByteString -> Either ErrorInfo BL.ByteString+skipTrack file_data = snd <$> splitAtTrack file_data
+ src/DarkPlaces/Demo.hs view
@@ -0,0 +1,61 @@+module DarkPlaces.Demo (+ getDemoMessage,+ getDemoMessages,+ iterDemoMessages,+ demoFileMessages,+ demoFilePackets+) where+import Control.Applicative+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString as B+import Data.Binary.Get+import DarkPlaces.Types+import DarkPlaces.Binary+import DarkPlaces.PacketParser+++getDemoMessage :: Get (QVector, BL.ByteString)+getDemoMessage = do+ size <- fromIntegral <$> getWord32le+ angls <- getQVector+ msg <- getLazyByteString size+ return (angls, msg)+++getDemoMessages :: Get [(QVector, BL.ByteString)]+getDemoMessages = do+ empty <- isEmpty+ if empty+ then return []+ else (:) <$> getDemoMessage <*> getDemoMessages+++iterDemoMessages :: BL.ByteString -> [Either ErrorInfo (QVector, BL.ByteString)]+iterDemoMessages demo_data = go decoder $ BL.toChunks demo_data+ where+ decoder = runGetIncremental getDemoMessage+ go (Fail _ offset msg) _ = [Left (offset, msg)]+ go (Partial k) [] = go (k Nothing) []+ go (Partial k) (x:xs) = go (k $ Just x) xs+ go (Done left _ res) xs = Right res : if empty then [] else go decoder xs'+ where+ empty = B.null left && null xs+ xs' = left:xs+++demoFileMessages :: BL.ByteString -> [Either ErrorInfo (QVector, BL.ByteString)]+demoFileMessages file_data = either (\l -> [Left l]) iterDemoMessages either_demo+ where+ either_demo = skipTrack file_data+++demoFilePackets :: BL.ByteString -> [Either ErrorInfo PacketOrError]+demoFilePackets file_data = parse (demoFileMessages file_data) defaultDemoState+ where+ parse (x:xs) s = case x of+ Left l -> [Left l]+ Right (_, ps) -> case listPackets ps s of+ Left l -> [Left l]+ Right (pls, s') -> (Right <$> pls) ++ parse xs s'++ parse [] _ = []
+ src/DarkPlaces/DemoMetadata.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE BangPatterns #-}+module DarkPlaces.DemoMetadata (+ DemoMetadata(..),+ MetadataList,+ getMetadata,+ getMapname+) where+import Data.Maybe+import Control.Applicative+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC+import Text.Regex.TDFA+import DarkPlaces.PacketParser+import DarkPlaces.Demo (demoFilePackets)+import DarkPlaces.Types (ErrorInfo)+++data DemoMetadata = MapName String+ | DemoTime Float+ | DemoMessage Float BL.ByteString+ | CurlDownload BL.ByteString BL.ByteString BL.ByteString -- fields: as for url+ deriving(Show, Eq)+++type MetadataList = [DemoMetadata]+++data DTimeState = DTimeBegin+ | DTimeState Float Float+ deriving(Show, Eq)+++timeInit :: DTimeState+timeInit = DTimeBegin++timeUpdate :: DPServerPacket -> DTimeState -> DTimeState+timeUpdate (DPTime x) DTimeBegin = DTimeState x 0+timeUpdate (DPTime x) (DTimeState b _) = DTimeState b x+timeUpdate _ s = s++timeMetadata :: DTimeState -> MetadataList+timeMetadata (DTimeState b e) = [DemoTime (e - b)]+timeMetadata _ = []++timeValue :: DTimeState -> Float+timeValue (DTimeState b e) = e - b+timeValue _ = 0++removePrefix :: BL.ByteString -> BL.ByteString -> Maybe BL.ByteString+removePrefix pref text = if matched then Just removed else Nothing+ where+ pl = BL.length pref+ matched = BL.isPrefixOf pref text+ removed = BL.drop pl text+++removeSuffix :: BL.ByteString -> BL.ByteString -> Maybe BL.ByteString+removeSuffix suf text = if matched then Just removed else Nothing+ where+ text_len = BL.length text+ suf_len = BL.length suf+ matched = BL.isSuffixOf suf text+ removed = BL.take (text_len - suf_len) text+++removePrefixSuffix :: BL.ByteString -> BL.ByteString -> BL.ByteString -> Maybe BL.ByteString+removePrefixSuffix pref suf text = removePrefix pref text >>= removeSuffix suf+++mapName :: BL.ByteString -> Maybe BL.ByteString+mapName model = removePrefixSuffix map_prefix map_suffix model+ where+ map_suffix = BLC.pack ".bsp"+ map_prefix = BLC.pack "maps/"+++detectMapName :: DPServerPacket -> MetadataList+detectMapName (DPServerInfo (Right p@(DPServerInfoData {}))) = if not empty+ then map MapName map_names+ else []+ where+ models = dpmodelsPrecached p+ empty = null models+ map_names = maybeToList $ BLC.unpack <$> mapName (head models)++detectMapName _ = []+++detectDemoMessage :: DPServerPacket -> Float -> MetadataList+detectDemoMessage (DPPrint p) t = [DemoMessage t p]+detectDemoMessage _ _ = []+++detectCurlDownload :: DPServerPacket -> MetadataList+detectCurlDownload (DPStuffText t) = getCurlDownload t+ where+ curlRegex = makeRegex "^curl.*\\-\\-as ([^ ]+) \\-\\-for ([^ ]+) ([^ ]+)" :: Regex+ matchCurl s = match curlRegex s :: (BL.ByteString, BL.ByteString, BL.ByteString, [BL.ByteString])+ getCurlDownload s = case matchCurl s of+ (_, mt, a, [as, for, url]) | not (BL.null mt) -> (CurlDownload as for url) : getCurlDownload a+ _ -> []++detectCurlDownload _ = []+++getMetadata :: BL.ByteString -> [Either ErrorInfo DemoMetadata]+getMetadata file_data = go (demoFilePackets file_data) timeInit+ where+ go ((Left x):_) _ = [Left x]+ go ((Right (Right x)):xs) !s = addSimpleMetadata x s ++ go xs (timeUpdate x s)+ go ((Right (Left _)):xs) !s = go xs s+ go [] s = Right <$> timeMetadata s+ addSimpleMetadata x s = Right <$> (detectMapName x ++ detectCurlDownload x ++ (detectDemoMessage x $ timeValue s))+++getMapname :: BL.ByteString -> Either ErrorInfo (Maybe String)+getMapname file_data = go (demoFilePackets file_data)+ where+ go ((Left x):_) = Left x+ go ((Right (Right x)):xs) = if not (null mapList) then Right $ maybeMap mapList else go xs+ where+ mapList = detectMapName x+ maybeMap [MapName m] = Just m+ maybeMap _ = Nothing++ go ((Right (Left _)):xs) = go xs+ go [] = Right Nothing
+ src/DarkPlaces/PacketParser.hs view
@@ -0,0 +1,466 @@+module DarkPlaces.PacketParser (+ DPServerPacket(..),+ ProtocolVersion(..),+ ServerInfoData(..),+ PacketOrError(),+ defaultDemoState,+ parsePacket,+ parsePackets,+ iterPacketsWithState,+ iterPackets,+ listPackets+) where++import Prelude hiding (sequence)+import Control.Monad hiding (sequence, mapM)+import Control.Applicative+import Data.Binary.Get+import Data.Binary.IEEE754+import Data.Word+import Data.Int+import Data.Maybe+import Data.Either+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString as B+import Data.Traversable (sequence)+import Control.Monad.Trans.Writer.Lazy+import Control.Monad.Trans.State.Lazy+import Control.Monad.Trans.Class+import Data.Bits+import DarkPlaces.ProtocolConstants+import DarkPlaces.Types+import DarkPlaces.Binary+++data DPServerPacket = DPNop+ | DPDisconnect+ | DPUpdateStat (Either Word8 ClientStatsEnum) Int+ | DPVersion (Maybe ProtocolVersion)+ | DPSetView Word16+ | DPSound+ | DPTime Float+ | DPPrint BL.ByteString+ | DPStuffText BL.ByteString + | DPSetAngle SetAngleData+ | DPServerInfo (Either Word32 ServerInfoData)+ | DPLightStyle Word8 BL.ByteString+ | DPUpdateName Word8 BL.ByteString -- <user number> <user name>+ | DPUpdateFrags Word8 Int16+ | DPClientData Word32 ClientDataPacket -- <bits> <client data>+ | DPStopSound Word16+ | DPUpdateColors Word8 Word8 -- <user number> <user color>+ | DPParticle+ | DPDamage Int Int QVector -- <armor> <blood> <from locatiom>+ | DPSpawnStatic+ | DPSpawnBaseline+ | DPTempEntity+ | DPSetPause+ | DPSignonNum Word8+ | DPCenterPrint+ | DPKilledMonster+ | DPFoundSecret+ | DPSpawnStaticSound+ | DPIntermission+ | DPFinale BL.ByteString+ | DPCDTrack Word8 Word8 -- <cd track> <loop track>+ | DPSellScreen+ | DPCutScene+ | DPShowlmp+ | DPHidelmp+ | DPSkybox -- 37+ | DPDownloadData Word32 Word16 BL.ByteString -- <start> <size> <data> 50+ | DPUpdateStatUbyte (Either Word8 ClientStatsEnum) Int+ | DPSpawnStaticSound2 QVector Word16 Word8 Word8 -- <Vector origin> <Number> <vol> <atten> 59+ deriving(Show, Eq)+++data ServerInfoData = QWServerInfoData+ | DPServerInfoData {+ dpserverProtocol :: ProtocolVersion,+ dpmaxClients :: Word8,+ dpgameType :: Word8,+ dpsignonMessage :: BL.ByteString,+ dpmodelsPrecached :: [BL.ByteString],+ dpsoundsPrecached :: [BL.ByteString]+ } deriving(Show, Eq)+++data SetAngleData = SetAngleOld Float Float Float+ | SetAngleNew Float Float Float+ deriving(Show, Eq)+++data ClientDataPacket = ClientDataPacket {+ mpunchAngle :: QVector,+ mpunchVector :: QVector,+ mvelocity :: QVector,+ onGround :: Bool,+ inWater :: Bool,+ idealPitch :: Maybe Float,+ statsInfo :: [(ClientStatsEnum, Int)]+} deriving(Show, Eq)+++data ServerProtocolState = ServerProtocolState {+ protocol :: ProtocolVersion,+ gamemode :: GameMode+} deriving(Show, Eq)++++type ServerPacketParser = Get DPServerPacket+type ServerProtocolStateM a = StateT ServerProtocolState Get a+type PacketOrError = Either Word8 DPServerPacket+++getProtocol :: ServerProtocolStateM ProtocolVersion+getProtocol = protocol <$> get++setProtocol :: ProtocolVersion -> ServerProtocolStateM ()+setProtocol proto = modify $ \s -> s {protocol=proto}++getGameMode :: ServerProtocolStateM GameMode+getGameMode = gamemode <$> get+++setGameMode :: GameMode -> ServerProtocolStateM ()+setGameMode mode = modify $ \s -> s {gamemode=mode}+++updateProtoState :: DPServerPacket -> ServerProtocolStateM ()+updateProtoState (DPVersion (Just p)) = setProtocol p+updateProtoState (DPServerInfo (Right p@(DPServerInfoData {}))) = setProtocol $ dpserverProtocol p+updateProtoState _ = return ()+++updatesState :: DPServerPacket -> ServerProtocolStateM DPServerPacket+updatesState x = updateProtoState x >> return x++defaultDemoState :: ServerProtocolState+defaultDemoState = ServerProtocolState {protocol=ProtocolDarkplaces7, gamemode=GameXonotic}+++parsePacket :: ServerProtocolStateM PacketOrError+parsePacket = sequence =<< getServerPacketParser <$> lift getWord8+++parsePackets :: ServerProtocolStateM [PacketOrError]+parsePackets = do+ empty <- lift isEmpty+ if empty+ then return []+ else do+ either_packet <- parsePacket+ case either_packet of+ Right packet -> (Right packet:) <$> parsePackets+ Left t -> return [Left t]+++iterPacketsWithState :: BL.ByteString -> ServerProtocolState -> [Either ErrorInfo (PacketOrError, ServerProtocolState)]+iterPacketsWithState packets_data state = go (decoder state) $ BL.toChunks packets_data+ where+ decoder s = runGetIncremental (runStateT parsePacket s)+ go (Fail _ offset msg) _ = [Left (offset, msg)]+ go (Partial k) [] = go (k Nothing) []+ go (Partial k) (x:xs) = go (k $ Just x) xs+ go (Done left _ (res, s')) xs = Right (res, s') : if end then [] else go (decoder s') xs'+ where+ empty = null xs && B.null left+ end = empty || isLeft res+ xs' = left:xs+++iterPackets :: BL.ByteString -> ServerProtocolState -> ([Either ErrorInfo PacketOrError], ServerProtocolState)+iterPackets packets_data state = convert (iterPacketsWithState packets_data state) state+ where+ convert (x:xs) s = case x of+ Right (p, s') -> let (res, s'') = convert xs s'+ in (Right p : res, s'')++ Left (offset, msg) -> ([Left (offset, msg)], s)++ convert [] s = ([], s)+++listPackets :: BL.ByteString -> ServerProtocolState -> Either ErrorInfo ([PacketOrError], ServerProtocolState)+listPackets packets_data state = convert $ runGetOrFail (runStateT parsePackets state) packets_data+ where+ convert (Left (_, offset, msg)) = Left (offset, msg)+ convert (Right (_, _, r)) = Right r+++getServerPacketParser :: Word8 -> Either Word8 (ServerProtocolStateM DPServerPacket)+getServerPacketParser t = case t of+ 1 -> Right $ lift getNop+ 2 -> Right $ lift getDisconnect+ 3 -> Right $ lift getUpdateStats+ 4 -> Right $ lift getVersion >>= updatesState+ 5 -> Right $ lift getSetView+ -- 6 sound+ 7 -> Right $ lift getTime+ 8 -> Right $ lift getPrint+ 9 -> Right $ lift getStuffText+ 10 -> Right $ lift . getSetAngle =<< getProtocol+ 11 -> Right $ lift getServerInfo >>= updatesState+ 12 -> Right $ lift getLightStyle+ 13 -> Right $ lift getUpdateName+ 14 -> Right $ lift getUpdateFrags+ 15 -> Right $ getProtocol >>= \p -> getGameMode >>= lift . getClientData p+ 16 -> Right $ lift getStopSound+ 17 -> Right $ lift getUpdateColors+ 19 -> Right $ lift getDamage+ 25 -> Right $ lift getSignonNum+ 30 -> Right $ lift getIntermission+ 31 -> Right $ lift getFinale+ 32 -> Right $ lift getCDTrack+ 50 -> Right $ lift getDownloadData+ 51 -> Right $ lift getUpdateStatUbyte+ 59 -> Right $ lift getSpawnStaticSound2+ _ -> Left t++getNop :: ServerPacketParser+getNop = return DPNop++getDisconnect :: ServerPacketParser+getDisconnect = return DPDisconnect++getUpdateStats :: ServerPacketParser+getUpdateStats = do+ i <- getWord8+ let stats = maybe (Left i) Right $ statsFromNum i+ DPUpdateStat stats . fromIntegral <$> getInt32le++getVersion :: ServerPacketParser+getVersion = DPVersion . protocolVersionFromNum <$> getWord32le++getSetView :: ServerPacketParser+getSetView = DPSetView <$> getWord16le++-- parseSound for DPSound++getTime :: ServerPacketParser+getTime = DPTime <$> getFloat32le++getPrint ::ServerPacketParser+getPrint = DPPrint <$> getLazyByteStringNul++getStuffText :: ServerPacketParser+getStuffText = DPStuffText <$> getLazyByteStringNul++getSetAngle :: ProtocolVersion -> ServerPacketParser+getSetAngle proto = DPSetAngle <$> if proto `elem` [(ProtocolDarkplaces5)..]+ then SetAngleNew <$> getAngle16i <*> getAngle16i <*> getAngle16i+ else SetAngleOld <$> getAngle8i <*> getAngle8i <*> getAngle8i++ +-- TODO: not full+getServerInfo :: ServerPacketParser+getServerInfo = do+ proto_num <- getWord32le+ let maybe_proto = protocolVersionFromNum proto_num+ case maybe_proto of+ Nothing -> return $ DPServerInfo (Left proto_num)+ Just proto@(ProtocolQuakeWorld) -> toDPServerPacket <$> parseQuakeWorldInfo proto+ Just proto -> toDPServerPacket <$> parseOtherInfo proto+ where+ parseQuakeWorldInfo proto = undefined+ parseOtherInfo proto = do+ maxclients <- getWord8+ gametype <- getWord8+ signon_msg <- getLazyByteStringNul+ models_precached <- getStringList+ sounds_precached <- getStringList+ return DPServerInfoData {+ dpserverProtocol=proto,+ dpmaxClients=maxclients,+ dpgameType=gametype,+ dpsignonMessage=signon_msg,+ dpmodelsPrecached=models_precached,+ dpsoundsPrecached=sounds_precached}+ toDPServerPacket = DPServerInfo . Right+++getLightStyle :: ServerPacketParser+getLightStyle = DPLightStyle <$> getWord8 <*> getLazyByteStringNul+++getUpdateName :: ServerPacketParser+getUpdateName = DPUpdateName <$> getWord8 <*> getLazyByteStringNul++getUpdateFrags :: ServerPacketParser+getUpdateFrags = DPUpdateFrags <$> getWord8 <*> (fromIntegral <$> getWord16le)++getClientData :: ProtocolVersion -> GameMode -> ServerPacketParser+getClientData proto mode = do+ bits <- getBits+ ms_view_height <- maybeDo (testBit bits su_viewheight_bit) getInt8+ m_ideal_pitch <- maybeDo (testBit bits su_idealpitch_bit) getInt8+ (p_angl, p_vec, vel) <- getMpVectors bits+ ms_items <- maybeDo (testBit bits su_items_bit || proto `elem` hipnotic_demos) getInt32le+ stats' <- case proto of+ ProtocolDarkplaces5 -> parseDP5Stats bits+ _ | proto `elem` (quakes ++ neharaFamily ++ darkplacesUpto4) -> execWriterT $ getOldStats bits+ _ -> return []++ m_view_zoom <- case testBit bits su_viewzoom_bit of+ True | proto `elem` [(ProtocolDarkplaces2)..(ProtocolDarkplaces4)] -> Just <$> getWord8asInt+ True -> Just <$> getWord16asInt+ False -> return Nothing++ let view_zoom = maybeToList $ (\n -> (ViewZoomStat, n)) <$> m_view_zoom++ let stats = toStats ms_view_height ViewHeightStat +++ toStats ms_items ItemsStat ++ stats' ++ view_zoom++ return $ DPClientData bits ClientDataPacket {+ mpunchAngle=p_angl,+ mpunchVector=p_vec,+ mvelocity=vel,+ onGround=testBit bits su_onground_bit,+ inWater=testBit bits su_inwater_bit,+ idealPitch= fromIntegral <$> m_ideal_pitch,+ statsInfo=stats+ }+ where+ quakes =[ProtocolQuake, ProtocolQuakeDP]+ neharaFamily = [(ProtocolNehahraMovie)..(ProtocolNehahraBJP3)]+ darkplacesUpto4 = [(ProtocolDarkplaces1)..(ProtocolDarkplaces4)]+ hipnotic_demos = quakes ++ neharaFamily ++ [(ProtocolDarkplaces1)..(ProtocolDarkplaces5)]+ getWord16as32 = (fromIntegral :: Word16 -> Word32) <$> getWord16le+ getWord8as32 = (fromIntegral :: Word8 -> Word32) <$> getWord8+ toStats num key = maybeToList $ (\n -> (key, fromIntegral n)) <$> num+ statsVal key n = [(key, n)]+ getBits = do+ bits <- getWord16as32++ bits <- if testBit bits su_extend1_bit+ then (\b -> bits .|. shift b 16) <$> getWord8as32+ else return bits++ bits <- if testBit bits su_extend2_bit+ then (\b -> bits .|. shift b 32) <$> getWord8as32+ else return bits+ + return bits++ maybeDo cond res = if cond then Just <$> res else return Nothing + getMpVectors bits = do+ r_vecs <- forM [0..2] $ \i -> do+ p_angl <- if testBit bits (su_punch1_bit + i)+ then getPunchAngle+ else return 0++ p_vec <- if testBit bits (su_punchvec1_bit + i)+ then getPunchvec+ else return 0++ vel <- if testBit bits (su_velocity1_bit + i)+ then getVelocity+ else return 0++ return (p_angl, p_vec, vel)++ let (angls, vecs, vels) = unzip3 r_vecs+ return (buildQVector angls, buildQVector vecs, buildQVector vels)+ where+ getPunchAngle :: Get Float+ getPunchAngle = if proto `elem` (neharaFamily ++ quakes)+ then fromIntegral <$> getInt8+ else getAngle16i++ getPunchvec = if proto `elem` darkplacesUpto4+ then getCord16i+ else getFloat32le++ getVelocity = if proto `elem` (quakes ++ neharaFamily ++ darkplacesUpto4)+ then (16 *) . fromIntegral <$> getInt8+ else getFloat32le++ buildQVector = fromJust . qvectorFromList++ maybeGetStat bits bit key = if testBit bits bit then statsVal key <$> getInt16asInt else return []+ getStat key = (\v -> (key, v)) <$> getInt16asInt+ parseDP5Stats bits = do+ stats <- sequence [maybeGetStat bits su_weaponframe_bit WeaponFrameStat,+ maybeGetStat bits su_armor_bit ArmorStat,+ maybeGetStat bits su_weapon_bit WeaponStat]++ stats' <- sequence $ getStat <$> [HealthStat, AmmoStat, ShellsStat, NailsStat,+ RocketsStat, CellsStat]++ stats'' <- statsVal ActiveWeaponStat <$> getWord16asInt+ + return $ concat stats ++ stats' ++ stats''++ getOldStats :: Word32 -> WriterT ClientStatsList Get ()+ getOldStats bits = do+ when (testBit bits su_weaponframe_bit) $ do+ tell =<< statsVal WeaponFrameStat <$> lift getWord8asInt++ when (testBit bits su_armor_bit) $ do+ tell =<< statsVal ArmorStat <$> lift getWord8asInt++ when (testBit bits su_weapon_bit) $ do+ let r = lift $ if proto `elem` [(ProtocolNehahraBJP)..(ProtocolNehahraBJP3)]+ then getWord16asInt+ else getWord8asInt++ tell =<< statsVal WeaponStat <$> r++ tell =<< statsVal HealthStat <$> lift getInt16asInt+ tell =<< statsVal AmmoStat <$> lift getWord8asInt+ tell =<< statsVal ShellsStat <$> lift getWord8asInt+ tell =<< statsVal NailsStat <$> lift getWord8asInt+ tell =<< statsVal RocketsStat <$> lift getWord8asInt+ tell =<< statsVal CellsStat <$> lift getWord8asInt+ let awep = if mode `elem` [GameNexuiz, GameVoreTournament, GameHipnotic, GameRogue, GameQuoth]+ then shift 1 <$> getWord8asInt+ else getWord8asInt++ tell =<< statsVal ActiveWeaponStat <$> lift awep+++getStopSound :: ServerPacketParser+getStopSound = DPStopSound <$> getWord16le -- (n `shiftR` 3) (n .&. 7)++getUpdateColors :: ServerPacketParser+getUpdateColors = DPUpdateColors <$> getWord8 <*> getWord8++-- 19+getDamage :: ServerPacketParser+getDamage = DPDamage <$> getWord8asInt <*> getWord8asInt <*> getQVector+++-- 25+getSignonNum :: ServerPacketParser+getSignonNum = DPSignonNum <$> getWord8+++-- 30+getIntermission :: ServerPacketParser+getIntermission = return DPIntermission++getFinale :: ServerPacketParser+getFinale = DPFinale <$> getLazyByteStringNul++getCDTrack :: ServerPacketParser+getCDTrack = DPCDTrack <$> getWord8 <*> getWord8++getDownloadData :: ServerPacketParser+getDownloadData = do+ start <- getWord32le+ size <- getWord16le+ download_data <- getLazyByteString $ fromIntegral size+ return $ DPDownloadData start size download_data+++getUpdateStatUbyte :: ServerPacketParser+getUpdateStatUbyte = do+ i <- getWord8+ let stats = maybe (Left i) Right $ statsFromNum i+ v <- fromIntegral <$> getWord8+ return $ DPUpdateStatUbyte stats v++--TODO: need check protocol for QVector+getSpawnStaticSound2 :: ServerPacketParser+getSpawnStaticSound2 = DPSpawnStaticSound2 <$> getQVector <*> getWord16le <*> getWord8 <*> getWord8
+ src/DarkPlaces/ProtocolConstants.hs view
@@ -0,0 +1,336 @@+module DarkPlaces.ProtocolConstants where++u_morebits_bit :: Int+u_morebits_bit = 0+u_origin1_bit :: Int+u_origin1_bit = 1+u_origin2_bit :: Int+u_origin2_bit = 2+u_origin3_bit :: Int+u_origin3_bit = 3+u_angle2_bit :: Int+u_angle2_bit = 4+u_step_bit :: Int+u_step_bit = 5+u_frame_bit :: Int+u_frame_bit = 6+u_signal_bit :: Int+u_signal_bit = 7+u_angle1_bit :: Int+u_angle1_bit = 8+u_angle3_bit :: Int+u_angle3_bit = 9+u_model_bit :: Int+u_model_bit = 10+u_colormap_bit :: Int+u_colormap_bit = 11+u_skin_bit :: Int+u_skin_bit = 12+u_effects_bit :: Int+u_effects_bit = 13+u_longentity_bit :: Int+u_longentity_bit = 14+u_extend1_bit :: Int+u_extend1_bit = 15+u_delta_bit :: Int+u_delta_bit = 16+u_alpha_bit :: Int+u_alpha_bit = 17+u_scale_bit :: Int+u_scale_bit = 18+u_effects2_bit :: Int+u_effects2_bit = 19+u_glowsize_bit :: Int+u_glowsize_bit = 20+u_glowcolor_bit :: Int+u_glowcolor_bit = 21+u_colormod_bit :: Int+u_colormod_bit = 22+u_extend2_bit :: Int+u_extend2_bit = 23+u_glowtrail_bit :: Int+u_glowtrail_bit = 24+u_viewmodel_bit :: Int+u_viewmodel_bit = 25+u_frame2_bit :: Int+u_frame2_bit = 26+u_model2_bit :: Int+u_model2_bit = 27+u_exteriormodel_bit :: Int+u_exteriormodel_bit = 28+u_unused29_bit :: Int+u_unused29_bit = 29+u_unused30_bit :: Int+u_unused30_bit = 30+u_extend3_bit :: Int+u_extend3_bit = 31+su_viewheight_bit :: Int+su_viewheight_bit = 0+su_idealpitch_bit :: Int+su_idealpitch_bit = 1+su_punch1_bit :: Int+su_punch1_bit = 2+su_punch2_bit :: Int+su_punch2_bit = 3+su_punch3_bit :: Int+su_punch3_bit = 4+su_velocity1_bit :: Int+su_velocity1_bit = 5+su_velocity2_bit :: Int+su_velocity2_bit = 6+su_velocity3_bit :: Int+su_velocity3_bit = 7+su_items_bit :: Int+su_items_bit = 9+su_onground_bit :: Int+su_onground_bit = 10+su_inwater_bit :: Int+su_inwater_bit = 11+su_weaponframe_bit :: Int+su_weaponframe_bit = 12+su_armor_bit :: Int+su_armor_bit = 13+su_weapon_bit :: Int+su_weapon_bit = 14+su_extend1_bit :: Int+su_extend1_bit = 15+su_punchvec1_bit :: Int+su_punchvec1_bit = 16+su_punchvec2_bit :: Int+su_punchvec2_bit = 17+su_punchvec3_bit :: Int+su_punchvec3_bit = 18+su_viewzoom_bit :: Int+su_viewzoom_bit = 19+su_unused20_bit :: Int+su_unused20_bit = 20+su_unused21_bit :: Int+su_unused21_bit = 21+su_unused22_bit :: Int+su_unused22_bit = 22+su_extend2_bit :: Int+su_extend2_bit = 23+su_unused24_bit :: Int+su_unused24_bit = 24+su_unused25_bit :: Int+su_unused25_bit = 25+su_unused26_bit :: Int+su_unused26_bit = 26+su_unused27_bit :: Int+su_unused27_bit = 27+su_unused28_bit :: Int+su_unused28_bit = 28+su_unused29_bit :: Int+su_unused29_bit = 29+su_unused30_bit :: Int+su_unused30_bit = 30+su_extend3_bit :: Int+su_extend3_bit = 31+snd_volume_bit :: Int+snd_volume_bit = 0+snd_attenuation_bit :: Int+snd_attenuation_bit = 1+snd_looping_bit :: Int+snd_looping_bit = 2+snd_largeentity_bit :: Int+snd_largeentity_bit = 3+snd_largesound_bit :: Int+snd_largesound_bit = 4+snd_speedushort4000_bit :: Int+snd_speedushort4000_bit = 5+e_origin1_bit :: Int+e_origin1_bit = 0+e_origin2_bit :: Int+e_origin2_bit = 1+e_origin3_bit :: Int+e_origin3_bit = 2+e_angle1_bit :: Int+e_angle1_bit = 3+e_angle2_bit :: Int+e_angle2_bit = 4+e_angle3_bit :: Int+e_angle3_bit = 5+e_model1_bit :: Int+e_model1_bit = 6+e_extend1_bit :: Int+e_extend1_bit = 7+e_frame1_bit :: Int+e_frame1_bit = 8+e_effects1_bit :: Int+e_effects1_bit = 9+e_alpha_bit :: Int+e_alpha_bit = 10+e_scale_bit :: Int+e_scale_bit = 11+e_colormap_bit :: Int+e_colormap_bit = 12+e_skin_bit :: Int+e_skin_bit = 13+e_flags_bit :: Int+e_flags_bit = 14+e_extend2_bit :: Int+e_extend2_bit = 15+e_frame2_bit :: Int+e_frame2_bit = 16+e_model2_bit :: Int+e_model2_bit = 17+e_effects2_bit :: Int+e_effects2_bit = 18+e_glowsize_bit :: Int+e_glowsize_bit = 19+e_glowcolor_bit :: Int+e_glowcolor_bit = 20+e_light_bit :: Int+e_light_bit = 21+e_lightpflags_bit :: Int+e_lightpflags_bit = 22+e_extend3_bit :: Int+e_extend3_bit = 23+e_sound1_bit :: Int+e_sound1_bit = 24+e_soundvol_bit :: Int+e_soundvol_bit = 25+e_soundatten_bit :: Int+e_soundatten_bit = 26+e_tagattachment_bit :: Int+e_tagattachment_bit = 27+e_lightstyle_bit :: Int+e_lightstyle_bit = 28+e_unused6_bit :: Int+e_unused6_bit = 29+e_unused7_bit :: Int+e_unused7_bit = 30+e_extend4_bit :: Int+e_extend4_bit = 31+e5_fullupdate_bit :: Int+e5_fullupdate_bit = 0+e5_origin_bit :: Int+e5_origin_bit = 1+e5_angles_bit :: Int+e5_angles_bit = 2+e5_model_bit :: Int+e5_model_bit = 3+e5_frame_bit :: Int+e5_frame_bit = 4+e5_skin_bit :: Int+e5_skin_bit = 5+e5_effects_bit :: Int+e5_effects_bit = 6+e5_extend1_bit :: Int+e5_extend1_bit = 7+e5_flags_bit :: Int+e5_flags_bit = 8+e5_alpha_bit :: Int+e5_alpha_bit = 9+e5_scale_bit :: Int+e5_scale_bit = 10+e5_origin32_bit :: Int+e5_origin32_bit = 11+e5_angles16_bit :: Int+e5_angles16_bit = 12+e5_model16_bit :: Int+e5_model16_bit = 13+e5_colormap_bit :: Int+e5_colormap_bit = 14+e5_extend2_bit :: Int+e5_extend2_bit = 15+e5_attachment_bit :: Int+e5_attachment_bit = 16+e5_light_bit :: Int+e5_light_bit = 17+e5_glow_bit :: Int+e5_glow_bit = 18+e5_effects16_bit :: Int+e5_effects16_bit = 19+e5_effects32_bit :: Int+e5_effects32_bit = 20+e5_frame16_bit :: Int+e5_frame16_bit = 21+e5_colormod_bit :: Int+e5_colormod_bit = 22+e5_extend3_bit :: Int+e5_extend3_bit = 23+e5_glowmod_bit :: Int+e5_glowmod_bit = 24+e5_complexanimation_bit :: Int+e5_complexanimation_bit = 25+e5_traileffectnum_bit :: Int+e5_traileffectnum_bit = 26+e5_unused27_bit :: Int+e5_unused27_bit = 27+e5_unused28_bit :: Int+e5_unused28_bit = 28+e5_unused29_bit :: Int+e5_unused29_bit = 29+e5_unused30_bit :: Int+e5_unused30_bit = 30+e5_extend4_bit :: Int+e5_extend4_bit = 31+qw_pf_msec_bit :: Int+qw_pf_msec_bit = 0+qw_pf_command_bit :: Int+qw_pf_command_bit = 1+qw_pf_velocity1_bit :: Int+qw_pf_velocity1_bit = 2+qw_pf_velocity2_bit :: Int+qw_pf_velocity2_bit = 3+qw_pf_velocity3_bit :: Int+qw_pf_velocity3_bit = 4+qw_pf_model_bit :: Int+qw_pf_model_bit = 5+qw_pf_skinnum_bit :: Int+qw_pf_skinnum_bit = 6+qw_pf_effects_bit :: Int+qw_pf_effects_bit = 7+qw_pf_weaponframe_bit :: Int+qw_pf_weaponframe_bit = 8+qw_pf_dead_bit :: Int+qw_pf_dead_bit = 9+qw_pf_gib_bit :: Int+qw_pf_gib_bit = 10+qw_pf_nograv_bit :: Int+qw_pf_nograv_bit = 11+qw_cm_angle1_bit :: Int+qw_cm_angle1_bit = 0+qw_cm_angle3_bit :: Int+qw_cm_angle3_bit = 1+qw_cm_forward_bit :: Int+qw_cm_forward_bit = 2+qw_cm_side_bit :: Int+qw_cm_side_bit = 3+qw_cm_up_bit :: Int+qw_cm_up_bit = 4+qw_cm_buttons_bit :: Int+qw_cm_buttons_bit = 5+qw_cm_impulse_bit :: Int+qw_cm_impulse_bit = 6+qw_cm_angle2_bit :: Int+qw_cm_angle2_bit = 7+qw_u_origin1_bit :: Int+qw_u_origin1_bit = 9+qw_u_origin2_bit :: Int+qw_u_origin2_bit = 10+qw_u_origin3_bit :: Int+qw_u_origin3_bit = 11+qw_u_angle2_bit :: Int+qw_u_angle2_bit = 12+qw_u_frame_bit :: Int+qw_u_frame_bit = 13+qw_u_remove_bit :: Int+qw_u_remove_bit = 14+qw_u_morebits_bit :: Int+qw_u_morebits_bit = 15+qw_u_angle1_bit :: Int+qw_u_angle1_bit = 0+qw_u_angle3_bit :: Int+qw_u_angle3_bit = 1+qw_u_model_bit :: Int+qw_u_model_bit = 2+qw_u_colormap_bit :: Int+qw_u_colormap_bit = 3+qw_u_skin_bit :: Int+qw_u_skin_bit = 4+qw_u_effects_bit :: Int+qw_u_effects_bit = 5+qw_u_solid_bit :: Int+qw_u_solid_bit = 6
+ src/DarkPlaces/Types.hs view
@@ -0,0 +1,147 @@+module DarkPlaces.Types (+ QVector(),+ ClientStatsEnum(..),+ ClientStatsList,+ ProtocolVersion(..),+ GameMode(..),+ ErrorInfo,+ consQVector,+ qvectorFromList,+ protocolVersionFromNum,+ statsFromNum+) where++import qualified Data.Map.Strict as SM+import Data.Word+import Data.Binary.Get+++newtype QVector = QVector (Float, Float, Float) deriving (Show, Eq, Ord)+++type ErrorInfo = (ByteOffset, String)+++data ClientStatsEnum = HealthStat+ | WeaponStat+ | AmmoStat+ | ArmorStat+ | WeaponFrameStat+ | ShellsStat+ | NailsStat+ | RocketsStat+ | CellsStat+ | ActiveWeaponStat+ | TotalSecretsStat+ | TotalMonstersStat+ | SecretsStat+ | MonstersStat+ | ItemsStat+ | ViewHeightStat+ | ViewZoomStat+ deriving(Show, Eq, Enum, Bounded)+++type ClientStatsList = [(ClientStatsEnum, Int)]+++data ProtocolVersion = ProtocolQuake+ | ProtocolQuakeWorld+ | ProtocolQuakeDP+ | ProtocolNehahraMovie+ | ProtocolNehahraBJP+ | ProtocolNehahraBJP2+ | ProtocolNehahraBJP3+ | ProtocolDarkplaces1+ | ProtocolDarkplaces2+ | ProtocolDarkplaces3+ | ProtocolDarkplaces4+ | ProtocolDarkplaces5+ | ProtocolDarkplaces6+ | ProtocolDarkplaces7+ deriving(Show, Eq, Ord, Bounded, Enum)+++data GameMode = GameNormal+ | GameHipnotic+ | GameRogue+ | GameQuoth+ | GameNehahra+ | GameNexuiz+ | GameXonotic+ | GameTransfusion+ | GameGoodVsBad2+ | GameTeu+ | GameBattlemech+ | GameZymotic+ | GameSetheral+ | GameTenebrae+ | GameNeoteric+ | GameOpenquartz+ | GamePrydon+ | GameDeluxeQuake+ | GameThehunTed+ | GameDefeatIndetail2+ | GameDarsana+ | GameContagionTheory+ | GameEdu2p+ | GameProphecy+ | GameBloodOmnicide+ | GameSteelStorm+ | GameSteelStorm2+ | GameSsammo+ | GameTomesofMephistopheles+ | GameStrapBomb+ | GameMoonhelm+ | GameVoreTournament+ | GameCount+ deriving(Show, Eq, Enum, Bounded)+++consQVector :: Float -> Float -> Float -> QVector+consQVector x y z = QVector (x, y, z)++qvectorFromList :: [Float] -> Maybe QVector+qvectorFromList arg = case arg of+ [x, y, z] -> Just $ QVector (x, y, z)+ _ -> Nothing+++protocolVersionMaps :: [(Word32, ProtocolVersion, String)]+protocolVersionMaps = [+ (3504, ProtocolDarkplaces7, "DP7"),+ (3503, ProtocolDarkplaces6, "DP6"),+ (3502, ProtocolDarkplaces5, "DP5"),+ (3501, ProtocolDarkplaces4, "DP4"),+ (3500, ProtocolDarkplaces3, "DP3"),+ (97, ProtocolDarkplaces2, "DP2"),+ (96, ProtocolDarkplaces1, "DP1"),+ (15, ProtocolQuakeDP, "QUAKEDP"),+ (15, ProtocolQuake, "QUAKE"),+ (28, ProtocolQuakeWorld, "QW"),+ (250, ProtocolNehahraMovie, "NEHAHRAMOVIE"),+ (10000, ProtocolNehahraBJP, "NEHAHRABJP"),+ (10001, ProtocolNehahraBJP2, "NEHAHRABJP2"),+ (10002, ProtocolNehahraBJP3, "NEHAHRABJP3")]+ ++-- get ProtocolVersion by Long Int+protocolVersionFromNum :: (Integral a) => a -> Maybe ProtocolVersion+protocolVersionFromNum key = SM.lookup (fromIntegral key) map_table+ where+ map_table = SM.fromList $ map (\(x, y, _) -> (x, y)) protocolVersionMaps+++clientStatsMap :: [(Word8, ClientStatsEnum)]+clientStatsMap = [(0, HealthStat), (2, WeaponStat), (3, AmmoStat),+ (4, ArmorStat), (5, WeaponFrameStat), (6, ShellsStat),+ (7, NailsStat), (8, RocketsStat), (9, CellsStat),+ (10, ActiveWeaponStat), (11, TotalSecretsStat), (12, TotalMonstersStat),+ (13, SecretsStat), (14, MonstersStat),(15, ItemsStat),+ (16, ViewHeightStat), (21, ViewZoomStat)]+++statsFromNum :: (Integral a) => a -> Maybe ClientStatsEnum+statsFromNum a = SM.lookup (fromIntegral a) search_map+ where+ search_map = SM.fromList clientStatsMap
+ test_data/eac_cup_ex2perts_vs_schlitzerbos_asgy_gib_warehouse.dem view
file too large to diff
+ utils/DemoInfo.hs view
@@ -0,0 +1,132 @@+module Main where+import Options.Applicative+import DarkPlaces.DemoMetadata+import DarkPlaces.Text+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC+import System.Directory (doesFileExist)+import System.Exit+import Control.Monad.Error+import Text.Printf+import Data.Either+import Data.Fixed (mod')++data CommandArgs = CommandArgs {+ onlyMapname :: Bool,+ filename :: String+} deriving(Show, Eq)+++data ResourceDownload = ResourceDownload {+ as :: String,+ for :: String,+ url :: String+} deriving (Show, Eq)++data FileMetadata = FileMetadata {+ mapName :: String,+ demoTime :: Float,+ downloads :: [ResourceDownload]+} deriving (Show, Eq)++type MaybeError = ErrorT String IO++argsParser :: Parser CommandArgs+argsParser = CommandArgs + <$> switch+ ( long "map"+ <> short 'm'+ <> help "Print only map name")+ <*> argument str (+ metavar "FILE"+ <> help "Input demo file")+++printMessages :: MetadataList -> IO ()+printMessages metadata = putStrLn "Messages:" >> (mapM_ print $ filter pred metadata)+ where+ pred (DemoMessage _ _) = True+ pred _ = False+ print (DemoMessage _ m) = putStrUtf $ parseDPText m+ print _ = return ()+++openFile :: CommandArgs -> MaybeError BL.ByteString+openFile args = do+ let file = filename args+ exist <- liftIO $ doesFileExist file+ if exist+ then liftIO $ BL.readFile file+ else throwError $ printf "File \"%s\" does not exists\n" file+++formatTime :: Float -> String+formatTime d+ | d <= 60 = s_repr+ | d <= (60 * 60) = printf "%s %s" m_repr s_repr+ | otherwise = printf "%s %s %s" h_repr m_repr s_repr+ where+ s = d `mod'` 60 :: Float+ m = (truncate $ d / 60) `rem` 60 :: Int+ h = (truncate $ d / (60 * 60)) `rem` 24 :: Int+ s_repr = choose "second" "seconds" s+ m_repr = choose "minute" "minutes" m+ h_repr = choose "hour" "hours" h+ choose s1 s2 v+ | v == 1 = show v ++ " " ++ s1+ | otherwise = show v ++ " " ++ s2+++formatMetadata :: MetadataList -> MaybeError ()+formatMetadata metadata = do+ let meta = foldMetadata metadata initState+ liftIO $ putStrLn $ printf "Map: %s" $ mapName meta+ liftIO $ putStrLn $ printf "Time: %s" $ formatTime $ demoTime meta+ liftIO $ printDownloads meta+ liftIO $ printMessages metadata+ return ()+ where+ initState = FileMetadata "" 0 []+ foldMetadata ((MapName m):xs) ms = foldMetadata xs $ ms {mapName=m}+ foldMetadata ((DemoTime t):xs) ms = foldMetadata xs $ ms {demoTime=t}+ foldMetadata ((CurlDownload as for url):xs) ms = foldMetadata xs ms'+ where+ ms' = ms {downloads=(ResourceDownload (BLC.unpack as) (BLC.unpack for) (BLC.unpack url)): downloads ms}+ foldMetadata (_:xs) ms = foldMetadata xs ms+ foldMetadata [] ms = ms {downloads= reverse $ downloads ms}+ printDownloads meta = mapM_ printDownload $ downloads meta+ where+ printDownload d = putStrLn $ printf "Download: %s -- as %s" (url d) (as d)+++processDemo :: CommandArgs -> MaybeError ()+processDemo args = do+ file_data <- openFile args+ if onlyMapname $ args+ then do+ let maybe_map = getMapname file_data+ case maybe_map of+ (Right (Just m)) -> liftIO $ putStrLn $ printf "Map: %s" m+ (Right Nothing) -> liftIO $ putStrLn "No map information in demo file"+ (Left _) -> throwError "Error during parsing file"+ else do+ let (errors, metadata) = partitionEithers $ getMetadata file_data+ if null errors+ then formatMetadata metadata+ else throwError "Error during parsing file"+++demoInfo :: CommandArgs -> IO ()+demoInfo args = do+ r <- runErrorT $ processDemo args+ case r of+ Right _ -> exitSuccess+ Left e -> putStrLn e >> exitFailure+++main :: IO ()+main = demoInfo =<< execParser opts+ where+ opts = info (helper <*> argsParser)+ (fullDesc+ <> progDesc "Get demo file metada")