tttool-1.6: src/PrettyPrint.hs
{-# LANGUAGE TypeSynonymInstances, RecordWildCards #-}
module PrettyPrint where
import qualified Data.ByteString.Lazy as B
import Text.Printf
import Data.List
import Data.Maybe
import qualified Data.Map as M
import Types
-- Pretty printing
lineHex bytes l = prettyHex $ extract (lineOffset l) (lineLength l) bytes
extract :: Offset -> Word32 -> B.ByteString -> B.ByteString
extract off len = B.take (fromIntegral len) . B.drop (fromIntegral off)
lineOffset (Line o _ _ _) = o
lineLength :: Line r -> Word32
lineLength (Line _ conds cmds audio) = fromIntegral $
2 + 8 * length conds + 2 + 7 * length cmds + 2 + 2 * length audio
ppLine :: Transscript -> Line ResReg -> String
ppLine t (Line _ cs as xs) = spaces $
map ppConditional cs ++ map (ppCommand False t xs) as
-- Varaint that does not generate invalid play commands
exportLine :: Line ResReg -> String
exportLine (Line _ cs as xs) = spaces $
map ppConditional cs ++ map (ppCommand True M.empty xs) as
-- Group consecutive runs of numbers, if they do not have a description
groupRuns :: (Eq a, Bounded a, Enum a) => (a -> Maybe b) -> [a] -> [Either b [a]]
groupRuns l = go
where
go [] = []
go [x] = case l x of Nothing -> [Right [x]]
Just s -> [Left s]
go (x:xs) = case l x of
Just l -> Left l : go xs
Nothing -> case go xs of
Right (y:ys):r'
| x /= maxBound
, succ x == y -> Right (x:y:ys) : r'
r -> Right [x] : r
ppPlayList :: Transscript -> PlayList -> String
ppPlayList t xs = "[" ++ commas (map go (groupRuns (flip M.lookup t) xs)) ++ "]"
where go (Left s) = quote s
go (Right []) = error "Empty list in groupRuns result"
go (Right l) | length l > 3 = show (head l) ++ ".." ++ show (last l)
| otherwise = commas (map show l)
ppOidList :: [OID] -> String
ppOidList xs = "[" ++ commas (map go (groupRuns (const Nothing) xs)) ++ "]"
where go (Left s) = s
go (Right []) = error "Empty list in groupRuns result"
go (Right l) | length l > 3 = show (head l) ++ ".." ++ show (last l)
| otherwise = commas (map show l)
ppPlayListList :: Transscript -> PlayListList -> String
ppPlayListList t xs = "[" ++ commas (map (ppPlayList t) xs) ++ "]"
ppConditional :: Conditional ResReg -> String
ppConditional (Cond v1 o v2) = printf "%s%s%s?" (ppTVal v1) (ppCondOp o) (ppTVal v2)
ppCondOp :: CondOp -> String
ppCondOp Eq = "=="
ppCondOp NEq = "!="
ppCondOp Lt = "< "
ppCondOp Gt = "> "
ppCondOp GEq = ">="
ppCondOp LEq = "<="
ppCondOp (Unknowncond b) = printf "?%s?" (prettyHex b)
ppTVal :: Reg r => TVal r -> String
ppTVal (Reg r) = ppReg r
ppTVal (Const n) = show n
ppResReg :: ResReg -> String
ppResReg n = "$" ++ show n
ppRegister :: Register -> String
ppRegister (RegPos n) = "$" ++ show n
ppRegister (RegName n) = "$" ++ n
class Reg a where
ppReg :: a -> String
instance Reg ResReg where ppReg = ppResReg
instance Reg Register where ppReg = ppRegister
ppArithOp :: ArithOp -> String
ppArithOp Inc = "+="
ppArithOp Dec = "-="
ppArithOp Mult = "*="
ppArithOp Div = "/="
ppArithOp Mod = "%="
ppArithOp And = "&="
ppArithOp Or = "|="
ppArithOp XOr = "^="
ppArithOp Set = ":="
ppCommand :: Reg r => Bool -> Transscript -> PlayList -> Command r -> String
ppCommand True t xs p
| any (not . validIndex xs) (indices p) = ""
ppCommand _ t xs (Play n) = printf "P(%s)" $ ppPlayIndex t xs (fromIntegral n)
ppCommand _ t xs (Random a b) = printf "P(%s)" $ ppPlayRange t xs [b..a]
ppCommand _ t xs (PlayAll a b) = printf "PA(%s)" $ ppPlayRange t xs [b..a]
ppCommand _ t xs PlayAllVariant = printf "PA*(%s)" $ ppPlayAll t xs
ppCommand _ t xs RandomVariant = printf "P*(%s)" $ ppPlayAll t xs
ppCommand _ t xs Cancel = printf "C"
ppCommand _ t xs (Jump v) = printf "J(%s)" (ppTVal v)
ppCommand _ t xs (Timer r v) = printf "T(%s,%s)" (ppReg r) (ppTVal v)
ppCommand _ t xs (NamedJump v) = printf "J(%s)" v
ppCommand _ t xs (Game b) = printf "G(%d)" b
ppCommand _ t xs (ArithOp o r n) = ppReg r ++ ppArithOp o ++ ppTVal n
ppCommand _ t xs (Neg r) = printf "Neg(%s)" (ppReg r)
ppCommand _ t xs (Unknown b r n) = printf "?(%s,%s) (%s)" (ppReg r) (ppTVal n) (prettyHex b)
indices :: Command r -> [Int]
indices (Play n) = [fromIntegral n]
indices (Random a b) = map fromIntegral [b..a]
indices (PlayAll a b) = map fromIntegral [b..a]
indices _ = []
validIndex :: PlayList -> Int -> Bool
validIndex xs n = n >= 0 && n < length xs
ppPlayIndex :: Transscript -> PlayList -> Int -> String
ppPlayIndex t xs n | validIndex xs n = transcribe t (xs !! n)
| otherwise = "invalid_index_" ++ show n
ppPlayRange :: Transscript -> PlayList -> [Word8] -> String
ppPlayRange t xs = commas . map (ppPlayIndex t xs . fromIntegral)
ppPlayAll :: Transscript -> PlayList -> String
ppPlayAll t = commas . map (transcribe t)
spaces = intercalate " "
commas = intercalate ","
quote s = printf "'%s'" s
ppCommonGame :: Transscript -> Game -> String
ppCommonGame t g =
printf (unlines [" type: %d",
" rounds: %d",
" unknown (c): %d",
" early rounds: %d",
" repeat last media OID: %d",
" unknown (x): %d",
" unknown (w): %d",
" unknown (v): %d",
" start play list: %s",
" round end play list: %s",
" finish play list: %s",
" round start play list: %s",
" later round start play list: %s",
" subgames: (%d)", "%s",
" target scores: (%d) %s",
" finish play lists: (%d)", "%s"
])
(gameType g)
(gRounds g)
(gUnknownC g)
(gEarlyRounds g)
(gRepeatLastMedia g)
(gUnknownX g) (gUnknownW g) (gUnknownV g)
(ppPlayListList t (gStartPlayList g))
(ppPlayListList t (gRoundEndPlayList g))
(ppPlayListList t (gFinishPlayList g))
(ppPlayListList t (gRoundStartPlayList g))
(ppPlayListList t (gLaterRoundStartPlayList g))
(length (gSubgames g)) (ppSubGames t (gSubgames g))
(length (gTargetScores g)) (show (gTargetScores g))
(length (gFinishPlayLists g))(indent 4 (map (ppPlayListList t) (gFinishPlayLists g)))
ppGame :: Transscript -> Game -> String
ppGame t g@(CommonGame {..}) =
ppCommonGame t g
ppGame t (Game6 {..}) =
printf (unlines [" type: 6",
" rounds: %d",
" bonus rounds: %d",
" rounds target: %d",
" unknown (i): %d",
" early rounds: %d",
" unknown (q): %d",
" repeat last media OID: %d",
" unknown (x): %d",
" unknown (w): %d",
" unknown (v): %d",
" start play list: %s",
" round end play list: %s",
" finish play list: %s",
" round start play list: %s",
" later round start play list: %s",
" round start play list 2: %s",
" later round start play list 2: %s",
" bonus subgame count: %d",
" subgames: (%d)", "%s",
" target scores: (%d) %s",
" bonus target scores: (%d) %s",
" finish play lists: (%d)", "%s",
" bonus finish play lists: (%d)", "%s",
" bonus subgame ids: %s"
])
gRounds
gBonusRounds
gBonusTarget
gUnknownI
gEarlyRounds
gUnknownQ
gRepeatLastMedia
gUnknownX gUnknownW gUnknownV
(ppPlayListList t gStartPlayList)
(ppPlayListList t gRoundEndPlayList)
(ppPlayListList t gFinishPlayList)
(ppPlayListList t gRoundStartPlayList)
(ppPlayListList t gLaterRoundStartPlayList)
(ppPlayListList t gRoundStartPlayList2)
(ppPlayListList t gLaterRoundStartPlayList2)
gBonusSubgameCount
(length gSubgames) (ppSubGames t gSubgames)
(length gTargetScores) (show gTargetScores)
(length gBonusTargetScores) (show gBonusTargetScores)
(length gFinishPlayLists) (indent 4 (map (ppPlayListList t) gFinishPlayLists))
(length gBonusFinishPlayLists) (indent 4 (map (ppPlayListList t) gBonusFinishPlayLists))
(show gBonusSubgameIds)
ppGame t g@(Game7 {..}) = (ppCommonGame t g ++) $
printf (unlines [ " subgame groups: %s"
])
(show gSubgameGroups)
ppGame t g@(Game8 {..}) = (ppCommonGame t g ++) $
printf (unlines [" game select OIDs: %s",
" game select games: %s",
" game select errors 1: %s",
" game select errors 2: %s"
])
(show gGameSelectOIDs)
(show gGameSelect)
(ppPlayListList t gGameSelectErrors1)
(ppPlayListList t gGameSelectErrors2)
ppGame t g@(Game9 {..}) = (ppCommonGame t g ++) $
printf (unlines [" extra play lists (%d):","%s"
])
(length gExtraPlayLists) (indent 4 (map (ppPlayListList t) gExtraPlayLists))
ppGame t g@(Game10 {..}) = (ppCommonGame t g ++) $
printf (unlines [" extra play lists (%d):","%s"
])
(length gExtraPlayLists) (indent 4 (map (ppPlayListList t) gExtraPlayLists))
ppGame t g@(Game16 {..}) = (ppCommonGame t g ++) $
printf (unlines [" extra OIDs (%d): %s",
" extra play lists (%d):","%s"
])
(length gExtraOIDs) (show gExtraOIDs)
(length gExtraPlayLists) (indent 4 (map (ppPlayListList t) gExtraPlayLists))
ppGame t Game253 =
printf (unlines [" type: 253"
])
ppSubGames :: Transscript -> [SubGame] -> String
ppSubGames t = concatMap (uncurry (ppSubGame t)) . zip [0..]
ppSubGame :: Transscript -> Int -> SubGame -> String
ppSubGame t n (SubGame u oids1 oids2 oids3 plls) = printf (unlines
[ " Subgame %d:"
, " u: %s"
, " oids1: %s"
, " oids2: %s"
, " oids3: %s"
, " playlist: (%d)" , "%s"
])
n
(prettyHex u)
(ppOidList oids1) (ppOidList oids2) (ppOidList oids3)
(length plls) (indent 8 (map (ppPlayListList t) plls))
indent :: Int -> [String] -> String
indent n = intercalate "\n" . map (replicate n ' ' ++)
checkLine :: Int -> Line ResReg -> [String]
checkLine n_audio l@(Line _ _ _ xs)
| any (>= fromIntegral n_audio) xs
= return $ "Invalid audio index in line " ++ ppLine M.empty l
checkLine n_audio _ = []
prettyHex :: B.ByteString -> String
prettyHex = intercalate " " . map (printf "%02X") . B.unpack
transcribe :: Transscript -> Word16 -> String
transcribe t idx = fromMaybe (show idx) (M.lookup idx t)
ppDesc :: [String] -> String
ppDesc = intercalate "/"