ghc/tests/programs/andy_cherry/PrintTEX.lhs

   1 > module PrintTEX (texPrinter) where
   2
   3 > import GenUtils
   4 > import DataTypes
   5 > import Array -- 1.3
   6 > import Char -- 1.3
   7
   8 This is the driver that prints a file suitable for input into latex.
   9
  10 print_TeX_move :: String -> MoveNumber ->
  11
  12 1. turn [Quantum] -> [[Quantum]]
  13
  14 > splitUpQuantum :: [Quantum] -> [[Quantum]]
  15 > splitUpQuantum q = splitUpQuantums q []
  16 >   where
  17 >       splitUpQuantums [] [] = []
  18 >       splitUpQuantums [] mvs = [reverse mvs]
  19 >       splitUpQuantums (mv@(QuantumMove _ _ _ _):rest) mvs
  20 >               = splitUpQuantums rest (mv:mvs)
  21 >       splitUpQuantums (mv@(QuantumNAG _):rest) mvs
  22 >               = splitUpQuantums rest mvs
  23 >       splitUpQuantums (x:xs) [] = [x] : splitUpQuantums xs []
  24 >       splitUpQuantums (x:xs) mvs
  25 >               = [reverse mvs,[x]] ++ splitUpQuantums xs []
  26
  27 > type TeXState =
  28 >       (Bool,          -- if Top level !
  29 >       Board,          -- current board
  30 >       MoveNumber)     -- the Current Move Number
  31
  32 > printTeXQuantums :: TeXState -> [Quantum] -> [String]
  33 > printTeXQuantums ps
  34 >       = concat . fst . mapAccumL printTeXQuantum ps . splitUpQuantum
  35
  36 > printTeXQuantum :: TeXState -> [Quantum] -> ([String],TeXState)
  37 > printTeXQuantum state@(_,board,_) [QuantumComment ["\004"]] =
  38 >       (mkTeXBoard board,state)
  39 > printTeXQuantum state@(_,board,_) [QuantumComment (('\004':comm):comms)] =
  40 >       (mkTeXBoard board ++ formatText 70 (parseSquiggles (comm:comms)),state)
  41 > printTeXQuantum state [QuantumComment comms] =
  42 >       (formatText 70 (parseSquiggles comms),state)
  43 > printTeXQuantum (pnt,brd,mv) [QuantumAnalysis anal] =
  44 >       (printTeXQuantums (False,err,decMove mv) anal,(pnt,brd,mv))
  45 >   where err = error "Syntax error using ^D"
  46 > printTeXQuantum state@(_,board,_) [QuantumResult str] =
  47 >       (mkTeXBoard board ++ [printTeXResult (mkResult str)],state)
  48 > printTeXQuantum state mvs@(QuantumMove _ _ _ _:_) =
  49 >       printTeXMoves state mvs
  50 > printTeXQuantum _ _ = error "PANIC: strange Quantum"
  51
  52
  53 > parseSquiggles = map parseSquiggle
  54 > parseSquiggle ('<':'s':'a':'w':'>':r) = "\\wbetter{}" ++ r
  55 > parseSquiggle ('<':'a':'w':'>':r)     = "\\wupperhand{}" ++ r
  56 > parseSquiggle ('<':'w':'a':'w':'>':r) = "\\wdecisive{}" ++ r
  57 > parseSquiggle ('<':'s':'a':'b':'>':r) = "\\bbetter{}" ++ r
  58 > parseSquiggle ('<':'a':'b':'>':r)     = "\\bupperhand{}" ++ r
  59 > parseSquiggle ('<':'w':'a':'b':'>':r) = "\\bdecisive{}" ++ r
  60 > parseSquiggle wd = wd
  61
  62
  63 > printTeXResult :: Result -> String
  64 > printTeXResult Win     = "$1\\!-\\!0$"
  65 > printTeXResult Loss    = "$0\\!-\\!1$"
  66 > printTeXResult Draw    = "${1 \\over 2}\\!-\\!{1 \\over 2}$"
  67 > printTeXResult Unknown = "$*$"
  68
  69 > printTeXMoves (tl,_,mv) mvs
  70 >       = ([text],(True,brd,incMove last_mv_num))
  71 >    where
  72 >       aux_mvs = zip3 mvs (iterate incMove mv) (False:repeat True)
  73
  74 >       (QuantumMove _ _ _ brd,last_mv_num,_) = last aux_mvs
  75 >       text = initText tl
  76 >           ++ concat (fst (mapAccumL (pntMove tl) (mv,False) mvs))
  77 >           ++ endText tl
  78
  79 >       initText False =
  80 >            case mv of
  81 >               MoveNumber i Black -> "|" ++ show i ++ "\\ldots~"
  82 >               _ -> "|"
  83 >       initText True =
  84 >               "\\begin{center}|\n" ++
  85 >               "{\\bf" ++
  86 >               "\\begin{tabular}{rp{50pt}p{50pt}}\n" ++
  87 >            case mv of
  88 >               MoveNumber i Black -> show i ++ " & \\ldots"
  89 >               _ -> ""
  90
  91 >       endText True = case getMoveColour last_mv_num of
  92 >               White -> "&\\\\\n\\end{tabular}}|\n\\end{center}"
  93 >               Black -> "\\end{tabular}}|\n\\end{center}"
  94 >       endText False =  "|"
  95
  96 Use zip here !
  97
  98 >       pntMove True (mv@(MoveNumber i White),bl) move
  99 >               = (show i ++ " & "
 100 >               ++ printableMove move,
 101 >                 (incMove mv,True))
 102 >       pntMove True (mv@(MoveNumber i Black),bl) move
 103 >               = (" & " ++ printableMove move ++ "\\\\\n",
 104 >                 (incMove mv,True))
 105 >       pntMove False (mv@(MoveNumber i White),bl) move
 106 >               = ((if bl then "; " else "") ++ show i ++ ".~"
 107 >                       ++ printableMove move,
 108 >                 (incMove mv,True))
 109 >       pntMove False (mv@(MoveNumber i Black),bl) move
 110 >               = ((if bl then ", " else "") ++ printableMove move,
 111 >                 (incMove mv,True))
 112
 113 > printableMove :: Quantum -> String
 114 > printableMove (QuantumMove move ch an _) = map fn move ++ rest
 115 >    where
 116 >       fn 'x' = '*'
 117 >       fn 'O' = '0'
 118 >       fn c   = c
 119 >       rest = case ch of
 120 >               "#" -> an ++ " mate"
 121 >               _   -> ch ++ an
 122
 123 > mkTeXBoard :: Board -> [String]
 124 > mkTeXBoard (Board arr _ _) =
 125 >       ["\n\\board"] ++
 126 >       ["{" ++ [ fn ((x-y) `rem` 2 == 0) (arr ! (x,y)) | x <- [1..8]] ++ "}"
 127 >                       | y <- reverse [1..8]] ++
 128 >       ["$$\\showboard$$"]
 129 >  where
 130 >       fn _ (WhitesSq p) = head (userFormat p)
 131 >       fn _ (BlacksSq p) = toLower (head (userFormat p))
 132 >       fn True VacantSq = '*'
 133 >       fn False VacantSq = ' '
 134
 135 > printTeXGame :: RealGame -> [String]
 136 > printTeXGame (Game tags qu) = [
 137 >       "\\clearpage",
 138 >       "\\begin{center}",
 139 >       "\\fbox{\\fbox{\\large\\begin{tabular}{l}",
 140 >       ("Game " ++ gameno ++ " \\hspace{.3 in} "
 141 >               ++ date
 142 >               ++ " \\hspace{.3 in} "
 143 >               ++ result
 144 >               ++ "\\\\"),
 145 >       "\\hline" ++ (if null opening then "" else "\n" ++ opening ++ "\\\\"),
 146 >       "\\raisebox{2.5pt}[11pt]{\\framebox[11pt]{\\rule{0pt}{4.25pt}}} "
 147 >               ++ white ++ "\\\\",
 148 >       "\\rule[-1pt]{11pt}{11pt} "++ black ++ "\\\\",
 149 >       site,
 150 >       "\\end{tabular}}}",
 151 >       "\\end{center}"] ++
 152 >       (printTeXQuantums (True,startBoard,initMoveNumber) qu)
 153 >   where
 154 >       (date,site,game_no,res,white,black,opening) = getHeaderInfo tags
 155 >       gameno = case game_no of
 156 >                 Nothing -> ""
 157 >                 Just n -> show n
 158 >       result = printTeXResult res
 159
 160 > texPrinter :: [RealGame] -> String
 161 > texPrinter games =
 162 >          texHeader
 163 >       ++ (unlines(concat(map printTeXGame games)))
 164 >       ++ texFooter
 165
 166 > texHeader =
 167 >       "\\documentstyle[twocolumn,a4wide,chess]{article}\n" ++
 168 >       "\\textwidth 7.0 in\n" ++
 169 >       "\\textheight 63\\baselineskip\n" ++
 170 >       "\\columnsep .4 in\n" ++
 171 >       "\\columnseprule .5 pt\n" ++
 172 >       "\\topmargin -0.5 in\n" ++
 173 >       "\\headheight 0 pt\n" ++
 174 >       "\\headsep 0 pt\n" ++
 175 >       "\\oddsidemargin -0.3 in\n" ++
 176 >       "\\font\\sc=cmcsc10\n\\pagestyle{empty}\n" ++
 177 >       "\\begin{document}\n\\thispagestyle{empty}\n\n"
 178
 179 > texFooter = "\n\\end{document}\n"
 180
 181