{- |
Module      :  $Header$
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 }
