tttool play: improve handling of the J command (#231)

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)

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/GMERun.hs

@@ -102,8 +102,17 @@ playTTAudio i = do
     let bs = ttAudioFiles tt !! fromIntegral i
     liftIO $ playSound bs
 
+-- Rules for J(): jumps are executed last; the last J() wins.
+-- Effectively this is like a jump register is set, which is consulted after
+-- all other commands have executed. Simulate this by moving the last Jump
+-- to the end of the list and discarding all others.
+moveJumpsLast Nothing  []              = []
+moveJumpsLast (Just x) []              = [x]
+moveJumpsLast _        (Jump v : acts) = moveJumpsLast (Just (Jump v)) acts
+moveJumpsLast j        (x : acts)      = x : (moveJumpsLast j acts)
+
 applyLine :: Line Word16 -> GMEM Word16 ()
-applyLine (Line _ _ acts playlist) = go acts
+applyLine (Line _ _ acts playlist) = go (moveJumpsLast Nothing acts)
   where
     go (Neg r : acts) = do
         modReg r neg

src/Lint.hs

@@ -11,8 +11,7 @@ import PrettyPrint
 lintTipToi :: TipToiFile -> Segments -> IO ()
 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")
                ]
     forM_ hyps $ \(hyp, desc) -> do
         let wrong = filter (not . hyp) (concat (mapMaybe snd (ttScripts tt)))
@@ -41,8 +40,11 @@ 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
 
     report :: Segment -> Segment -> IO ()
     report (o1,l1,d1) (o2,l2,d2)

src/TipToiYaml.hs

@@ -884,7 +884,7 @@ ttYaml2tt no_date dir (TipToiYAML {..}) extCodes = do
         , ttGames = games
         , ttAudioFiles = files
         , ttAudioXor = knownXOR
-        , ttAudioFilesDoubles = False
+        , ttAudioFilesDoubles = Absent
         , ttMediaFlags = Nothing
         , ttChecksum = 0x00
         , ttChecksumCalc = 0x00

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/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/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,2 @@
+All lines do satisfy hypothesis "play indicies are correct"!
+All lines do satisfy hypothesis "media indicies are correct"!

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,2 @@
+All lines do satisfy hypothesis "play indicies are correct"!
+All lines do satisfy hypothesis "media indicies are correct"!

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,2 @@
+All lines do satisfy hypothesis "play indicies are correct"!
+All lines do satisfy hypothesis "media indicies are correct"!

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

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

testsuite/expected/downloaded/Pocket Wissen - Baustellenfahrzeuge.gme.info.txt

@@ -0,0 +1,16 @@
+Product ID: 113
+Raw XOR value: 0x000000DB
+Magic XOR value: 0xB0
+Comment: CHOMPTECH DATA FORMAT CopyRight 2009 Ver2.10.0901
+Date: 20170829
+Language: 
+Number of registers: 41
+Initial registers: [1,99,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: [[283,342]]
+Scripts for OIDs from 113 to 9516; 9230/9404 are disabled.
+Audio table entries: 489
+Audio table copy: Similar
+Binary tables entries: 9/9/9
+Single binary table entries: 1/1/1
+Special OIDs: 9307, 9306
+Checksum found 0x7224D523, calculated 0x7224D523

testsuite/expected/downloaded/Pocket Wissen - Baustellenfahrzeuge.gme.lint.txt

@@ -0,0 +1,2 @@
+All lines do satisfy hypothesis "play indicies are correct"!
+All lines do satisfy hypothesis "media indicies are correct"!

testsuite/expected/downloaded/Pocket Wissen - Baustellenfahrzeuge.gme.yaml.md5sum

@@ -0,0 +1 @@
+d07aa7d8a23e0c44434ef65480a2cdc2  output/downloaded/Pocket Wissen - Baustellenfahrzeuge.gme.yaml

testsuite/expected/downloaded/Puzzle Ritterburg.gme.info.txt

@@ -0,0 +1,15 @@
+Product ID: 15
+Raw XOR value: 0x000000EA
+Magic XOR value: 0xE2
+Comment: CHOMPTECH DATA FORMAT CopyRight 2009 Ver2.6.0925
+Date: 20110126
+Language: 
+Number of registers: 1
+Initial registers: [1]
+Initial sounds: [[374,375]]
+Scripts for OIDs from 5710 to 5824; 1/115 are disabled.
+Audio table entries: 376
+Audio table copy: Equal
+Binary tables entries: 0/0/0
+Single binary table entries: 0/0/0
+Checksum found 0x486306C9, calculated 0x486306C9

testsuite/expected/downloaded/Puzzle Ritterburg.gme.lint.txt

@@ -0,0 +1,2 @@
+All lines do satisfy hypothesis "play indicies are correct"!
+All lines do satisfy hypothesis "media indicies are correct"!

testsuite/expected/downloaded/Puzzle Ritterburg.gme.yaml.md5sum

@@ -0,0 +1 @@
+236e4880e363464432929168c6ce02a1  output/downloaded/Puzzle Ritterburg.gme.yaml

testsuite/expected/downloaded/Sprichst_Du_Englisch.gme.info.txt

@@ -0,0 +1,16 @@
+Product ID: 118
+Raw XOR value: 0x0000002F
+Magic XOR value: 0x6E
+Comment: CHOMPTECH DATA FORMAT CopyRight 2009 Ver2.10.0901
+Date: 20170722
+Language: 
+Number of registers: 23
+Initial registers: [1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0]
+Initial sounds: [[3,4,563]]
+Scripts for OIDs from 11201 to 11938; 131/738 are disabled.
+Audio table entries: 1209
+Audio table copy: Equal
+Binary tables entries: 1/1/1
+Single binary table entries: 1/1/1
+Special OIDs: 11817, 0
+Checksum found 0x6562C2BA, calculated 0x6562C2BA

testsuite/expected/downloaded/Sprichst_Du_Englisch.gme.lint.txt

@@ -0,0 +1,2 @@
+All lines do satisfy hypothesis "play indicies are correct"!
+All lines do satisfy hypothesis "media indicies are correct"!

testsuite/expected/downloaded/Sprichst_Du_Englisch.gme.yaml.md5sum

@@ -0,0 +1 @@
+f5e67b74de9ab84284e8774c18f8676b  output/downloaded/Sprichst_Du_Englisch.gme.yaml