1577289 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Powerpoint writer: Make content shape retrieval environment-aware

1577289Jesse Rosenthal9 years ago

src/Text/Pandoc/Writers/Powerpoint.hs+48−28

compare with master

unifiedsplit

@@ -32,7 +32,7 @@ Conversion of 'Pandoc' documents to powerpoint (pptx).

33module Text.Pandoc.Writers.Powerpoint (writePowerpoint) where

35−import Control.Monad.Except (throwError)

35+import Control.Monad.Except (throwError, catchError)

36import Control.Monad.Reader

37import Control.Monad.State

38import Codec.Archive.Zip

@@ -126,6 +126,7 @@ data WriterEnv = WriterEnv { envMetadata :: Meta

126 -- the end of the slide file name and

127 -- the rId number

128 , envSlideIdOffset :: Int

129+ , envColumnNumber :: Maybe Int

129 }

130 }

130 deriving (Show)

131 deriving (Show)

131

132

@@ -144,6 +145,7 @@ instance Default WriterEnv where

144 , envInNoteSlide = False

145 , envInNoteSlide = False

145 , envCurSlideId = 1

146 , envCurSlideId = 1

146 , envSlideIdOffset = 1

147 , envSlideIdOffset = 1

148+ , envColumnNumber = Nothing

147 }

149 }

148

150

149data MediaInfo = MediaInfo { mInfoFilePath :: FilePath

151data MediaInfo = MediaInfo { mInfoFilePath :: FilePath

@@ -905,11 +907,23 @@ shapeHasId ns ident element

905 nm == ident

907 nm == ident

906 | otherwise = False

908 | otherwise = False

907

909

910+-- The content shape in slideLayout2 (Title/Content) has id=3 In

911+-- slideLayout4 (two column) the left column is id=3, and the right

912+-- column is id=4.

908−getContentShape :: NameSpaces -> Element -> Maybe Element

913+getContentShape :: PandocMonad m => NameSpaces -> Element -> P m Element

909getContentShape ns spTreeElem

914getContentShape ns spTreeElem

910 | isElem ns "p" "spTree" spTreeElem =

915 | isElem ns "p" "spTree" spTreeElem =

911− filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Content Placeholder 2" e)) spTreeElem

916+ case filterChild

917+ (\e -> (isElem ns "p" "sp" e) && (shapeHasId ns "3" e))

918+ spTreeElem

919+ of

920+ Just e -> return e

912− | otherwise = Nothing

921+ Nothing -> throwError $

922+ PandocSomeError $

923+ "Could not find shape for Powerpoint content"

924+getContentShape _ _ = throwError $

925+ PandocSomeError $

926+ "Attempted to find content on non shapeTree"

913

927

914getShapeDimensions :: NameSpaces

928getShapeDimensions :: NameSpaces

915 -> Element

929 -> Element

@@ -942,25 +956,31 @@ getMasterShapeDimensionsById ident master = do

942 sp <- filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasId ns ident e)) spTree

956 sp <- filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasId ns ident e)) spTree

943 getShapeDimensions ns sp

957 getShapeDimensions ns sp

944

958

945−getContentShapeSize :: NameSpaces

959+getContentShapeSize :: PandocMonad m

960+ => NameSpaces

946 -> Element

961 -> Element

947 -> Element

962 -> Element

948− -> Maybe ((Integer, Integer), (Integer, Integer))

963+ -> P m ((Integer, Integer), (Integer, Integer))

949getContentShapeSize ns layout master

964getContentShapeSize ns layout master

950 | isElem ns "p" "sldLayout" layout

965 | isElem ns "p" "sldLayout" layout

951 , Just cSld <- findChild (elemName ns "p" "cSld") layout

966 , Just cSld <- findChild (elemName ns "p" "cSld") layout

952− , Just spTree <- findChild (elemName ns "p" "spTree") cSld

967+ , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do

953− , Just sp <- getContentShape ns spTree

968+ sp <- getContentShape ns spTree

954− , Just sz <- getShapeDimensions ns sp = Just sz

969+ case getShapeDimensions ns sp of

955− | isElem ns "p" "sldLayout" layout

970+ Just sz -> return sz

956− , Just cSld <- findChild (elemName ns "p" "cSld") layout

971+ Nothing -> do let mbSz =

957− , Just spTree <- findChild (elemName ns "p" "spTree") cSld

958− , Just sp <- getContentShape ns spTree

