diff options
Diffstat (limited to 'testsuite/tests/programs/andy_cherry/PrintTEX.hs')
| -rw-r--r-- | testsuite/tests/programs/andy_cherry/PrintTEX.hs | 182 |
1 files changed, 182 insertions, 0 deletions
diff --git a/testsuite/tests/programs/andy_cherry/PrintTEX.hs b/testsuite/tests/programs/andy_cherry/PrintTEX.hs new file mode 100644 index 0000000000..d8f253f6d4 --- /dev/null +++ b/testsuite/tests/programs/andy_cherry/PrintTEX.hs @@ -0,0 +1,182 @@ + + module PrintTEX (texPrinter) where + + import GenUtils + import DataTypes + import Data.Array -- 1.3 + import Data.Char -- 1.3 + + + + + + + + splitUpQuantum :: [Quantum] -> [[Quantum]] + splitUpQuantum q = splitUpQuantums q [] + where + splitUpQuantums [] [] = [] + splitUpQuantums [] mvs = [reverse mvs] + splitUpQuantums (mv@(QuantumMove _ _ _ _):rest) mvs + = splitUpQuantums rest (mv:mvs) + splitUpQuantums (mv@(QuantumNAG _):rest) mvs + = splitUpQuantums rest mvs + splitUpQuantums (x:xs) [] = [x] : splitUpQuantums xs [] + splitUpQuantums (x:xs) mvs + = [reverse mvs,[x]] ++ splitUpQuantums xs [] + + type TeXState = + (Bool, -- if Top level ! + Board, -- current board + MoveNumber) -- the Current Move Number + + printTeXQuantums :: TeXState -> [Quantum] -> [String] + printTeXQuantums ps + = concat . fst . mapAccumL printTeXQuantum ps . splitUpQuantum + + printTeXQuantum :: TeXState -> [Quantum] -> ([String],TeXState) + printTeXQuantum state@(_,board,_) [QuantumComment ["\004"]] = + (mkTeXBoard board,state) + printTeXQuantum state@(_,board,_) [QuantumComment (('\004':comm):comms)] = + (mkTeXBoard board ++ formatText 70 (parseSquiggles (comm:comms)),state) + printTeXQuantum state [QuantumComment comms] = + (formatText 70 (parseSquiggles comms),state) + printTeXQuantum (pnt,brd,mv) [QuantumAnalysis anal] = + (printTeXQuantums (False,err,decMove mv) anal,(pnt,brd,mv)) + where err = error "Syntax error using ^D" + printTeXQuantum state@(_,board,_) [QuantumResult str] = + (mkTeXBoard board ++ [printTeXResult (mkResult str)],state) + printTeXQuantum state mvs@(QuantumMove _ _ _ _:_) = + printTeXMoves state mvs + printTeXQuantum _ _ = error "PANIC: strange Quantum" + + + parseSquiggles = map parseSquiggle + parseSquiggle ('<':'s':'a':'w':'>':r) = "\\wbetter{}" ++ r + parseSquiggle ('<':'a':'w':'>':r) = "\\wupperhand{}" ++ r + parseSquiggle ('<':'w':'a':'w':'>':r) = "\\wdecisive{}" ++ r + parseSquiggle ('<':'s':'a':'b':'>':r) = "\\bbetter{}" ++ r + parseSquiggle ('<':'a':'b':'>':r) = "\\bupperhand{}" ++ r + parseSquiggle ('<':'w':'a':'b':'>':r) = "\\bdecisive{}" ++ r + parseSquiggle wd = wd + + + printTeXResult :: Result -> String + printTeXResult Win = "$1\\!-\\!0$" + printTeXResult Loss = "$0\\!-\\!1$" + printTeXResult Draw = "${1 \\over 2}\\!-\\!{1 \\over 2}$" + printTeXResult Unknown = "$*$" + + printTeXMoves (tl,_,mv) mvs + = ([text],(True,brd,incMove last_mv_num)) + where + aux_mvs = zip3 mvs (iterate incMove mv) (False:repeat True) + + (QuantumMove _ _ _ brd,last_mv_num,_) = last aux_mvs + text = initText tl + ++ concat (fst (mapAccumL (pntMove tl) (mv,False) mvs)) + ++ endText tl + + initText False = + case mv of + MoveNumber i Black -> "|" ++ show i ++ "\\ldots~" + _ -> "|" + initText True = + "\\begin{center}|\n" ++ + "{\\bf" ++ + "\\begin{tabular}{rp{50pt}p{50pt}}\n" ++ + case mv of + MoveNumber i Black -> show i ++ " & \\ldots" + _ -> "" + + endText True = case getMoveColour last_mv_num of + White -> "&\\\\\n\\end{tabular}}|\n\\end{center}" + Black -> "\\end{tabular}}|\n\\end{center}" + endText False = "|" + + + + pntMove True (mv@(MoveNumber i White),bl) move + = (show i ++ " & " + ++ printableMove move, + (incMove mv,True)) + pntMove True (mv@(MoveNumber i Black),bl) move + = (" & " ++ printableMove move ++ "\\\\\n", + (incMove mv,True)) + pntMove False (mv@(MoveNumber i White),bl) move + = ((if bl then "; " else "") ++ show i ++ ".~" + ++ printableMove move, + (incMove mv,True)) + pntMove False (mv@(MoveNumber i Black),bl) move + = ((if bl then ", " else "") ++ printableMove move, + (incMove mv,True)) + + printableMove :: Quantum -> String + printableMove (QuantumMove move ch an _) = map fn move ++ rest + where + fn 'x' = '*' + fn 'O' = '0' + fn c = c + rest = case ch of + "#" -> an ++ " mate" + _ -> ch ++ an + + mkTeXBoard :: Board -> [String] + mkTeXBoard (Board arr _ _) = + ["\n\\board"] ++ + ["{" ++ [ fn ((x-y) `rem` 2 == 0) (arr ! (x,y)) | x <- [1..8]] ++ "}" + | y <- reverse [1..8]] ++ + ["$$\\showboard$$"] + where + fn _ (WhitesSq p) = head (userFormat p) + fn _ (BlacksSq p) = toLower (head (userFormat p)) + fn True VacantSq = '*' + fn False VacantSq = ' ' + + printTeXGame :: RealGame -> [String] + printTeXGame (Game tags qu) = [ + "\\clearpage", + "\\begin{center}", + "\\fbox{\\fbox{\\large\\begin{tabular}{l}", + ("Game " ++ gameno ++ " \\hspace{.3 in} " + ++ date + ++ " \\hspace{.3 in} " + ++ result + ++ "\\\\"), + "\\hline" ++ (if null opening then "" else "\n" ++ opening ++ "\\\\"), + "\\raisebox{2.5pt}[11pt]{\\framebox[11pt]{\\rule{0pt}{4.25pt}}} " + ++ white ++ "\\\\", + "\\rule[-1pt]{11pt}{11pt} "++ black ++ "\\\\", + site, + "\\end{tabular}}}", + "\\end{center}"] ++ + (printTeXQuantums (True,startBoard,initMoveNumber) qu) + where + (date,site,game_no,res,white,black,opening) = getHeaderInfo tags + gameno = case game_no of + Nothing -> "" + Just n -> show n + result = printTeXResult res + + texPrinter :: [RealGame] -> String + texPrinter games = + texHeader + ++ (unlines(concat(map printTeXGame games))) + ++ texFooter + + texHeader = + "\\documentstyle[twocolumn,a4wide,chess]{article}\n" ++ + "\\textwidth 7.0 in\n" ++ + "\\textheight 63\\baselineskip\n" ++ + "\\columnsep .4 in\n" ++ + "\\columnseprule .5 pt\n" ++ + "\\topmargin -0.5 in\n" ++ + "\\headheight 0 pt\n" ++ + "\\headsep 0 pt\n" ++ + "\\oddsidemargin -0.3 in\n" ++ + "\\font\\sc=cmcsc10\n\\pagestyle{empty}\n" ++ + "\\begin{document}\n\\thispagestyle{empty}\n\n" + + texFooter = "\n\\end{document}\n" + + |