{-# LANGUAGE QuasiQuotes #-} module Language.LaTeX.Builder.Beamer where import Language.LaTeX.Builder.MonoidUtils import Language.LaTeX.Types import qualified Language.LaTeX.Builder.Internal as BI import qualified Language.LaTeX.Builder as B import Language.LaTeX.Builder.QQ import Control.Applicative import Data.List (intersperse) import Data.Maybe import Data.Monoid {- pkg :: PackageName pkg = B.pkgName "beamer" -} data DocClassOption = Compress | T | Red | Handout | RawDocClassOption String compress, t, red, handout :: DocClassOption compress = Compress t = T red = Red handout = Handout rawDocClassOption :: String -> DocClassOption rawDocClassOption = RawDocClassOption showDocClassOption :: DocClassOption -> String showDocClassOption Compress = "compress" showDocClassOption T = "t" showDocClassOption Red = "red" showDocClassOption Handout = "handout" showDocClassOption (RawDocClassOption x) = x documentclasskind :: DocumentClassKind documentclasskind = OtherDocumentClassKind "beamer" beamer :: Maybe LatexLength -> [DocClassOption] -> [AnyItem] -> DocumentClass beamer msize opts = B.documentclass documentclasskind . (maybeToList (BI.texLength <$> msize) ++) . (map (BI.rawAnyTex . showDocClassOption) opts ++) type TargetName = String type Label = String labelArg :: Label -> Arg AnyItem labelArg = BI.mandatoryLatexItem . BI.rawTex targetArg :: TargetName -> Arg AnyItem targetArg = BI.mandatoryLatexItem . BI.rawTex data FrameOpt = Label Label | Fragile | OtherOption String String deriving (Eq,Ord) data OverlayInt = OvInt Int | OvPlus | OvPlusOffset Int | OvDot deriving (Eq,Ord) -- | Only overlay actions are not supported currently. data Overlay = OvSingle OverlayInt | OvFromTo OverlayInt OverlayInt | OvFrom OverlayInt deriving (Eq,Ord) type Overlays = [Overlay] type BeamerOpt = (String, String) texFrameOpt :: FrameOpt -> BeamerOpt texFrameOpt (Label lbl) = ("label",lbl) texFrameOpt Fragile = ("fragile","") texFrameOpt (OtherOption a b) = (a,b) texFrameOpts :: [FrameOpt] -> Arg AnyItem texFrameOpts = beamerOpts . map texFrameOpt showOvInt :: OverlayInt -> ShowS showOvInt (OvInt i) = shows i showOvInt OvPlus = ('+':) showOvInt OvDot = ('.':) showOvInt (OvPlusOffset off) = ('+':) . ('(':) . shows off . (')':) showOverlay :: Overlay -> ShowS showOverlay (OvSingle i) = showOvInt i showOverlay (OvFromTo i j) = showOvInt i . ('-':) . showOvInt j showOverlay (OvFrom i) = showOvInt i . ('-':) showOverlays :: Overlays -> Maybe String showOverlays [] = Nothing showOverlays ovs = Just . ('<':) . (++">") . showsOv ovs $ [] where showsOv :: Overlays -> ShowS showsOv = mconcat . intersperse (',':) . map showOverlay texOverlaysOpt :: Overlays -> Maybe LatexItem texOverlaysOpt = fmap BI.rawTex . showOverlays texOverlaysArg :: Overlays -> Arg a texOverlaysArg = maybe BI.noArg BI.rawArg . showOverlays texOverlaysOptArg :: Overlays -> Arg AnyItem texOverlaysOptArg = maybe BI.noArg (BI.optionalLatexItem . BI.rawTex) . showOverlays label :: Label -> FrameOpt label = Label -- more options to add ? frame :: Overlays -> Overlays -> [FrameOpt] -> LatexItem -> LatexItem -> ParItem -> ParItem frame ov mov fopts title subtitle = {- recent beamer versions BI.parEnvironmentPar "frame" $ [ texOverlaysArg ov , maybe BI.noArg BI.optional $ texOverlaysOpt mov , texFrameOpts fopts , BI.mandatory title , BI.mandatory subtitle ] -} BI.parEnvironmentPar "frame" [ texOverlaysArg ov , texOverlaysOptArg mov , texFrameOpts fopts ] . (mapNonEmpty frametitle title ⊕) . (mapNonEmpty framesubtitle subtitle ⊕) frameO :: Overlays -> ParItem -> ParItem frameO overlays = BI.parEnvironmentPar "frame" [texOverlaysOptArg overlays] example :: ParItem -> ParItem example = BI.parEnvironmentPar "example" [] theorem :: ParItem -> ParItem theorem = BI.parEnvironmentPar "theorem" [] block :: LatexItem -> ParItem -> ParItem block title = BI.parEnvironmentPar "block" [BI.mandatoryLatexItem title] slide :: LatexItem -> ParItem -> ParItem slide tit = frame [] [] [] tit ø slideO :: LatexItem -> Overlays -> ParItem -> ParItem slideO tit ovs body = frameO ovs (frametitle tit ⊕ body) frametitle :: LatexItem -> ParItem frametitle = BI.parCmdArg "frametitle" . BI.latexItem framesubtitle :: LatexItem -> ParItem framesubtitle = BI.parCmdArg "framesubtitle" . BI.latexItem -- | All overlays counting from the given argument (like in @<1->@). ovFrom :: OverlayInt -> Overlay ovFrom = OvFrom -- | All overlays between the given arguments (like in @<1-3>@). ovFromTo :: OverlayInt -> OverlayInt -> Overlay ovFromTo = OvFromTo -- | The single overlay (like in @<1>@). ovSingle :: OverlayInt -> Overlay ovSingle = OvSingle -- | Lift a strictly positive 'Int' to an 'OverlayInt' ovInt :: Int -> OverlayInt ovInt i | i > 0 = OvInt i | otherwise = error "ovInt: strictly positive Int expected" {- | The '+' incremental overlay specification (like in @<+->@). Beamer User Guide at 8.6.4 Incremental Specifications -} ovPlus :: OverlayInt ovPlus = OvPlus {- | The '.' incremental overlay specification (like in @<.->@). Beamer User Guide at 8.6.4 Incremental Specifications -} ovDot :: OverlayInt ovDot = OvDot -- | Handy shortcut for @[ovFrom ovPlus]@ aka @<+->@. ovIncr :: Overlays ovIncr = [ovFrom ovPlus] -- | Handy lifting for a list of strictly positive integers. ovInts :: [Int] -> Overlays ovInts = map (ovSingle . ovInt) alert :: LatexItem -> LatexItem alert = BI.latexCmdArg "alert" -- A shortcut for @itemize . texOverlaysOpt@ itemize :: Overlays -> [ListItem] -> ParItem itemize = B.itemize . texOverlaysOpt -- A shortcut for @enumerate . texOverlaysOpt@ enumerate :: Overlays -> [ListItem] -> ParItem enumerate = B.enumerate . texOverlaysOpt -- A shortcut for @description . texOverlaysOpt@ description :: Overlays -> [ListItem] -> ParItem description = B.description . texOverlaysOpt -- AtBeginSubsection, AtBeginSection pause :: LatexItem pause = BI.texCmdNoArg "pause" pause' :: Maybe Int -> LatexItem pause' = BI.latexCmdArgs "pause" . maybeToList . fmap (BI.optional . BI.rawTex . show) only :: Overlays -> LatexItem -> LatexItem only ov arg = BI.latexCmdArgs "only" [texOverlaysArg ov, BI.mandatory arg] uncover :: Overlays -> LatexItem -> LatexItem uncover ov arg = BI.latexCmdArgs "uncover" [texOverlaysArg ov, BI.mandatory arg] visible :: Overlays -> LatexItem -> LatexItem visible ov arg = BI.latexCmdArgs "visible" [texOverlaysArg ov, BI.mandatory arg] invisible :: Overlays -> LatexItem -> LatexItem invisible ov arg = BI.latexCmdArgs "invisible" [texOverlaysArg ov, BI.mandatory arg] alt :: Overlays -> LatexItem -> LatexItem -> LatexItem alt ov arg1 arg2 = BI.latexCmdArgs "alt" [texOverlaysArg ov, BI.mandatory arg1, BI.mandatory arg2] temporal :: Overlays -> LatexItem -> LatexItem -> LatexItem -> LatexItem temporal ov arg1 arg2 arg3 = BI.latexCmdArgs "temporal" [ texOverlaysArg ov , BI.mandatory arg1 , BI.mandatory arg2 , BI.mandatory arg3 ] visibleenv :: Overlays -> ParItem -> ParItem visibleenv ov = BI.parEnvironmentPar "visibleenv" [texOverlaysArg ov] invisibleenv :: Overlays -> ParItem -> ParItem invisibleenv ov = BI.parEnvironmentPar "invisibleenv" [texOverlaysArg ov] uncoverenv :: Overlays -> ParItem -> ParItem uncoverenv ov = BI.parEnvironmentPar "uncoverenv" [texOverlaysArg ov] onlyenv :: Overlays -> ParItem -> ParItem onlyenv ov = BI.parEnvironmentPar "onlyenv" [texOverlaysArg ov] altenv :: Overlays -- ^ overlay specification -> LatexItem -- ^ begin text -> LatexItem -- ^ end text -> LatexItem -- ^ alternate begin text -> LatexItem -- ^ alternate end text -> ParItem -- ^ environment contents -> ParItem altenv ov b e ab ae = BI.parEnvironmentPar "altenv" [ texOverlaysArg ov , BI.mandatoryLatexItem b , BI.mandatoryLatexItem e , BI.mandatoryLatexItem ab , BI.mandatoryLatexItem ae ] beamerOpts :: [BeamerOpt] -> Arg AnyItem beamerOpts = BI.namedOpts . map f where f (x,y) = Named x $ BI.rawAnyTex y beamerPreambleCmdArgs :: String -> [BeamerOpt] -> LatexItem -> PreambleItem beamerPreambleCmdArgs name opts arg = BI.preambleCmdArgs name [beamerOpts opts, BI.mandatoryLatexItem arg] usetheme, usefonttheme, useinnertheme, useoutertheme, usecolortheme :: [BeamerOpt] -> LatexItem -> PreambleItem usetheme = beamerPreambleCmdArgs "usetheme" usefonttheme = beamerPreambleCmdArgs "usefonttheme" useinnertheme = beamerPreambleCmdArgs "useinnertheme" useoutertheme = beamerPreambleCmdArgs "useoutertheme" usecolortheme = beamerPreambleCmdArgs "usecolortheme" {- | Draws a button with the given button text . Example: @hyperlink [] "somewhere" (beamerbutton "Go somewhere")@ p97 beamer userguide -} beamerbutton :: LatexItem -> LatexItem beamerbutton = BI.latexCmdArg "beamerbutton" {- | Draws a button with the given button text. Before the text, a small symbol (usually a right-pointing arrow) is inserted that indicates that pressing this button will jump to another *area* of the presentation. Example: @hyperlink [] "detour" (beamergotobutton "Go to detour")@ p98 beamer userguide -} beamergotobutton :: LatexItem -> LatexItem beamergotobutton = BI.latexCmdArg "beamergotobutton" {- | The symbol drawn for this button is usually a double right arrow. Use this button if pressing it will skip over a well-defined part of your talk. p98 beamer userguide -} beamerskipbutton :: LatexItem -> LatexItem beamerskipbutton = BI.latexCmdArg "beamerskipbutton" {- | The symbol drawn for this button is usually a left-pointing arrow. Use this button if pressing it will return from a detour. p98 beamer userguide -} beamerreturnbutton :: LatexItem -> LatexItem beamerreturnbutton = BI.latexCmdArg "beamerreturnbutton" {- | Only one overlay specification may be given. The link text is typeset in the usual way. If you click anywhere on this text, you will jump to the slide on which the \hypertarget command was used with the parameter target name . If an overlay specification is present, the hyperlink (including the link text) is completely suppressed on the non-specified slides. p99 beamer userguide -} hyperlink :: Overlays -> TargetName -> LatexItem -> Overlays -> LatexItem hyperlink ov1 target linkText ov2 = BI.latexCmdAnyArgs "hyperlink" [ texOverlaysArg ov1 , targetArg target , BI.mandatoryLatexItem linkText , texOverlaysArg ov2 ] againframe :: Overlays -> Overlays -> [FrameOpt] -> Label -> ParItem againframe ov1 ov2 fopts lbl = BI.parCmdArgs "againframe" [ texOverlaysArg ov1 , texOverlaysArg ov2 , texFrameOpts fopts , labelArg lbl ] -- | Disable those litte icons at the bottom right of your presentation. beamertemplatenavigationsymbolsempty :: PreambleItem beamertemplatenavigationsymbolsempty = BI.preambleCmdArgs "beamertemplatenavigationsymbolsempty" [] type TexDimension = LatexLength data BeamerSize = TextMarginLeft TexDimension -- ^ sets a new left margin. This excludes the left sidebar. Thus, -- it is the distance between the right edge of the left sidebar and the left edge of the text. | TextMarginRight TexDimension -- ^ sets a new right margin. | SidebarWidthLeft TexDimension -- ^ sets the size of the left sidebar. Currently, this command -- should be given before a shading is installed for the sidebar canvas. | SidebarWidthRight TexDimension -- ^ sets the size of the right sidebar. | DescriptionWidth TexDimension -- ^ sets the default width of description labels, see Beamer User Guide Section 11.1. | DescriptionWidthOf LatexItem -- ^ sets the default width of description labels to the width of the -- text, see Section 11.1. | MiniFrameSize TexDimension -- ^ sets the size of mini frames in a navigation bar. When two -- mini frame icons are shown alongside each other, their left end points are -- 'TexDimension' far apart. | MiniFrameOffset TexDimension -- ^ set an additional vertical offset that is added to the mini -- frame size when arranging mini frames vertically. texBeamerSizeArg :: BeamerSize -> Arg AnyItem texBeamerSizeArg bs = BI.namedArgs . pure $ case bs of TextMarginLeft dim -> n "text margin left" $ BI.texLength dim TextMarginRight dim -> n "text margin right" $ BI.texLength dim SidebarWidthLeft dim -> n "sidebar width left" $ BI.texLength dim SidebarWidthRight dim -> n "sidebar width right" $ BI.texLength dim DescriptionWidth dim -> n "description width" $ BI.texLength dim DescriptionWidthOf txt -> n "description width of" $ BI.latexItem txt MiniFrameSize dim -> n "mini frame size" $ BI.texLength dim MiniFrameOffset dim -> n "mini frame offset" $ BI.texLength dim where n = Named setbeamersize :: BeamerSize -> PreambleItem setbeamersize = BI.preambleCmdArgs "setbeamersize" . pure . texBeamerSizeArg appendix :: ParItem appendix = BI.parCmdArgs "appendix" [] -- \setbeamercolor*{titlelike}{parent=structure} data Footline = Footline { authorPercent :: Percentage , titlePercent :: Percentage , datePercent :: Maybe Percentage , showTotalFrames :: Bool } defaultFootline :: Footline defaultFootline = Footline { authorPercent = 34 , titlePercent = 36 , datePercent = Nothing , showTotalFrames = True } footline :: Footline -> PreambleItem footline Footline{authorPercent=authorp,titlePercent=titlep,datePercent=maydatep,showTotalFrames=stf} = let datep = fromMaybe (100 - authorp - titlep) maydatep f (Percentage p) = BI.rawPreamble $ show p maytotalframes = if stf then [qp| / \inserttotalframenumber|] else ø in [qp| | \defbeamertemplate*{footline}{infolines theme without institution} | { | \leavevmode% | \hbox{% | \begin{beamercolorbox}[wd=.|] ⊕ f authorp ⊕ [qp|\paperwidth,ht=2.25ex,dp=1.125ex,center]{author in head/foot}% | \usebeamerfont{author in head/foot} | \insertshortauthor | \end{beamercolorbox}% | \begin{beamercolorbox}[wd=.|] ⊕ f titlep ⊕ [qp|\paperwidth,ht=2.25ex,dp=1.125ex,center]{title in head/foot}% | \usebeamerfont{title in head/foot} | \insertshorttitle | \end{beamercolorbox}% | \begin{beamercolorbox}[wd=.|] ⊕ f datep ⊕ [qp|\paperwidth,ht=2.25ex,dp=1.125ex,right]{date in head/foot}% | \usebeamerfont{date in head/foot} | \insertshortdate{}\hspace*{2em} | \insertframenumber{}|] ⊕ maytotalframes ⊕ [qp|\hspace*{2ex} | \end{beamercolorbox}}% | \vskip0pt% | } |]