@@ -82,6 +82,12 @@ writePowerpoint opts (Pandoc meta blks) = do
8282
8383 utctime <- P.getCurrentTime
8484
85+ presSize <- case getPresentationSize refArchive distArchive of
86+ Just sz -> return sz
87+ Nothing -> throwError $
88+ PandocSomeError $
89+ "Could not determine presentation size"
90+
8591 let env = def { envMetadata = meta
8692 , envRefArchive = refArchive
8793 , envDistArchive = distArchive
@@ -90,6 +96,7 @@ writePowerpoint opts (Pandoc meta blks) = do
9096 , envSlideLevel = case writerSlideLevel opts of
9197 Just n -> n
9298 Nothing -> getSlideLevel blks'
99+ , envPresentationSize = presSize
93100 }
94101
95102 let st = def { stMediaGlobalIds = initialGlobalIds refArchive distArchive
@@ -110,7 +117,7 @@ data WriterEnv = WriterEnv { envMetadata :: Meta
110117 , envDistArchive :: Archive
111118 , envUTCTime :: UTCTime
112119 , envOpts :: WriterOptions
113− , envPresentationSize :: PresentationSize
120+ , envPresentationSize :: (Integer, Integer)
114121 , envSlideHasHeader :: Bool
115122 , envInList :: Bool
116123 , envInNoteSlide :: Bool
@@ -131,7 +138,7 @@ instance Default WriterEnv where
131138 , envDistArchive = emptyArchive
132139 , envUTCTime = posixSecondsToUTCTime 0
133140 , envOpts = def
134− , envPresentationSize = def
141+ , envPresentationSize = (720, 540)
135142 , envSlideHasHeader = False
136143 , envInList = False
137144 , envInNoteSlide = False
@@ -183,6 +190,19 @@ initialGlobalIds refArchive distArchive =
183190 in
184191 M.fromList $ mapMaybe go mediaPaths
185192
193+getPresentationSize :: Archive -> Archive -> Maybe (Integer, Integer)
194+getPresentationSize refArchive distArchive = do
195+ entry <- findEntryByPath "ppt/presentation.xml" refArchive `mplus`
196+ findEntryByPath "ppt/presentation.xml" distArchive
197+ presElement <- parseXMLDoc $ UTF8.toStringLazy $ fromEntry entry
198+ let ns = elemToNameSpaces presElement
199+ sldSize <- findChild (elemName ns "p" "sldSz") presElement
200+ cxS <- findAttr (QName "cx" Nothing Nothing) sldSize
201+ cyS <- findAttr (QName "cy" Nothing Nothing) sldSize
202+ (cx, _) <- listToMaybe $ reads cxS :: Maybe (Integer, String)
203+ (cy, _) <- listToMaybe $ reads cyS :: Maybe (Integer, String)
204+ return (cx `div` 12700, cy `div` 12700)
205+
186206type P m = ReaderT WriterEnv (StateT WriterState m)
187207
188208runP :: Monad m => WriterEnv -> WriterState -> P m a -> m a
@@ -190,28 +210,28 @@ runP env st p = evalStateT (runReaderT p env) st
190210
191211type Pixels = Integer
192212
193−data Presentation = Presentation PresentationSize [Slide]
213+data Presentation = Presentation [Slide]
194214 deriving (Show)
195215
196−data PresentationSize = PresentationSize { presSizeWidth :: Pixels
197− , presSizeRatio :: PresentationRatio
198− }
199− deriving (Show, Eq)
216+-- data PresentationSize = PresentationSize { presSizeWidth :: Pixels
217+-- , presSizeRatio :: PresentationRatio
218+-- }
219+-- deriving (Show, Eq)
200220
201−data PresentationRatio = Ratio4x3
202− | Ratio16x9
203− | Ratio16x10
204− deriving (Show, Eq)
221+-- data PresentationRatio = Ratio4x3
222+-- | Ratio16x9
223+-- | Ratio16x10
224+-- deriving (Show, Eq)
205225
206226-- Note that right now we're only using Ratio4x3.
207−getPageHeight :: PresentationSize -> Pixels
208−getPageHeight sz = case presSizeRatio sz of
209− Ratio4x3 -> floor (((fromInteger (presSizeWidth sz)) / 4) * 3 :: Double)
210− Ratio16x9 -> floor (((fromInteger (presSizeWidth sz)) / 16) * 9 :: Double)
211− Ratio16x10 -> floor (((fromInteger (presSizeWidth sz)) / 16) * 10 :: Double)
227+-- getPageHeight :: PresentationSize -> Pixels
228+-- getPageHeight sz = case presSizeRatio sz of
229+-- Ratio4x3 -> floor (((fromInteger (presSizeWidth sz)) / 4) * 3 :: Double)
230+-- Ratio16x9 -> floor (((fromInteger (presSizeWidth sz)) / 16) * 9 :: Double)
231+-- Ratio16x10 -> floor (((fromInteger (presSizeWidth sz)) / 16) * 10 :: Double)
212232
213−instance Default PresentationSize where
214− def = PresentationSize 720 Ratio4x3
233+-- instance Default PresentationSize where
234+-- def = PresentationSize 720 Ratio4x3
215235
216236data Slide = MetadataSlide { metadataSlideTitle :: [ParaElem]
217237 , metadataSlideSubtitle :: [ParaElem]
@@ -520,7 +540,7 @@ blockToShape (Para (il:_)) | Link _ (il':_) target <- il
520540 Pic def{picPropLink = Just target} url attr <$> (inlinesToParElems ils)
521541blockToShape (Table caption algn _ hdrCells rows) = do
522542 caption' <- inlinesToParElems caption
523− pageWidth <- presSizeWidth <$> asks envPresentationSize
543+ (pageWidth, _) <- asks envPresentationSize
524544 hdrCells' <- rowToParagraphs algn hdrCells
525545 rows' <- mapM (rowToParagraphs algn) rows
526546 let tblPr = if null hdrCells
@@ -641,8 +661,6 @@ blocksToSlide blks = do
641661 slideLevel <- asks envSlideLevel
642662 blocksToSlide' slideLevel blks
643663
644−
645−
646664makeNoteEntry :: Int -> [Block] -> [Block]
647665makeNoteEntry n blks =
648666 let enum = Str (show n ++ ".")
@@ -763,9 +781,8 @@ blocksToPresentation blks = do
763781 })
764782 (blocksToSlide $ notesSlideBlocks)
765783 return [notesSlide]
766− presSize <- asks envPresentationSize
767784 return $
768− Presentation presSize $
785+ Presentation $
769786 metadataslides ++ tocSlides ++ bodyslides ++ notesSlides
770787
771788--------------------------------------------------------------------
@@ -829,7 +846,7 @@ requiredFiles = [ "_rels/.rels"
829846
830847
831848presentationToArchive :: PandocMonad m => Presentation -> P m Archive
832−presentationToArchive p@(Presentation _ slides) = do
849+presentationToArchive p@(Presentation slides) = do
833850 filePaths <- patternsToFilePaths inheritedPatterns
834851
835852 -- make sure all required files are available:
@@ -1126,8 +1143,7 @@ makePicElement :: PandocMonad m
11261143 -> P m Element
11271144makePicElement picProps mInfo attr = do
11281145 opts <- asks envOpts
1129− pageWidth <- presSizeWidth <$> asks envPresentationSize
1130− pageHeight <- getPageHeight <$> asks envPresentationSize
1146+ (pageWidth, pageHeight) <- asks envPresentationSize
11311147 hasHeader <- asks envSlideHasHeader
11321148 let hasCaption = mInfoCaption mInfo
11331149 (imgBytes, _) <- P.fetchItem (mInfoFilePath mInfo)
@@ -1621,7 +1637,7 @@ getRels = do
16211637 return $ mapMaybe elementToRel relElems
16221638
16231639presentationToRels :: PandocMonad m => Presentation -> P m [Relationship]
1624−presentationToRels (Presentation _ slides) = do
1640+presentationToRels (Presentation slides) = do
16251641 mySlideRels <- mapM (\(s, n) -> slideToPresRel s n) $ zip slides [1..]
16261642 rels <- getRels
16271643 let relsWithoutSlides = filter (\r -> relType r /= "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide") rels
@@ -1749,7 +1765,7 @@ slideToSldIdElement slide idNum = do
17491765 return $ mknode "p:sldId" [("id", id'), ("r:id", rId)] ()
17501766
17511767presentationToSldIdLst :: PandocMonad m => Presentation -> P m Element
1752−presentationToSldIdLst (Presentation _ slides) = do
1768+presentationToSldIdLst (Presentation slides) = do
17531769 ids <- mapM (\(s,n) -> slideToSldIdElement s n) (zip slides [1..])
17541770 return $ mknode "p:sldIdLst" [] ids
17551771
@@ -1845,7 +1861,7 @@ mediaContentType mInfo
18451861 | otherwise = Nothing
18461862
18471863presentationToContentTypes :: PandocMonad m => Presentation -> P m ContentTypes
1848−presentationToContentTypes (Presentation _ slides) = do
1864+presentationToContentTypes (Presentation slides) = do
18491865 mediaInfos <- (mconcat . M.elems) <$> gets stMediaIds
18501866 filePaths <- patternsToFilePaths inheritedPatterns
18511867 let mediaFps = filter (match (compile "ppt/media/image*")) filePaths