-- VisualizeGameASCII.hs
-- Tom Moertel <tom@moertel.com>
-- CVS $Id: VisualizeGameASCII.hs,v 1.4 2002/09/12 03:18:55 thor Exp $

-- | The VisualizeGameASCII filter converts a Game (read from standard
-- input) into an ASCII text stream that visualizes each turn of the
-- game.


module Main (main) where

import Data.Char
import Data.List (intersperse)
import Data.FiniteMap
import System.Environment

import ANSIColor
import Board
import Eval
import Game
import GameState
import GetInput

type Colorizer          =  String -> String

-- | Main entry point.  We set up the colorzing function based on
-- whether the user passed the @--colorize@ option and then pass
-- the standard input to the 'visualize' function.


main                    :: IO ()
main                    =  do
                           args <- getArgs
                           let colorfn = if null (filter (==opt) args)
                                         then id else colorize
                           interactFromArgs (filter (/=opt) args) $
                               visualize colorfn . read
    where
    opt                 =  "--colorize"


-- | Visualizes the given game using the given colorizer.

visualize               :: Colorizer -> Game -> String
visualize colorfn g     =  (joinWith "\f\n" $ map visTurn gss) ++ end
    where
    end                 =  unlines $ "\nEND OF GAME" 
                                   : joinWith [] (map how (gameEpilogues g))
    how (rid,turn,msgs) =  [ "Robot " ++ show rid 
                             ++ " finished on turn " ++ show turn
                             ++ ". Server info follows:"
                           , unlines $ 
                             if null msgs then ["(No more info)"] else msgs 
                           ]
    gss                 =  evalGame g
    boardRowsRev        =  reverse . lines . drawBoard . gameBoard $ g
    turnRobotIDs gs     =  keysFM (gsRobots gs)
    initialRIDs         =  turnRobotIDs (gss !! 1)
    robotLabelTable     =  zip initialRIDs ['a' .. ]
    robotLabel rbt      =  case lookup (rbtID rbt) robotLabelTable of
                               Just label -> label
                               Nothing    -> '?'
    title               =  joinWith " v. " names
    names               =  [ map toUpper nm ++ "(" ++ show rid ++ ")" 
                             | (rid,nm) <- gameRobotNames g]

    visTurn             :: GameState -> String
    visTurn (GS rbtK pkgK _ turnNumber) 
                        =  unlines [ title
                                   , "Turn " ++ show turnNumber
                                   , colorfn boardVis, stats]
        where
        boardVis        =  unlines . reverse . zipWith drawRow [1..] $
                               boardRowsRev
        stats           =  unlines . map robotStats $ allRobots
        drawRow row cs  =  zipWith drawCell [(col,row) | col <- [1..]] cs
        drawCell loc c  =  case lookupFM robotLocFM loc of
                               Just (rbt:_)  -> robotLabel rbt
                               Nothing       -> c
                               _             -> error "drawCell: impossible"
        allRobots       =  eltsFM rbtK
        liveRobots      =  filter rbtAliveStart allRobots
        robotLocFM      =  keyedGroups rbtLocation liveRobots

        package pid     =  let Just pkg = lookupFM pkgK pid in pkg

        robotStats      :: Robot -> String
        robotStats rbt  =  label : ( ": ("       ++ idStats ++ ")" ++
                                     "  "        ++ aliveStats     ++
                                     "  S="      ++ scoreStats     ++
                                     "  $="      ++ moneyStats     ++
                                     "  W="      ++ weightStats    ++
                                     "  Pkgs="   ++ pkgStats
                                   )
            where
            label       =  robotLabel rbt
            idStats     =  digN 2 (rbtID rbt)
            aliveStats  =  case (rbtAliveStart rbt, rbtAliveEnd rbt) of
                               (True,  True) -> "Alive"
                               (True, False) -> "Dying"
                               _             -> "Dead "
            scoreStats  =  case rbtScore rbt of
                               Just score -> digN 5 score
                               _          -> "?????"
            moneyStats  =  case rbtMoney rbt of
                               Just money -> digN 5 money
                               _          -> "?????"
            weightStats =  digN 4 knownWeight ++ unkwnWeight
            knownWeight =  sum [w | Just w <- rawWeights]
            unkwnWeight =  if null [()| Nothing<-rawWeights] then " " else "+"
            rawWeights  =  map (pkgWeight . package) rpkgs
--          locStats    =  take 9 (show (rbtLocation rbt) ++ replicate 10 ' ')
            pkgStats    =  show rpkgs
            rpkgs       =  rbtPackages rbt


-- |Add colors to the ASCII art visualizations

colorize                :: String -> String
colorize                =  colorize' ANSI_Reset
    where
    reset               =  acode ANSI_Reset
    colorize' _ []      =  reset
    colorize' cc (x:xs) =  if cc == cc' then x : colorize' cc xs
                           else reset ++ acode cc' ++ (x : colorize' cc' xs)
        where
        cc'             =  colorCode x

-- | Pick the appropriate color coding for each type of game piece.

colorCode               :: Char -> ANSICode
colorCode c
    | c == '~'          =  ANSI_Foreground ANSI_Blue
    | c == '#'          =  ANSI_Reset
    | c == '@'          =  ANSI_Foreground ANSI_Green
    | c == '.'          =  ANSI_Reset
    | isUpper c         =  ANSI_Foreground ANSI_Red -- package
    | isLower c         =  ANSI_Foreground ANSI_Magenta -- robot
    | otherwise         =  ANSI_Reset

-- |Given a keying function and a list of elements, apply the keying
-- function to the elements, and then group the elements based on
-- their keys, emitting the result a finite map over the keys.  For
-- example, (keyedGroups length) results in a function that will group
-- lists by length, returning a value of type (FiniteMap Int [a]),
-- where, e.g., all lists of length 3 are grouped into a list that is
-- stored under the key 3 in the finite map. The variant keyedGroupsL
-- returns a lookup list of type [(keyType, [a])] instead of a finite
-- map.

keyedGroups             :: (Ord a, Ord key) =>
                             (a -> key) -> [a] -> FiniteMap key [a]
keyedGroups keyFn       =  addListToFM_C (flip (++)) emptyFM
                        .  map ( \x -> (keyFn x, [x]) )

-- | Joins lists (typically Strings) with a given separator list.

joinWith                :: [a] -> [[a]] -> [a]
joinWith sep            =  concat . intersperse sep


-- | Show an integral number using n digits

digN                    :: (Integral a) => a -> a -> String
digN n num              =  tail (show $ 10^n + num)


-- =================================================================
--
-- Copyright (C) 2002 Thomas Moertel.
-- 
-- 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.
-- 
-- The text of the GNU GPL may be found in the LICENSE file,
-- included with this software, or online at the following URL:
-- 
--     http://www.gnu.org/copyleft/gpl.html
-- 
-- 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.
-- 
-- Except as provided for under the terms of the GNU GPL, all rights
-- are reserved worldwide.
--
-- =================================================================