944ed5e · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Powerpoint writer: read presentation size from reference file.

944ed5eJesse Rosenthal9 years ago

src/Text/Pandoc/Writers/Powerpoint.hs+45−29

compare with master

unifiedsplit

@@ -82,6 +82,12 @@ writePowerpoint opts (Pandoc meta blks) = do

83 utctime <- P.getCurrentTime

85+ presSize <- case getPresentationSize refArchive distArchive of

86+ Just sz -> return sz

87+ Nothing -> throwError $

88+ PandocSomeError $

89+ "Could not determine presentation size"

90+

85 let env = def { envMetadata = meta

91 let env = def { envMetadata = meta

86 , envRefArchive = refArchive

92 , envRefArchive = refArchive

87 , envDistArchive = distArchive

93 , envDistArchive = distArchive

@@ -90,6 +96,7 @@ writePowerpoint opts (Pandoc meta blks) = do

90 , envSlideLevel = case writerSlideLevel opts of

96 , envSlideLevel = case writerSlideLevel opts of

91 Just n -> n

97 Just n -> n

92 Nothing -> getSlideLevel blks'

98 Nothing -> getSlideLevel blks'

99+ , envPresentationSize = presSize

93 }

100 }

101

95 let st = def { stMediaGlobalIds = initialGlobalIds refArchive distArchive

102 let st = def { stMediaGlobalIds = initialGlobalIds refArchive distArchive

@@ -110,7 +117,7 @@ data WriterEnv = WriterEnv { envMetadata :: Meta

110 , envDistArchive :: Archive

117 , envDistArchive :: Archive

111 , envUTCTime :: UTCTime

118 , envUTCTime :: UTCTime

112 , envOpts :: WriterOptions

119 , envOpts :: WriterOptions

113− , envPresentationSize :: PresentationSize

120+ , envPresentationSize :: (Integer, Integer)

114 , envSlideHasHeader :: Bool

121 , envSlideHasHeader :: Bool

115 , envInList :: Bool

122 , envInList :: Bool

116 , envInNoteSlide :: Bool

123 , envInNoteSlide :: Bool

@@ -131,7 +138,7 @@ instance Default WriterEnv where

131 , envDistArchive = emptyArchive

138 , envDistArchive = emptyArchive

132 , envUTCTime = posixSecondsToUTCTime 0

139 , envUTCTime = posixSecondsToUTCTime 0

133 , envOpts = def

140 , envOpts = def

134− , envPresentationSize = def

141+ , envPresentationSize = (720, 540)

135 , envSlideHasHeader = False

142 , envSlideHasHeader = False

136 , envInList = False

143 , envInList = False

137 , envInNoteSlide = False

144 , envInNoteSlide = False

@@ -183,6 +190,19 @@ initialGlobalIds refArchive distArchive =

183 in

190 in

184 M.fromList $ mapMaybe go mediaPaths

191 M.fromList $ mapMaybe go mediaPaths

185

192

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+

186type P m = ReaderT WriterEnv (StateT WriterState m)

206type P m = ReaderT WriterEnv (StateT WriterState m)

187

207

188runP :: Monad m => WriterEnv -> WriterState -> P m a -> m a

208runP :: Monad m => WriterEnv -> WriterState -> P m a -> m a

@@ -190,28 +210,28 @@ runP env st p = evalStateT (runReaderT p env) st

190

210

191type Pixels = Integer

211type Pixels = Integer

192

212

193−data Presentation = Presentation PresentationSize [Slide]

213+data Presentation = Presentation [Slide]

194 deriving (Show)

214 deriving (Show)

195

215

196−data PresentationSize = PresentationSize { presSizeWidth :: Pixels

216+-- data PresentationSize = PresentationSize { presSizeWidth :: Pixels

197− , presSizeRatio :: PresentationRatio

217+-- , presSizeRatio :: PresentationRatio

198− }

218+-- }

199− deriving (Show, Eq)

219+-- deriving (Show, Eq)

200

220

201−data PresentationRatio = Ratio4x3

221+-- data PresentationRatio = Ratio4x3

202− | Ratio16x9

222+-- | Ratio16x9

203− | Ratio16x10

223+-- | Ratio16x10

204− deriving (Show, Eq)

224+-- deriving (Show, Eq)

205

225

206-- Note that right now we're only using Ratio4x3.

226-- Note that right now we're only using Ratio4x3.

207−getPageHeight :: PresentationSize -> Pixels

227+-- getPageHeight :: PresentationSize -> Pixels

208−getPageHeight sz = case presSizeRatio sz of

228+-- getPageHeight sz = case presSizeRatio sz of

209− Ratio4x3 -> floor (((fromInteger (presSizeWidth sz)) / 4) * 3 :: Double)

229+-- Ratio4x3 -> floor (((fromInteger (presSizeWidth sz)) / 4) * 3 :: Double)

210− Ratio16x9 -> floor (((fromInteger (presSizeWidth sz)) / 16) * 9 :: Double)

230+-- Ratio16x9 -> floor (((fromInteger (presSizeWidth sz)) / 16) * 9 :: Double)

211− Ratio16x10 -> floor (((fromInteger (presSizeWidth sz)) / 16) * 10 :: Double)

231+-- Ratio16x10 -> floor (((fromInteger (presSizeWidth sz)) / 16) * 10 :: Double)

212

232

213−instance Default PresentationSize where

233+-- instance Default PresentationSize where

214− def = PresentationSize 720 Ratio4x3

234+-- def = PresentationSize 720 Ratio4x3

215

235

216data Slide = MetadataSlide { metadataSlideTitle :: [ParaElem]

236data Slide = MetadataSlide { metadataSlideTitle :: [ParaElem]

217 , metadataSlideSubtitle :: [ParaElem]

237 , metadataSlideSubtitle :: [ParaElem]

@@ -520,7 +540,7 @@ blockToShape (Para (il:_)) | Link _ (il':_) target <- il

520 Pic def{picPropLink = Just target} url attr <$> (inlinesToParElems ils)

540 Pic def{picPropLink = Just target} url attr <$> (inlinesToParElems ils)

521blockToShape (Table caption algn _ hdrCells rows) = do

541blockToShape (Table caption algn _ hdrCells rows) = do

522 caption' <- inlinesToParElems caption

542 caption' <- inlinesToParElems caption

523− pageWidth <- presSizeWidth <$> asks envPresentationSize

543+ (pageWidth, _) <- asks envPresentationSize

524 hdrCells' <- rowToParagraphs algn hdrCells

544 hdrCells' <- rowToParagraphs algn hdrCells

525 rows' <- mapM (rowToParagraphs algn) rows

545 rows' <- mapM (rowToParagraphs algn) rows

526 let tblPr = if null hdrCells

546 let tblPr = if null hdrCells

@@ -641,8 +661,6 @@ blocksToSlide blks = do

641 slideLevel <- asks envSlideLevel

661 slideLevel <- asks envSlideLevel

642 blocksToSlide' slideLevel blks

662 blocksToSlide' slideLevel blks

643

663

644−

645−

646makeNoteEntry :: Int -> [Block] -> [Block]

664makeNoteEntry :: Int -> [Block] -> [Block]

647makeNoteEntry n blks =

665makeNoteEntry n blks =

648 let enum = Str (show n ++ ".")

666 let enum = Str (show n ++ ".")

@@ -763,9 +781,8 @@ blocksToPresentation blks = do

763 })

781 })

764 (blocksToSlide $ notesSlideBlocks)

782 (blocksToSlide $ notesSlideBlocks)

765 return [notesSlide]

783 return [notesSlide]

766− presSize <- asks envPresentationSize

767 return $

784 return $

768− Presentation presSize $

785+ Presentation $

769 metadataslides ++ tocSlides ++ bodyslides ++ notesSlides

786 metadataslides ++ tocSlides ++ bodyslides ++ notesSlides

770

787

771--------------------------------------------------------------------

788--------------------------------------------------------------------

@@ -829,7 +846,7 @@ requiredFiles = [ "_rels/.rels"

829

846

830

847

831presentationToArchive :: PandocMonad m => Presentation -> P m Archive

848presentationToArchive :: PandocMonad m => Presentation -> P m Archive

832−presentationToArchive p@(Presentation _ slides) = do

849+presentationToArchive p@(Presentation slides) = do

833 filePaths <- patternsToFilePaths inheritedPatterns

850 filePaths <- patternsToFilePaths inheritedPatterns

834

851

835 -- make sure all required files are available:

852 -- make sure all required files are available:

@@ -1126,8 +1143,7 @@ makePicElement :: PandocMonad m

1126 -> P m Element

1143 -> P m Element

1127makePicElement picProps mInfo attr = do

1144makePicElement picProps mInfo attr = do

1128 opts <- asks envOpts

1145 opts <- asks envOpts

1129− pageWidth <- presSizeWidth <$> asks envPresentationSize

1130− pageHeight <- getPageHeight <$> asks envPresentationSize

1146+ (pageWidth, pageHeight) <- asks envPresentationSize

1131 hasHeader <- asks envSlideHasHeader

1147 hasHeader <- asks envSlideHasHeader

1132 let hasCaption = mInfoCaption mInfo

1148 let hasCaption = mInfoCaption mInfo

1133 (imgBytes, _) <- P.fetchItem (mInfoFilePath mInfo)

1149 (imgBytes, _) <- P.fetchItem (mInfoFilePath mInfo)

@@ -1621,7 +1637,7 @@ getRels = do

1621 return $ mapMaybe elementToRel relElems

1637 return $ mapMaybe elementToRel relElems

1622

1638

1623presentationToRels :: PandocMonad m => Presentation -> P m [Relationship]

1639presentationToRels :: PandocMonad m => Presentation -> P m [Relationship]

1624−presentationToRels (Presentation _ slides) = do

1640+presentationToRels (Presentation slides) = do

1625 mySlideRels <- mapM (\(s, n) -> slideToPresRel s n) $ zip slides [1..]

1641 mySlideRels <- mapM (\(s, n) -> slideToPresRel s n) $ zip slides [1..]

1626 rels <- getRels

1642 rels <- getRels

1627 let relsWithoutSlides = filter (\r -> relType r /= "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide") rels

1643 let relsWithoutSlides = filter (\r -> relType r /= "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide") rels

@@ -1749,7 +1765,7 @@ slideToSldIdElement slide idNum = do

1749 return $ mknode "p:sldId" [("id", id'), ("r:id", rId)] ()

1765 return $ mknode "p:sldId" [("id", id'), ("r:id", rId)] ()

1750

1766

1751presentationToSldIdLst :: PandocMonad m => Presentation -> P m Element

1767presentationToSldIdLst :: PandocMonad m => Presentation -> P m Element

1752−presentationToSldIdLst (Presentation _ slides) = do

1768+presentationToSldIdLst (Presentation slides) = do

1753 ids <- mapM (\(s,n) -> slideToSldIdElement s n) (zip slides [1..])

1769 ids <- mapM (\(s,n) -> slideToSldIdElement s n) (zip slides [1..])

1754 return $ mknode "p:sldIdLst" [] ids

1770 return $ mknode "p:sldIdLst" [] ids

1755

1771

@@ -1845,7 +1861,7 @@ mediaContentType mInfo

1845 | otherwise = Nothing

1861 | otherwise = Nothing

1846

1862

1847presentationToContentTypes :: PandocMonad m => Presentation -> P m ContentTypes

1863presentationToContentTypes :: PandocMonad m => Presentation -> P m ContentTypes

1848−presentationToContentTypes (Presentation _ slides) = do

1864+presentationToContentTypes (Presentation slides) = do

1849 mediaInfos <- (mconcat . M.elems) <$> gets stMediaIds

1865 mediaInfos <- (mconcat . M.elems) <$> gets stMediaIds

1850 filePaths <- patternsToFilePaths inheritedPatterns

1866 filePaths <- patternsToFilePaths inheritedPatterns

1851 let mediaFps = filter (match (compile "ppt/media/image*")) filePaths

1867 let mediaFps = filter (match (compile "ppt/media/image*")) filePaths