git.iko.soy/typeable/pandoc
on master help sign in
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.

commit64c4451ef3b55a6c545de232af62780e0f5766d7 authorJesse Rosenthal <jrosenthal@jhu.edu> dateSun 14 Jan 2018, 01:37 (9 years ago) parent1577289
1 file changed+33−45
src/Text/Pandoc/Writers/Powerpoint.hs+33−45
src/Text/Pandoc/Writers/Powerpoint.hs+33−45
@@ -42,7 +42,6 @@ import Data.Time.Clock (UTCTime)
4242import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)
4343import System.FilePath.Posix (splitDirectories, splitExtension, takeExtension)
4444import Text.XML.Light
45−import qualified Text.XML.Light.Cursor as XMLC
4645import Text.Pandoc.Definition
4746import qualified Text.Pandoc.UTF8 as UTF8
4847import Text.Pandoc.Class (PandocMonad)
@@ -126,7 +125,7 @@ data WriterEnv = WriterEnv { envMetadata :: Meta
126125 -- the end of the slide file name and
127126 -- the rId number
128127 , envSlideIdOffset :: Int
129− , envColumnNumber :: Maybe Int
128+ , envContentType :: ContentType
130129 }
131130 deriving (Show)
132131
@@ -145,9 +144,14 @@ instance Default WriterEnv where
145144 , envInNoteSlide = False
146145 , envCurSlideId = 1
147146 , envSlideIdOffset = 1
148− , envColumnNumber = Nothing
147+ , envContentType = NormalContent
149148 }
150149
150+data ContentType = NormalContent
151+ | TwoColumnLeftContent
152+ | TwoColumnRightContent
153+ deriving (Show, Eq)
154+
151155data MediaInfo = MediaInfo { mInfoFilePath :: FilePath
152156 , mInfoLocalId :: Int
153157 , mInfoGlobalId :: Int
@@ -912,15 +916,20 @@ shapeHasId ns ident element
912916-- column is id=4.
913917getContentShape :: PandocMonad m => NameSpaces -> Element -> P m Element
914918getContentShape ns spTreeElem
915− | isElem ns "p" "spTree" spTreeElem =
916− case filterChild
917− (\e -> (isElem ns "p" "sp" e) && (shapeHasId ns "3" e))
918− spTreeElem
919− of
920− Just e -> return e
921− Nothing -> throwError $
922− PandocSomeError $
923− "Could not find shape for Powerpoint content"
919+ | isElem ns "p" "spTree" spTreeElem = do
920+ contentType <- asks envContentType
921+ let ident = case contentType of
922+ NormalContent -> "3"
923+ TwoColumnLeftContent -> "3"
924+ TwoColumnRightContent -> "4"
925+ case filterChild
926+ (\e -> (isElem ns "p" "sp" e) && (shapeHasId ns ident e))
927+ spTreeElem
928+ of
929+ Just e -> return e
930+ Nothing -> throwError $
931+ PandocSomeError $
932+ "Could not find shape for Powerpoint content"
924933getContentShape _ _ = throwError $
925934 PandocSomeError $
926935 "Attempted to find content on non shapeTree"
@@ -1552,40 +1561,15 @@ contentToElement layout hdrShape shapes
15521561 let hdrShapeElements = if null hdrShape
15531562 then []
15541563 else [element]
1555− contentElements <- shapesToElements layout shapes
1564+ contentElements <- local
1565+ (\env -> env {envContentType = NormalContent})
1566+ (shapesToElements layout shapes)
15561567 return $
15571568 replaceNamedChildren ns "p" "sp"
15581569 (hdrShapeElements ++ contentElements)
15591570 spTree
15601571contentToElement _ _ _ = return $ mknode "p:sp" [] ()
15611572
1562−setIdx'' :: NameSpaces -> String -> Content -> Content
1563−setIdx'' _ idx (Elem element) =
1564− let tag = XMLC.getTag element
1565− attrs = XMLC.tagAttribs tag
1566− idxKey = (QName "idx" Nothing Nothing)
1567− attrs' = Attr idxKey idx : (filter (\a -> attrKey a /= idxKey) attrs)
1568− tag' = tag {XMLC.tagAttribs = attrs'}
1569− in Elem $ XMLC.setTag tag' element
1570−setIdx'' _ _ c = c
1571−
1572−setIdx' :: NameSpaces -> String -> XMLC.Cursor -> XMLC.Cursor
1573−setIdx' ns idx cur =
1574− let modifiedCur = XMLC.modifyContent (setIdx'' ns idx) cur
1575− in
1576− case XMLC.nextDF modifiedCur of
1577− Just cur' -> setIdx' ns idx cur'
1578− Nothing -> XMLC.root modifiedCur
1579−
1580−setIdx :: NameSpaces -> String -> Element -> Element
1581−setIdx ns idx element =
1582− let cur = XMLC.fromContent (Elem element)
1583− cur' = setIdx' ns idx cur
1584− in
1585− case XMLC.toTree cur' of
1586− Elem element' -> element'
1587− _ -> element
1588−
15891573twoColumnToElement :: PandocMonad m => Element -> [ParaElem] -> [Shape] -> [Shape] -> P m Element
15901574twoColumnToElement layout hdrShape shapesL shapesR
15911575 | ns <- elemToNameSpaces layout
@@ -1595,13 +1579,17 @@ twoColumnToElement layout hdrShape shapesL shapesR
15951579 let hdrShapeElements = if null hdrShape
15961580 then []
15971581 else [element]
1598− contentElementsL <- shapesToElements layout shapesL
1599− contentElementsR <- shapesToElements layout shapesR
1600− let contentElementsL' = map (setIdx ns "1") contentElementsL
1601− contentElementsR' = map (setIdx ns "2") contentElementsR
1582+ contentElementsL <- local
1583+ (\env -> env {envContentType =TwoColumnLeftContent})
1584+ (shapesToElements layout shapesL)
1585+ contentElementsR <- local
1586+ (\env -> env {envContentType =TwoColumnRightContent})
1587+ (shapesToElements layout shapesR)
1588+ -- let contentElementsL' = map (setIdx ns "1") contentElementsL
1589+ -- contentElementsR' = map (setIdx ns "2") contentElementsR
16021590 return $
16031591 replaceNamedChildren ns "p" "sp"
1604− (hdrShapeElements ++ contentElementsL' ++ contentElementsR')
1592+ (hdrShapeElements ++ contentElementsL ++ contentElementsR)
16051593 spTree
16061594twoColumnToElement _ _ _ _= return $ mknode "p:sp" [] ()
16071595