From 64c4451ef3b55a6c545de232af62780e0f5766d7 Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Sun, 14 Jan 2018 01:37:51 -0500
Subject: Powerpoint writer: Position images correctly in two-column layout.
You can have two images side-by-side, or text alongside an image. The
image will be fit correctly within the column.
---
src/Text/Pandoc/Writers/Powerpoint.hs | 78 +++++++++++++++--------------------
1 file changed, 33 insertions(+), 45 deletions(-)
diff --git a/src/Text/Pandoc/Writers/Powerpoint.hs b/src/Text/Pandoc/Writers/Powerpoint.hs
index 62f355d76..4b6ea0853 100644
--- a/src/Text/Pandoc/Writers/Powerpoint.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint.hs
@@ -42,7 +42,6 @@ import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)
import System.FilePath.Posix (splitDirectories, splitExtension, takeExtension)
import Text.XML.Light
-import qualified Text.XML.Light.Cursor as XMLC
import Text.Pandoc.Definition
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Class (PandocMonad)
@@ -126,7 +125,7 @@ data WriterEnv = WriterEnv { envMetadata :: Meta
-- the end of the slide file name and
-- the rId number
, envSlideIdOffset :: Int
- , envColumnNumber :: Maybe Int
+ , envContentType :: ContentType
}
deriving (Show)
@@ -145,9 +144,14 @@ instance Default WriterEnv where
, envInNoteSlide = False
, envCurSlideId = 1
, envSlideIdOffset = 1
- , envColumnNumber = Nothing
+ , envContentType = NormalContent
}
+data ContentType = NormalContent
+ | TwoColumnLeftContent
+ | TwoColumnRightContent
+ deriving (Show, Eq)
+
data MediaInfo = MediaInfo { mInfoFilePath :: FilePath
, mInfoLocalId :: Int
, mInfoGlobalId :: Int
@@ -912,15 +916,20 @@ shapeHasId ns ident element
-- column is id=4.
getContentShape :: PandocMonad m => NameSpaces -> Element -> P m Element
getContentShape ns spTreeElem
- | isElem ns "p" "spTree" spTreeElem =
- case filterChild
- (\e -> (isElem ns "p" "sp" e) && (shapeHasId ns "3" e))
- spTreeElem
- of
- Just e -> return e
- Nothing -> throwError $
- PandocSomeError $
- "Could not find shape for Powerpoint content"
+ | isElem ns "p" "spTree" spTreeElem = do
+ contentType <- asks envContentType
+ let ident = case contentType of
+ NormalContent -> "3"
+ TwoColumnLeftContent -> "3"
+ TwoColumnRightContent -> "4"
+ case filterChild
+ (\e -> (isElem ns "p" "sp" e) && (shapeHasId ns ident e))
+ spTreeElem
+ of
+ Just e -> return e
+ Nothing -> throwError $
+ PandocSomeError $
+ "Could not find shape for Powerpoint content"
getContentShape _ _ = throwError $
PandocSomeError $
"Attempted to find content on non shapeTree"
@@ -1552,40 +1561,15 @@ contentToElement layout hdrShape shapes
let hdrShapeElements = if null hdrShape
then []
else [element]
- contentElements <- shapesToElements layout shapes
+ contentElements <- local
+ (\env -> env {envContentType = NormalContent})
+ (shapesToElements layout shapes)
return $
replaceNamedChildren ns "p" "sp"
(hdrShapeElements ++ contentElements)
spTree
contentToElement _ _ _ = return $ mknode "p:sp" [] ()
-setIdx'' :: NameSpaces -> String -> Content -> Content
-setIdx'' _ idx (Elem element) =
- let tag = XMLC.getTag element
- attrs = XMLC.tagAttribs tag
- idxKey = (QName "idx" Nothing Nothing)
- attrs' = Attr idxKey idx : (filter (\a -> attrKey a /= idxKey) attrs)
- tag' = tag {XMLC.tagAttribs = attrs'}
- in Elem $ XMLC.setTag tag' element
-setIdx'' _ _ c = c
-
-setIdx' :: NameSpaces -> String -> XMLC.Cursor -> XMLC.Cursor
-setIdx' ns idx cur =
- let modifiedCur = XMLC.modifyContent (setIdx'' ns idx) cur
- in
- case XMLC.nextDF modifiedCur of
- Just cur' -> setIdx' ns idx cur'
- Nothing -> XMLC.root modifiedCur
-
-setIdx :: NameSpaces -> String -> Element -> Element
-setIdx ns idx element =
- let cur = XMLC.fromContent (Elem element)
- cur' = setIdx' ns idx cur
- in
- case XMLC.toTree cur' of
- Elem element' -> element'
- _ -> element
-
twoColumnToElement :: PandocMonad m => Element -> [ParaElem] -> [Shape] -> [Shape] -> P m Element
twoColumnToElement layout hdrShape shapesL shapesR
| ns <- elemToNameSpaces layout
@@ -1595,13 +1579,17 @@ twoColumnToElement layout hdrShape shapesL shapesR
let hdrShapeElements = if null hdrShape
then []
else [element]
- contentElementsL <- shapesToElements layout shapesL
- contentElementsR <- shapesToElements layout shapesR
- let contentElementsL' = map (setIdx ns "1") contentElementsL
- contentElementsR' = map (setIdx ns "2") contentElementsR
+ contentElementsL <- local
+ (\env -> env {envContentType =TwoColumnLeftContent})
+ (shapesToElements layout shapesL)
+ contentElementsR <- local
+ (\env -> env {envContentType =TwoColumnRightContent})
+ (shapesToElements layout shapesR)
+ -- let contentElementsL' = map (setIdx ns "1") contentElementsL
+ -- contentElementsR' = map (setIdx ns "2") contentElementsR
return $
replaceNamedChildren ns "p" "sp"
- (hdrShapeElements ++ contentElementsL' ++ contentElementsR')
+ (hdrShapeElements ++ contentElementsL ++ contentElementsR)
spTree
twoColumnToElement _ _ _ _= return $ mknode "p:sp" [] ()
--
cgit v1.2.3