module MarXup.LineUp (Tok(..),lineup,mkSpaces) where
import Data.List
import Data.Foldable
import Control.Monad (when)
import Data.Monoid
import Data.Maybe (catMaybes)
import MarXup.Tex
data Tok = Tok {
startCol :: Int,
endCol :: Int,
preSpace :: Float,
render :: TeX,
postSpace :: Float
}
justIf True x = Just x
justIf _ _ = Nothing
marx True = '!'
marx False = '-'
lineup :: [[Tok]] -> TeX
lineup input = env'' "list" [] [mempty,tex "\\setlength\\leftmargin{1em}"] $ do
usepkg "polytable" 100 []
texLn ""
texLines $ map (("% " ++) . map marx . drop 1 . isIndentTab ) array
texLn "\\item\\relax"
cmd "ensuremath" $ env "pboxed" $ do
declColumn Nothing "B"
forM_ (zip3 allTabStops [(1::Int)..] (drop 1 indentColumns)) $ \(_col,tab,indenting) ->
declColumn (justIf (indenting) $ tex $ show (tab1) ++ "em") (show tab)
declColumn Nothing "E"
texLn "%"
sequence_ $ intersperse (texLn "\\\\") $ map printLine array
where
showCol 0 = "B"
showCol n = show n
declColumn :: Maybe TeX -> String -> TeX
declColumn dim c = do
cmdm "column" (catMaybes [dim]) [tex c,tex "@{}>{}l<{}@{}"]
return ()
printLine :: [[Tok]] -> TeX
printLine xs = do
forM_ (zip xs [(0::Int)..]) $ \(ts,colName) -> do
when (not $ null ts) $ do
cmdn' ">" [showCol colName] []
braces $ forM_ ts $ \t -> do
render t
cmdn' "<" ["E"] []
return ()
array :: [[[Tok]]]
array = map (tabify . mkSpaces) input
isAligning :: [Tok] -> [(Bool,Tok)]
isAligning [] = []
isAligning (x:xs) = (True,x) :
[(startCol t2 > 1 + endCol t1,t2) | (t1,t2) <- zip (x:xs) xs]
isIndentTab :: [[Tok]] -> [Bool]
isIndentTab xs = zipWith (||) nulls (scanl (&&) True nulls)
where nulls = map null xs
indentColumns :: [Bool]
indentColumns = map and $ transpose $ map isIndentTab array
tabStops :: [Tok] -> [Int]
tabStops xs = [startCol x | (align,x) <- isAligning xs, align]
allTabStops :: [Int]
allTabStops = sort $ nub $ concatMap tabStops input
tabify :: [Tok] -> [[Tok]]
tabify xs = tabify' (isAligning xs) allTabStops
clearMeta :: [(Bool,Tok)] -> [Tok]
clearMeta = map snd
tabify' :: [(Bool,Tok)] -> [Int]-> [[Tok]]
tabify' [] _ = []
tabify' xs [] = [clearMeta xs]
tabify' xs (t:ts) = clearMeta col:tabify' xs' ts
where (col,xs') = break (\(align,s) -> align && (startCol s >= t)) xs
mkSpaces :: [Tok] -> [Tok]
mkSpaces [] = []
mkSpaces ts = [ Tok (startCol l) (endCol l) 0
(render l <>
tex ("\\mskip " ++ show (min (postSpace l) (preSpace r)) ++ "mu" )) 0
| (l,r) <- zip ts (tail ts) ] ++ [last ts]