content: {- |
  Module      :  ./Common/PrintLaTeX.hs
  Description :  functions for LaTeX pretty printing
  Copyright   :  (c) Klaus Luettich, Christian Maeder and Uni Bremen 2002-2006
  License     :  GPLv2 or higher, see LICENSE.txt
  
  Maintainer  :  Christian.Maeder@dfki.de
  Stability   :  provisional
  Portability :  portable
  
  Functions for LaTeX pretty printing
  
  -}
  
  module Common.PrintLaTeX
      ( renderLatex
      , latexHeader
      , latexFooter
      )
      where
  
  import Data.Char (isSpace, isDigit)
  import Common.Lib.State
  import Data.List (isPrefixOf, isSuffixOf)
  import Data.Maybe (fromMaybe)
  
  import Common.Lib.Pretty
  import Common.LaTeX_funs
  
  -- the header of the LaTeX-file that will be processed by pdflatex
  latexHeader :: String
  latexHeader = unlines
    [ "\\documentclass{article}"
    , "\\usepackage{hetcasl}"
    , "\\usepackage{textcomp}"
    , "\\usepackage[T1]{fontenc}"
    , "\\begin{document}" ]
  
  -- the ending document string
  latexFooter :: String
  latexFooter = "\n\\end{document}\n"
  
  -- a style for formatting (Standard is Style PageMode 50 1.19)
  latexStyle :: Style
  latexStyle = style
    { ribbonsPerLine = 1.1
    , lineLength = calcLineLen 345 }
    -- for svmono you need 336.0pt
  
  {- a LatexRenderingState
     field indentTabs : for the number of tab
       stops set those need to be rendererd after every newline.
     field recentlySet : number of setTab makros indentTabs is only
        increased if recentlySet is 0 -}
  data LRState = LRS
    { indentTabs :: ![Int]
    , recentlySet
    , totalTabStops
    , setTabsThisLine
    , indentTabsWritten :: !Int
    , onlyTabs :: !Bool
    , isSetLine :: !Bool
    , collSpaceIndents :: ![Int]
    , insideAnno :: Bool
    } deriving Show
  
  -- the initial state for using the state based rendering via LRState
  initialLRState :: LRState
  initialLRState = LRS
    { indentTabs = []
    , recentlySet = 0
    , totalTabStops = 0
    , setTabsThisLine = 0
    , indentTabsWritten = 0
    , onlyTabs = False
    , isSetLine = False
    , collSpaceIndents = []
    , insideAnno = False
    }
  
  showTextDetails :: TextDetails -> String
  showTextDetails t = case t of
    Chr c -> [c]
    Str s -> s
    PStr s -> s
  
  maxTabs :: Int
  maxTabs = 12
  
  -- a function that knows how to print LaTeX TextDetails
  latexTxt :: TextDetails -> State LRState ShowS -> State LRState ShowS
  latexTxt td cont = let s1 = showTextDetails td in case s1 of
    "" -> cont
    "\n" -> do
        annoBrace <- endOfLine
        indent <- getIndent
        s <- cont
        return $ annoBrace . showString "\\\\\n" . indent . s
    _ | all isSpace s1 -> do
        s2 <- cont
        return $ showChar ' ' . s2
      | s1 == startTab -> do
        indent <- addTabStop
        s2 <- cont
        return $ indent . s2
      | s1 == endTab -> do
        subTabStop
        cont
      | s1 == setTab -> do
        s <- get
        setTabStop
        s2 <- cont
        let (eAn, sAn) = if insideAnno s
              then (showChar '}', showString startAnno)
              else (id, id)
        return $ eAn
          . (if indentTabsWritten s
             + setTabsThisLine s > maxTabs
             || onlyTabs s then id else showString s1)
          . sAn . s2
      | setTabWSp
        `isPrefixOf`
        s1 -> do
        addTabWithSpaces s1
        cont
      | s1 == startAnno -> do
        setInsideAnno True
        s2 <- cont
        return $ showString s1 . s2
      | s1 == endAnno -> do
        setInsideAnno False
        s2 <- cont
        return $ showChar '}' . s2
      | "\\kill\n"
        `isSuffixOf`
        s1 -> do
        indent <- getIndent
        s2 <- cont
        return $ showString s1 . indent . s2
    _ -> do
        setOnlyTabs False
        s2 <- cont
        return $ showString s1 . s2
  
  setOnlyTabs :: Bool -> State LRState ()
  setOnlyTabs b = modify $ \ s -> s { onlyTabs = b }
  
  setInsideAnno :: Bool -> State LRState ()
  setInsideAnno b = modify $ \ s -> s { insideAnno = b }
  
  -- a function to produce a String containing the actual tab stops in use
  getIndent :: State LRState ShowS
  getIndent = do
    s <- get
    let indentTabsSum = min (succ maxTabs) $ sum $ indentTabs s
        collSpcInds = collSpaceIndents s
    put $ s
      { indentTabsWritten = indentTabsSum
      , collSpaceIndents = []
      , onlyTabs = True
      , totalTabStops = max (totalTabStops s)
          $ indentTabsSum + length collSpcInds }
    let indent_fun = tabIndent indentTabsSum
        space_format sf1 i = sf1 . showString (replicate i '~')
          . showString "\\="
        new_tab_line = foldl space_format id (collSpaceIndents s)
          . showString "\\kill\n"
        sAnno = if insideAnno s then showString startAnno else id
    return $ (if null collSpcInds then indent_fun else
              indent_fun . new_tab_line . indent_fun) . sAnno
  
  tabIndent :: Int -> ShowS
  tabIndent n = foldl (.) id $ replicate n $ showString "\\>"
  
  endOfLine :: State LRState ShowS
  endOfLine = do
    s <- get
    put s
      { isSetLine = False
      , setTabsThisLine = 0 }
    return $ if insideAnno s then showChar '}' else id
  
  setTabStop :: State LRState ()
  setTabStop = modify $ \ s ->
      let new_setTabsThisLine = succ $ setTabsThisLine s
      in if onlyTabs s then s { isSetLine = True } else s
        { recentlySet = succ $ recentlySet s
        , setTabsThisLine = new_setTabsThisLine
        , totalTabStops = max (totalTabStops s)
            (new_setTabsThisLine + indentTabsWritten s)
        , isSetLine = True }
  
  addTabWithSpaces :: String -> State LRState ()
  addTabWithSpaces str = let
      delay :: Int
      delay = read . reverse . takeWhile isDigit . tail $ reverse str
    in modify $ \ s ->
    s { collSpaceIndents = collSpaceIndents s ++ [delay] }
  
  -- increase the indentTabs in the state by 1
  addTabStop :: State LRState ShowS
  addTabStop = state $ \ s ->
    let lineSet = isSetLine s
        recent = recentlySet s
        newTabs = if lineSet then recent else 1
        new_indentTabs =
            let iTabs = indentTabs s
            in if newTabs + sum iTabs > totalTabStops s
            then iTabs
            else iTabs ++ [newTabs]
        new_recentlySet =
            if lineSet
            then 0
            else recent
        inTabs = tabIndent newTabs
        (indent_fun, new_indentTabsWritten) =
            let writtenTabs = indentTabsWritten s
            in if sum new_indentTabs > writtenTabs
              && not lineSet && onlyTabs s
            then (inTabs, newTabs + writtenTabs)
            else (id, writtenTabs)
    in (indent_fun, s
      { recentlySet = new_recentlySet
      , indentTabs = new_indentTabs
      , indentTabsWritten = new_indentTabsWritten })
  
  -- decrease the indentTabs in the state by 1
  subTabStop :: State LRState ()
  subTabStop = modify $ \ s -> s
    { indentTabs = case indentTabs s of
        [] -> []
        itabs -> init itabs }
  
  -- functions for producing IO printable Strings
  
  renderLatexCore :: Style -> Doc -> ShowS
  renderLatexCore latexStyle' d =
      evalState (fullRender
                 (mode latexStyle')
                 (lineLength latexStyle')
                 (ribbonsPerLine latexStyle')
                 latexTxt (return id) d) initialLRState
  
  renderLatex :: Maybe Int -> Doc -> String
  renderLatex mi d = showString "\\begin{hetcasl}\n"
    $ renderLatexCore latexStyle' d "\n\\end{hetcasl}\n"
      where latexStyle' = latexStyle
              { lineLength = fromMaybe (lineLength latexStyle) mi }
  