{- |
Module : ./utils/itcor/GenItCorrections.hs
Copyright : (c) C. Maeder, DFKI GmbH 2010
License : GPLv2 or higher, see LICENSE.txt
Maintainer : Christian.Maeder@dfki.de
Stability : experimental
Portability : portable
-}
module Main where
import Text.ParserCombinators.Parsec
import qualified Data.Map as Map
import System.Environment
import System.Exit
import System.Cmd
import Control.Monad
usage :: IO ()
usage = putStrLn
"Usage: it-corrections \"gen_it_characters\" \"gen_it_words\""
main :: IO ()
main = do
args <- getArgs
case args of
[] -> usage
[_] -> usage
[fp1_base, fp2_base] -> do
let fp1 = fp1_base ++ ".txt"
fp2 = fp2_base ++ ".txt"
fp1_tex = fp1_base ++ ".tex"
fp2_tex = fp2_base ++ ".tex"
fp1_pdf = fp1_base ++ ".pdf"
fp2_pdf = fp2_base ++ ".pdf"
generate_tex_files fp2_tex fp1_tex
convert_to_txt fp1_tex fp1_pdf
convert_to_txt fp2_tex fp2_pdf
str1 <- readFile fp1 -- file with table for every character
p1 <- parseItTable str1
str2 <- readFile fp2 -- file with table for combinated characters
p2 <- parseItTable str2
let itc = corrections (Map.fromList (zip allCharacters p1))
(zip combinations p2)
str <- output itc "" -- print itc
putStrLn ("\nitaliccorrection_map :: Map String Int\n" ++
"italiccorrection_map = fromList $ read " ++ post_proc str )
_ -> usage
convert_to_txt :: FilePath -> FilePath -> IO ()
convert_to_txt tex_name pdf_name = do
system ("pdflatex -interaction=batchmode " ++ tex_name ++ " >/dev/null") >>=
\ ec -> when (isFail ec) (fail "pdflatex went wrong")
rawSystem "pdftotext" ["-raw", "-q", pdf_name] >>=
\ ec -> when (isFail ec) (fail "pdftotext went wrong")
return ()
where isFail ec = case ec of
ExitFailure _ -> True
_ -> False
generate_tex_files :: String -> String -> IO ()
generate_tex_files filename1 filename2 = do
writeFile filename1 (tex_file $ writeTexTable combinations)
writeFile filename2 (tex_file $ writeTexTable [[c] | c <- allCharacters])
output :: [(String, Int)] -> String -> IO String
output [] str = return (init str)
output ((s, i) : xs) str =
output xs $ str ++ "(\"" ++ s ++ "\"," ++ show i ++ "),"
post_proc :: String -> String
post_proc str = '\"' : '[' : concatMap conv str ++ "]\""
where conv c = case c of
'\"' -> "\\\""
-- substitute umlauts with \196\214\220\223\228\246\252
'\196' -> "\\196"
'\214' -> "\\214"
'\220' -> "\\220"
'\223' -> "\\223"
'\228' -> "\\228"
'\246' -> "\\246"
'\252' -> "\\252"
_ -> [c]
-- -------- Parser for Table generated with "width-it-table.tex" ---------
parseItTable :: String -> IO [Double]
parseItTable str = case parse itParser "" str of
Left err -> do
putStr "parse error at"
print err; error ""
Right x -> return x
itParser :: Parser [Double]
itParser = do
manyTill anyChar (try (string "wl: "))
many1 tableEntry
<|> do
anyChar
itParser
tableEntry :: Parser Double
tableEntry = do
str <- parseDouble
string "pt"
spaces
try (manyTill anyChar $ try $ string "wl: ") <|> manyTill anyChar eof
return (read str)
parseDouble :: Parser String
parseDouble = many1 double
double :: Parser Char
double = digit <|> char '.'
stringHead :: Parser String
stringHead = do
c1 <- tableChar
c2 <- option "" tableChar
return (c1 ++ c2)
tableChar :: Parser String
tableChar = do
str <- try letter <|> digit
return [str]
-- ------------------------------------------------------------------------
corrections :: Map.Map Char Double -> [(String, Double)] -> [(String, Int)]
corrections fm = map (corrections' fm)
corrections' :: Map.Map Char Double -> (String, Double) -> (String, Int)
corrections' fm (str, d) = case str of
[c1, c2] ->
let d1 = Map.findWithDefault 0.0 c1 fm
d2 = Map.findWithDefault 0.0 c2 fm
dif = round (((d1 + d2) - d) * 0.351 * 1000.0)
in (str, dif)
_ -> error "corrections'"
combinations :: [String]
combinations = let z = zipIt allCharacters allCharacters
in [ c1 : [c2] | (c1, c2) <- z ]
where
zipIt :: String -> String -> [(Char, Char)]
zipIt [] _ = []
zipIt (a : as) bs = zip [a, a ..] bs ++ zipIt as bs
allCharacters :: String
allCharacters = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9']
++ "\228\252\246\196\220\214\223"
writeTexTable :: [String] -> String
writeTexTable [] = []
writeTexTable strl = concat
[ "\\wordline{\\textit{" ++ str ++ "}}\n\\hline\n" | str <- f ]
++ "\\end{tabular}\n\\newpage\n\\begin{tabular}{l|l}\n\\hline\n"
++ writeTexTable r
where (f, r) = splitAt 30 strl
tex_file :: String -> String
tex_file str = unlines
[ "\\documentclass[a4paper]{article}"
, "\\usepackage{bookman}"
, "\\usepackage[latin1]{inputenc}"
, "\\usepackage{german}"
, "\\usepackage{calc}"
, "\\usepackage{longtable}"
, "\\newlength{\\widthofword}"
, "\\setlength{\\parindent}{0cm}"
, "\\newcommand{\\wordline}[1]%"
, "{#1 & wl: \\setlength{\\widthofword}{\\widthof{#1}}\\the\\widthofword\\\\}"
, "\\title{Useful Widths for Typesetting-CASL}"
, "\\author{Klaus Luettich}"
, "\\begin{document}"
, "\\maketitle"
, "\\begin{tabular}{l|l}"
, "\\hline"
, str
, "\\end{tabular}"
, "\\end{document}" ]