{-# LANGUAGE OverloadedStrings #-}

-- | An extension to the standard LaTeX tabular environment that
-- creates struts which (slightly) stretch the table row in which they
-- sit.

module Text.LaTeX.Packages.Bigstrut
 ( bigstrutp
 , bigstrut
 , bigstrutTop
 , bigstrutBottom
 ) where

import Text.LaTeX.Base.Syntax (LaTeX(TeXComm), TeXArg(OptArg))
import Text.LaTeX.Base.Class (LaTeXC, fromLaTeX)
import Text.LaTeX.Base.Types (PackageName)

-- | bigstrut package. Use it to import it like this:
--
-- > usepackage [] bigstrut
bigstrutp :: PackageName
bigstrutp :: PackageName
bigstrutp = PackageName
"bigstrut"

-- | 'bigstrutTop', 'bigstrutBottom' and 'bigstrut' produce a strut (a
-- rule with width 0) which is 'bigstrutjot' (2pt by default) higher,
-- lower, or both than the standard array/tabular strut. Use them in
-- table entries that are adjacent to 'hlines' to leave an extra bit
-- of space

bigstrut :: LaTeXC l => l
bigstrut :: forall l. LaTeXC l => l
bigstrut = forall l. LaTeXC l => LaTeX -> l
fromLaTeX forall a b. (a -> b) -> a -> b
$ PackageName -> [TeXArg] -> LaTeX
TeXComm PackageName
"bigstrut" []

bigstrutTop :: LaTeXC l => l
bigstrutTop :: forall l. LaTeXC l => l
bigstrutTop = forall l. LaTeXC l => LaTeX -> l
fromLaTeX forall a b. (a -> b) -> a -> b
$ PackageName -> [TeXArg] -> LaTeX
TeXComm PackageName
"bigstrut" [LaTeX -> TeXArg
OptArg LaTeX
"t"]

bigstrutBottom :: LaTeXC l => l
bigstrutBottom :: forall l. LaTeXC l => l
bigstrutBottom = forall l. LaTeXC l => LaTeX -> l
fromLaTeX forall a b. (a -> b) -> a -> b
$ PackageName -> [TeXArg] -> LaTeX
TeXComm PackageName
"bigstrut" [LaTeX -> TeXArg
OptArg LaTeX
"b"]