diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Text/Pandoc/Writers/Powerpoint/Output.hs | 38 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Powerpoint/Presentation.hs | 36 |
2 files changed, 53 insertions, 21 deletions
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs index a45c09bd4..eed35565e 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs @@ -48,6 +48,14 @@ import Text.Pandoc.Writers.Math (convertMath) import Text.Pandoc.Writers.Powerpoint.Presentation import Skylighting (fromColor) +-- |The 'EMU' type is used to specify sizes in English Metric Units. +type EMU = Integer + +-- |The 'pixelsToEmu' function converts a size in pixels to one +-- in English Metric Units. It assumes a DPI of 72. +pixelsToEmu :: Pixels -> EMU +pixelsToEmu = (12700 *) + -- This populates the global ids map with images already in the -- template, so the ids won't be used by images introduced by the -- user. @@ -148,6 +156,18 @@ runP env st p = evalStateT (runReaderT p env) st -------------------------------------------------------------------- +monospaceFont :: Monad m => P m String +monospaceFont = do + vars <- writerVariables <$> asks envOpts + case lookup "monofont" vars of + Just s -> return s + Nothing -> return "Courier" + +fontSizeAttributes :: Monad m => RunProps -> P m [(String, String)] +fontSizeAttributes RunProps { rPropForceSize = Just sz } = + return [("sz", (show $ sz * 100))] +fontSizeAttributes _ = return [] + copyFileToArchive :: PandocMonad m => Archive -> FilePath -> P m Archive copyFileToArchive arch fp = do refArchive <- asks envRefArchive @@ -721,13 +741,8 @@ makePicElements layout picProps mInfo alt = do paraElemToElements :: PandocMonad m => ParaElem -> P m [Element] paraElemToElements Break = return [mknode "a:br" [] ()] paraElemToElements (Run rpr s) = do - let sizeAttrs = case rPropForceSize rpr of - Just n -> [("sz", (show $ n * 100))] - Nothing -> if rPropCode rpr - -- hardcoded size for code for now - then [("sz", "1800")] - else [] - attrs = sizeAttrs ++ + sizeAttrs <- fontSizeAttributes rpr + let attrs = sizeAttrs ++ (if rPropBold rpr then [("b", "1")] else []) ++ (if rPropItalics rpr then [("i", "1")] else []) ++ (if rPropUnderline rpr then [("u", "sng")] else []) ++ @@ -773,8 +788,9 @@ paraElemToElements (Run rpr s) = do ] _ -> [] Nothing -> [] + codeFont <- monospaceFont let codeContents = if rPropCode rpr - then [mknode "a:latin" [("typeface", "Courier")] ()] + then [mknode "a:latin" [("typeface", codeFont)] ()] else [] let propContents = linkProps ++ colorContents ++ codeContents return [mknode "a:r" [] [ mknode "a:rPr" attrs $ propContents @@ -821,7 +837,11 @@ paragraphToElement par = do let attrs = [("lvl", show $ pPropLevel $ paraProps par)] ++ (case pPropMarginLeft (paraProps par) of - Just px -> [("marL", show $ 12700 * px), ("indent", "0")] + Just px -> [("marL", show $ pixelsToEmu px)] + Nothing -> [] + ) ++ + (case pPropIndent (paraProps par) of + Just px -> [("indent", show $ pixelsToEmu px)] Nothing -> [] ) ++ (case pPropAlign (paraProps par) of diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs index ae36c961c..8667c79f4 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs @@ -33,6 +33,7 @@ module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation , TableProps(..) , Strikethrough(..) , Capitals(..) + , Pixels , PicProps(..) , URL , TeXString(..) @@ -226,6 +227,7 @@ data ParaProps = ParaProps { pPropMarginLeft :: Maybe Pixels , pPropBullet :: Maybe BulletType , pPropAlign :: Maybe Algnment , pPropSpaceBefore :: Maybe Pixels + , pPropIndent :: Maybe Pixels } deriving (Show, Eq) instance Default ParaProps where @@ -235,6 +237,7 @@ instance Default ParaProps where , pPropBullet = Nothing , pPropAlign = Nothing , pPropSpaceBefore = Nothing + , pPropIndent = Just 0 } newtype TeXString = TeXString {unTeXString :: String} @@ -411,18 +414,23 @@ blockToParagraphs (LineBlock ilsList) = do pProps <- asks envParaProps return [Paragraph pProps parElems] -- TODO: work out the attributes -blockToParagraphs (CodeBlock attr str) = - local (\r -> r{ envParaProps = def{pPropMarginLeft = Just 100} +blockToParagraphs (CodeBlock attr str) = do + pProps <- asks envParaProps + local (\r -> r{ envParaProps = def{ pPropMarginLeft = Nothing + , pPropBullet = Nothing + , pPropLevel = pPropLevel pProps + , pPropIndent = Just 0 + } , envRunProps = (envRunProps r){rPropCode = True}}) $ do - mbSty <- writerHighlightStyle <$> asks envOpts - synMap <- writerSyntaxMap <$> asks envOpts - case mbSty of - Just sty -> - case highlight synMap (formatSourceLines sty) attr str of - Right pElems -> do pProps <- asks envParaProps - return [Paragraph pProps pElems] - Left _ -> blockToParagraphs $ Para [Str str] - Nothing -> blockToParagraphs $ Para [Str str] + mbSty <- writerHighlightStyle <$> asks envOpts + synMap <- writerSyntaxMap <$> asks envOpts + case mbSty of + Just sty -> + case highlight synMap (formatSourceLines sty) attr str of + Right pElems -> do pPropsNew <- asks envParaProps + return [Paragraph pPropsNew pElems] + Left _ -> blockToParagraphs $ Para [Str str] + Nothing -> blockToParagraphs $ Para [Str str] -- We can't yet do incremental lists, but we should render a -- (BlockQuote List) as a list to maintain compatibility with other -- formats. @@ -431,7 +439,9 @@ blockToParagraphs (BlockQuote (blk : blks)) | isListType blk = do ps' <- blockToParagraphs $ BlockQuote blks return $ ps ++ ps' blockToParagraphs (BlockQuote blks) = - local (\r -> r{ envParaProps = (envParaProps r){pPropMarginLeft = Just 100} + local (\r -> r{ envParaProps = (envParaProps r){ pPropMarginLeft = Just 100 + , pPropIndent = Just 0 + } , envRunProps = (envRunProps r){rPropForceSize = Just blockQuoteSize}})$ concatMapM blockToParagraphs blks -- TODO: work out the format @@ -455,6 +465,7 @@ blockToParagraphs (BulletList blksLst) = do , envParaProps = pProps{ pPropLevel = lvl + 1 , pPropBullet = Just Bullet , pPropMarginLeft = Nothing + , pPropIndent = Nothing }}) $ concatMapM multiParBullet blksLst blockToParagraphs (OrderedList listAttr blksLst) = do @@ -464,6 +475,7 @@ blockToParagraphs (OrderedList listAttr blksLst) = do , envParaProps = pProps{ pPropLevel = lvl + 1 , pPropBullet = Just (AutoNumbering listAttr) , pPropMarginLeft = Nothing + , pPropIndent = Nothing }}) $ concatMapM multiParBullet blksLst blockToParagraphs (DefinitionList entries) = do |