-- VisualizeGameASCII.hs
-- Tom Moertel <tom@moertel.com>
-- CVS $Id: VisualizeGameASCII.hs,v 1.1 2002/09/09 04:58:06 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.Array
import Data.Char
import Data.List (intersperse)
import Data.FiniteMap
import System.Environment

import ANSIColor
import BasicTypes
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" $ zipWith visTurn gss [0..]
    where
    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    -> '?'

    visTurn             :: GameState -> Int -> String
    visTurn gs@(GS rbtK pkgK) turnNumber
                        =  unlines [ "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 rbtAlive 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  =  if rbtAlive rbt then "Alive" else "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 [0| 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' cc []     =  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.
--
-- =================================================================