959− , Just ident <- findChild (elemName ns "p" "nvSpPr") sp >>=

972+ findChild (elemName ns "p" "nvSpPr") sp >>=

960− findChild (elemName ns "p" "cNvPr") >>=

973+ findChild (elemName ns "p" "cNvPr") >>=

961− findAttr (QName "id" Nothing Nothing)

974+ findAttr (QName "id" Nothing Nothing) >>=

962− , Just sz <- getMasterShapeDimensionsById ident master = Just sz

975+ flip getMasterShapeDimensionsById master

963− | otherwise = Nothing

976+ case mbSz of

977+ Just sz' -> return sz'

978+ Nothing -> throwError $

979+ PandocSomeError $

980+ "Couldn't find necessary content shape size"

981+getContentShapeSize _ _ _ = throwError $

982+ PandocSomeError $

983+ "Attempted to find content shape size in non-layout"

964

984

965replaceNamedChildren :: NameSpaces

985replaceNamedChildren :: NameSpaces

966 -> String

986 -> String

@@ -1198,11 +1218,11 @@ makePicElements layout picProps mInfo _ alt = do

1198 Left _ -> sizeInPixels $ def

1218 Left _ -> sizeInPixels $ def

1199 master <- getMaster

1219 master <- getMaster

1200 let ns = elemToNameSpaces layout

1220 let ns = elemToNameSpaces layout

1201− let ((x, y), (cx, cytmp)) = case getContentShapeSize ns layout master of

1221+ ((x, y), (cx, cytmp)) <- getContentShapeSize ns layout master

1202− Just dims -> dims

1222+ `catchError`

1203− Nothing -> ((0, 0), (pageWidth, pageHeight))

1223+ (\_ -> return ((0, 0), (pageWidth, pageHeight)))

1204

1224

1205− cy = if hasCaption then cytmp - captionHeight else cytmp

1225+ let cy = if hasCaption then cytmp - captionHeight else cytmp

1206

1226

1207 let imgRatio = fromIntegral pxX / fromIntegral pxY :: Double

1227 let imgRatio = fromIntegral pxX / fromIntegral pxY :: Double

1208 boxRatio = fromIntegral cx / fromIntegral cy :: Double

1228 boxRatio = fromIntegral cx / fromIntegral cy :: Double

@@ -1390,8 +1410,8 @@ shapeToElement :: PandocMonad m => Element -> Shape -> P m Element

1390shapeToElement layout (TextBox paras)

1410shapeToElement layout (TextBox paras)

1391 | ns <- elemToNameSpaces layout

1411 | ns <- elemToNameSpaces layout

1392 , Just cSld <- findChild (elemName ns "p" "cSld") layout

1412 , Just cSld <- findChild (elemName ns "p" "cSld") layout

1393− , Just spTree <- findChild (elemName ns "p" "spTree") cSld

1413+ , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do

1394− , Just sp <- getContentShape ns spTree = do

1414+ sp <- getContentShape ns spTree

1395 elements <- mapM paragraphToElement paras

1415 elements <- mapM paragraphToElement paras

1396 let txBody = mknode "p:txBody" [] $

1416 let txBody = mknode "p:txBody" [] $

1397 [mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] ++ elements

1417 [mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] ++ elements

@@ -1430,11 +1450,11 @@ graphicFrameToElements layout tbls caption = do

1430 master <- getMaster

1450 master <- getMaster

1431 (pageWidth, pageHeight) <- asks envPresentationSize

1451 (pageWidth, pageHeight) <- asks envPresentationSize

1432 let ns = elemToNameSpaces layout

1452 let ns = elemToNameSpaces layout

1433− let ((x, y), (cx, cytmp)) = case getContentShapeSize ns layout master of

1453+ ((x, y), (cx, cytmp)) <- getContentShapeSize ns layout master

1434− Just dims -> dims

1454+ `catchError`

1435− Nothing -> ((0, 0), (pageWidth, pageHeight))

1455+ (\_ -> return ((0, 0), (pageWidth, pageHeight)))

1436

1456

1437− cy = if (not $ null caption) then cytmp - captionHeight else cytmp

1457+ let cy = if (not $ null caption) then cytmp - captionHeight else cytmp

1438

1458

1439 elements <- mapM graphicToElement tbls

1459 elements <- mapM graphicToElement tbls

1440 let graphicFrameElts =

1460 let graphicFrameElts =