Lint

Changelog.md

@@ -3,7 +3,8 @@
 ## 1.10 (UNRELEASED)
 
  * Audio filenames can now be quoted, to support filenames with characters
-   outside the range `a-zA-Z0-9_`
+   outside the range `a-zA-Z0-9_`. Audio files can also be given including
+   their extension.
  * Support for the `stop` and `restart` codes (generated by default)
  * The `set-language` command truncates long language names (like `ITALIAN`)
    automatically.

default.nix

@@ -193,10 +193,10 @@ in rec {
   gme-downloads = pkgs.runCommandNoCC "gme-downloads" {
     buildInputs = with pkgs; [ wget ];
     outputHashMode = "recursive";
-    outputHash =  "sha256:01byby8fmqmxfg5cb5ss0pmhvf2av65sil9cqbjswky0a1mn7kp5";
+    outputHash =  "sha256:02cayz36ajaw8lv2kri54vmd6qid5w4vn4s6dmagq583f887b03l";
   } ''
     mkdir -p $out
-    bash ${./testsuite/download.sh} $out
+    bash ${./testsuite/download.sh} ${./testsuite/gme-files-test.txt} $out
   '';
 
   tests = pkgs.stdenv.mkDerivation {

src/Commands.hs

@@ -117,7 +117,7 @@ dumpInfo conf file = do
         (fst (head st)) (fst (last st))
         (length (filter (isNothing . snd) st)) (length st)
     printf "Audio table entries: %d\n" (length ttAudioFiles)
-    when ttAudioFilesDoubles $ printf "Audio table repeated twice\n"
+    printf "Audio table copy: %s\n" (show ttAudioFilesDoubles)
     printf "Binary tables entries: %d/%d/%d\n"
         (length ttBinaries1)
         (length ttBinaries2)
@@ -133,7 +133,8 @@ dumpInfo conf file = do
 lint :: FilePath -> IO ()
 lint file = do
     (tt,segments) <- parseTipToiFile <$> B.readFile file
-    lintTipToi tt segments
+    result <- lintTipToi tt segments
+    when (result == False) exitFailure
 
 play :: Conf -> FilePath -> IO ()
 play conf file = do

src/GMEParser.hs

@@ -270,27 +270,34 @@ getBinaries = do
         binary <- getSegAt offset (BC.unpack desc) (getBS length)
         return (desc, binary)
 
-getAudios :: Word32 -> SGet ([B.ByteString], Bool, Word8)
+getAudios :: Word32 -> SGet ([B.ByteString], Similarity, Word8)
 getAudios rawXor = do
     until <- lookAhead getWord32
     x <- case () of
           () | rawXor == knownRawXOR -> return knownXOR
              | otherwise             -> lookAhead $ jumpTo until >> getXor
     offset <- bytesRead
     let n_entries = fromIntegral ((until - offset) `div` 8)
-    at_doubled <- lookAhead $ do
-        half1 <- getBS (n_entries * 8 `div` 2)
-        half2 <- getBS (n_entries * 8 `div` 2)
-        return $ half1 == half2
-    let n_entries' | at_doubled = n_entries `div` 2
-                   | otherwise  = n_entries
+    similarity <- determine_similiarity <$> lookAhead (getBS (n_entries * 8))
+    let n_entries' | Absent <- similarity = n_entries
+                   | otherwise = n_entries `div` 2
     decoded <- forM [0..n_entries'-1] $ \n -> do
         cypher x <$> indirectBS (show n)
-    -- Fix segment
-    when at_doubled $ lookAhead $ getSeg "Audio table copy" $
+    -- pretend we read the rest too
+    unless (similarity == Absent) $ lookAhead $ getSeg "Audio table copy" $
         replicateM_ (fromIntegral n_entries') (getWord32 >> getWord32)
 
-    return (decoded, at_doubled, x)
+    return (decoded, similarity, x)
+  where
+    -- Fuzzy comparison: More than 80% the same?
+    determine_similiarity bs
+        | a == b            = Equal
+        | 5 * same >= 4 * n = Similar
+        | otherwise         = Absent
+      where
+        (a,b) = B.splitAt (B.length bs `div` 2) bs
+        n = fromIntegral (B.length a)
+        same = length [ () | (x,y) <- B.zip a b, x == y ]
 
 getXor :: SGet Word8
 getXor = do
@@ -307,7 +314,7 @@ getXor = do
 getChecksum :: SGet Word32
 getChecksum = do
     l <- getLength
-    getSegAt (l-4) "Checksum" $ getWord32
+    getSegAt (l-4) "Checksum" getWord32
 
 calcChecksum :: SGet Word32
 calcChecksum = do

src/Lint.hs

@@ -8,23 +8,31 @@ import qualified Data.Map as M
 import Types
 import PrettyPrint
 
-lintTipToi :: TipToiFile -> Segments -> IO ()
+lintTipToi :: TipToiFile -> Segments -> IO (Bool)
 lintTipToi tt segments = do
     let hyps = [ (hyp1, "play indicies are correct")
-               , (hyp2 (fromIntegral (length (ttAudioFiles tt))),
-                  "media indicies are correct")
+               , (hyp2, "media indicies are correct")
+               , (hyp3, "at most one jump per line, as last action")
                ]
-    forM_ hyps $ \(hyp, desc) -> do
+    hyp_result <- forM hyps $ \(hyp, desc) -> do
         let wrong = filter (not . hyp) (concat (mapMaybe snd (ttScripts tt)))
         if null wrong
-        then printf "All lines do satisfy hypothesis \"%s\"!\n" desc
+        then do
+            printf "All lines do satisfy hypothesis \"%s\"!\n" desc
+            return True
         else do
             printf "These lines do not satisfy hypothesis \"%s\":\n" desc
             forM_ wrong $ \line -> do
                 printf "    %s\n" (ppLine M.empty line)
+            return False
 
-    forM_ (fromMaybe [] (ttMediaFlags tt)) $ \f ->
-        when (f > 1) $ printf "Media flag >1: %d" f
+    media_result <- forM (fromMaybe [] (ttMediaFlags tt)) $ \f ->
+        if (f > 1)
+        then do
+            printf "Media flag >1: %d" f
+            return False
+        else do
+            return True
 
     let overlapping_segments =
             filter (\((o1,l1,_),(o2,l2,_)) -> o1+l1 > o2) $
@@ -33,6 +41,9 @@ lintTipToi tt segments = do
         printf "Overlapping segments: %d\n"
             (length overlapping_segments)
         mapM_ (uncurry report) overlapping_segments
+
+    let no_failures = (all (==True)) $ (hyp_result ++ media_result ++ [null overlapping_segments])
+    return no_failures
   where
     hyp1 :: Line ResReg -> Bool
     hyp1 (Line _ _ as mi) = all ok as
@@ -41,8 +52,18 @@ lintTipToi tt segments = do
                          0 <= b && b < fromIntegral (length mi)
             ok _ = True
 
-    hyp2 :: Word16 -> Line ResReg -> Bool
-    hyp2 n (Line _ _ _ mi) = all (<= n) mi
+    media_count :: Word16
+    media_count  = fromIntegral (length (ttAudioFiles tt))
+
+    hyp2 :: Line ResReg -> Bool
+    hyp2 (Line _ _ _ mi) = all (< media_count) mi
+
+    max_one_jump_at_end [] = True
+    max_one_jump_at_end (Jump x : acts) = null acts
+    max_one_jump_at_end (x : acts) = max_one_jump_at_end acts
+
+    hyp3 :: Line ResReg -> Bool
+    hyp3 (Line _ _ as _) = max_one_jump_at_end as
 
     report :: Segment -> Segment -> IO ()
     report (o1,l1,d1) (o2,l2,d2)

src/TipToiYaml.hs

@@ -843,11 +843,9 @@ ttYaml2tt no_date dir (TipToiYAML {..}) extCodes = do
         Just (lang, txt) -> do
             Right <$> readFile' (ttsFileName lang txt)
         Nothing -> do
-            let paths = [ combine dir relpath
-                    | ext <- map snd fileMagics
-                    , let pat = fromMaybe "%s" ttyMedia_Path
-                    , let relpath = printf pat fn <.> ext
-                    ]
+            let pat = fromMaybe "%s" ttyMedia_Path
+            let basePath = printf pat fn
+            let paths = map (combine dir) (basePath : [basePath <.> ext | (_,ext) <- fileMagics ])
             ex <- filterM doesFileExist paths
             case ex of
                 [] -> do
@@ -884,7 +882,7 @@ ttYaml2tt no_date dir (TipToiYAML {..}) extCodes = do
         , ttGames = games
         , ttAudioFiles = files
         , ttAudioXor = knownXOR
-        , ttAudioFilesDoubles = False
+        , ttAudioFilesDoubles = Absent
         , ttMediaFlags = Nothing
         , ttChecksum = 0x00
         , ttChecksumCalc = 0x00
@@ -955,7 +953,7 @@ parsePlayList :: Parser [String]
 parsePlayList = P.commaSep lexer $ parseAudioRef
 
 parseAudioRef :: Parser String
-parseAudioRef = (P.lexeme lexer $ many1 (alphaNum <|> char '_')) <|> P.stringLiteral lexer
+parseAudioRef = (P.lexeme lexer $ many1 (alphaNum <|> char '_' <|> char '.')) <|> P.stringLiteral lexer
 
 parseScriptRef :: Parser String
 parseScriptRef = P.lexeme lexer $ many1 (alphaNum <|> char '_')

src/Types.hs

@@ -64,6 +64,7 @@ data Line r = Line Offset [Conditional r] [Command r] PlayList
 
 type ProductID = Word32
 
+data Similarity = Absent | Equal | Similar deriving (Show, Eq)
 
 data TipToiFile = TipToiFile
     { ttProductId :: ProductID
@@ -76,7 +77,7 @@ data TipToiFile = TipToiFile
     , ttScripts :: [(Word16, Maybe [Line ResReg])]
     , ttGames :: [Game]
     , ttAudioFiles :: [B.ByteString]
-    , ttAudioFilesDoubles :: Bool
+    , ttAudioFilesDoubles :: Similarity
     , ttAudioXor :: Word8
     , ttMediaFlags :: Maybe [Word16]
     , ttBinaries1 :: [(B.ByteString, B.ByteString)]

testsuite/.gitignore

@@ -1,3 +1,5 @@
 output
 ./downloaded
+./all-gmes
 !expected/**
+

testsuite/README.md

@@ -1,7 +1,11 @@
 A small test suite for tttool
+-----------------------------
 
-The script `download.sh` downloads a few GME files into the directory
-`downloaded/`
+The script `download.sh` downloads a those GME files listed in
+`gme-files-test.txt` into the directory `downloaded/`. This is a subset of
+Ravensburger GMEs, useful for testing.
+
+Feel free to propose a different set of GME files to include in the test
 
 The script `test.sh` runs a bunch of `tttool` commands on the files in `input/`
 and `downloaded/`, putting the result in `output/`
@@ -24,3 +28,15 @@ To run the test suite with nix, run
 If the downloaded files changed, change the `outputHash` in
 `../default.nix` a bit, run the above, and then copy the new hash from the
 error message into the `.nix` file.
+
+
+Getting more GMEs
+-----------------
+
+To test theories or search for certain things, it might be useful to fetch all
+GMEs. For that, run
+
+     ./list-gmes.sh
+     ./download.sh gme-files-all.txt all-gmes
+
+Warning, this downloads ~6GB.

testsuite/download.sh

@@ -1,19 +1,11 @@
 #!/usr/bin/env bash
 
 set -e
-dir="${1:-downloaded}"
+gmes="${1:-gme-files-test.txt}"
+dir="${2:-downloaded}"
 
 mkdir -p "$dir"
-cd "$dir"
-
-# We used to have a script that would fetch an .xml file from ravensburger
-# that lists all GME files, but that XML file disappeared.
-# For now, just list some GME files
-
-function get() {
-  wget --no-verbose --timestamping --no-check-certificate \
-    https://ssl-static.ravensburger.de/db/applications/"$1"
-}
-
-get WissenQuizzen1.gme
-get Pocketwissen_Feuerwehr.gme
+while read -r filename; do
+  wget --no-verbose --timestamping --no-check-certificate -P "$dir" \
+    https://ssl-static.ravensburger.de/db/applications/"$filename"
+done < "$gmes"

testsuite/expected/downloaded/Alle meine Tiere.gme.info.txt

@@ -0,0 +1,16 @@
+Product ID: 100
+Raw XOR value: 0x000000C6
+Magic XOR value: 0x55
+Comment: CHOMPTECH DATA FORMAT CopyRight 2009 Ver2.10.0901
+Date: 20170315
+Language: 
+Number of registers: 3
+Initial registers: [0,0,0]
+Initial sounds: [[18,25]]
+Scripts for OIDs from 4201 to 4282; 0/82 are disabled.
+Audio table entries: 543
+Audio table copy: Similar
+Binary tables entries: 0/0/0
+Single binary table entries: 1/1/1
+Special OIDs: 4210, 0
+Checksum found 0x6E379441, calculated 0x6E379441

testsuite/expected/downloaded/WissenQuizzen1.gme.lint.txt → testsuite/expected/downloaded/Alle meine Tiere.gme.lint.txt

@@ -1,2 +1,3 @@
 All lines do satisfy hypothesis "play indicies are correct"!
 All lines do satisfy hypothesis "media indicies are correct"!
+All lines do satisfy hypothesis "at most one jump per line, as last action"!

testsuite/expected/downloaded/Alle meine Tiere.gme.yaml.md5sum

@@ -0,0 +1 @@
+0fd54c3bbb1a88b494972a2547b08f9f  output/downloaded/Alle meine Tiere.gme.yaml

testsuite/expected/downloaded/Dein Koerper und Du.gme.info.txt

@@ -0,0 +1,16 @@
+Product ID: 61
+Raw XOR value: 0x000000FA
+Magic XOR value: 0x16
+Comment: CHOMPTECH DATA FORMAT CopyRight 2009 Ver2.10.0901
+Date: 20141021
+Language: 
+Number of registers: 71
+Initial registers: [1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
+Initial sounds: [[1447,317],[317]]
+Scripts for OIDs from 5670 to 9969; 3709/4300 are disabled.
+Audio table entries: 1448
+Audio table copy: Equal
+Binary tables entries: 1/1/1
+Single binary table entries: 1/1/1
+Special OIDs: 9756, 0
+Checksum found 0x0092FB3D, calculated 0x0092FB3D

testsuite/expected/downloaded/Pocketwissen_Feuerwehr.gme.lint.txt → testsuite/expected/downloaded/Dein Koerper und Du.gme.lint.txt

@@ -1,2 +1,3 @@
 All lines do satisfy hypothesis "play indicies are correct"!
 All lines do satisfy hypothesis "media indicies are correct"!
+All lines do satisfy hypothesis "at most one jump per line, as last action"!

testsuite/expected/downloaded/Dein Koerper und Du.gme.yaml.md5sum

@@ -0,0 +1 @@
+e2f933effc132ed235888e4f0bf22e8f  output/downloaded/Dein Koerper und Du.gme.yaml

testsuite/expected/downloaded/Duell-der-Superquizzer.gme.info.txt

@@ -0,0 +1,16 @@
+Product ID: 137
+Raw XOR value: 0x000000D2
+Magic XOR value: 0x4D
+Comment: CHOMPTECH DATA FORMAT CopyRight 2009 Ver2.10.0901
+Date: 20190215
+Language: 
+Number of registers: 3
+Initial registers: [1,0,0]
+Initial sounds: [[29,44,108]]
+Scripts for OIDs from 4100 to 4300; 0/201 are disabled.
+Audio table entries: 2115
+Audio table copy: Similar
+Binary tables entries: 1/1/1
+Single binary table entries: 1/1/1
+Special OIDs: 4105, 0
+Checksum found 0xFD752110, calculated 0xFD752110

testsuite/expected/downloaded/Duell-der-Superquizzer.gme.lint.txt

@@ -0,0 +1,3 @@
+All lines do satisfy hypothesis "play indicies are correct"!
+All lines do satisfy hypothesis "media indicies are correct"!
+All lines do satisfy hypothesis "at most one jump per line, as last action"!

testsuite/expected/downloaded/Duell-der-Superquizzer.gme.yaml.md5sum

@@ -0,0 +1 @@
+61a09460d93d53c8c5383248973bf1a7  output/downloaded/Duell-der-Superquizzer.gme.yaml

testsuite/expected/downloaded/Expedition Wissen - Aegypten.gme.info.txt

@@ -0,0 +1,16 @@
+Product ID: 34
+Raw XOR value: 0x00000025
+Magic XOR value: 0xDE
+Comment: CHOMPTECH DATA FORMAT CopyRight 2009 Ver2.10.0901
+Date: 20150114
+Language: 
+Number of registers: 51
+Initial registers: [1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
+Initial sounds: [[907,908],[908]]
+Scripts for OIDs from 34 to 3583; 3018/3550 are disabled.
+Audio table entries: 909
+Audio table copy: Equal
+Binary tables entries: 14/14/14
+Single binary table entries: 1/1/1
+Special OIDs: 3010, 3009
+Checksum found 0xC3F06F70, calculated 0xC3F06F70

testsuite/expected/downloaded/Expedition Wissen - Aegypten.gme.lint.txt

@@ -0,0 +1,3 @@
+All lines do satisfy hypothesis "play indicies are correct"!
+All lines do satisfy hypothesis "media indicies are correct"!
+All lines do satisfy hypothesis "at most one jump per line, as last action"!

testsuite/expected/downloaded/Expedition Wissen - Aegypten.gme.yaml.md5sum

@@ -0,0 +1 @@
+0a99dc6315e77ff0efb0c91928480327  output/downloaded/Expedition Wissen - Aegypten.gme.yaml

testsuite/expected/downloaded/Leserabe Drache.gme.info.txt

@@ -0,0 +1,16 @@
+Product ID: 32
+Raw XOR value: 0x00000024
+Magic XOR value: 0xA1
+Comment: CHOMPTECH DATA FORMAT CopyRight 2009 Ver2.10.0901
+Date: 20141127
+Language: GERMANƒÚ
+Number of registers: 45
+Initial registers: [1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
+Initial sounds: [[1007,1008]]
+Scripts for OIDs from 1008 to 5547; 3755/4540 are disabled.
+Audio table entries: 1009
+Audio table copy: Equal
+Binary tables entries: 12/12/12
+Single binary table entries: 1/1/1
+Special OIDs: 4902, 4901
+Checksum found 0x848AC808, calculated 0x848AC808

testsuite/expected/downloaded/Leserabe Drache.gme.lint.txt

@@ -0,0 +1,3 @@
+All lines do satisfy hypothesis "play indicies are correct"!
+All lines do satisfy hypothesis "media indicies are correct"!
+All lines do satisfy hypothesis "at most one jump per line, as last action"!

testsuite/expected/downloaded/Leserabe Drache.gme.yaml.md5sum

@@ -0,0 +1 @@
+dafec43004052b310638581994076b1a  output/downloaded/Leserabe Drache.gme.yaml