content: {-# LANGUAGE 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 (`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 (Const 0)) = printf "PA*(%s)"    (ppPlayAll t xs)
  ppCommand _ t xs (PlayAllVariant v)         = printf "PA*(%s)(%s)" (ppPlayAll t xs) (ppTVal v)
  ppCommand _ t xs (RandomVariant (Const 0))  = printf "P*(%s)"     (ppPlayAll t xs)
  ppCommand _ t xs (RandomVariant v)          = printf "P*(%s)(%s)"  (ppPlayAll t xs) (ppTVal v)
  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 "/"
  