935b16b · typeable/pandoc

174getPageHeight sz = case presSizeRatio sz of

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

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

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

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

178

179instance Default PresentationSize where

180 def = PresentationSize 720 Ratio4x3

183 , metadataSlideSubtitle :: [ParaElem]

184 , metadataSlideAuthors :: [[ParaElem]]

185 , metadataSlideDate :: [ParaElem]

186− }

186+ }

187 | TitleSlide { titleSlideHeader :: [ParaElem]}

188 | ContentSlide { contentSlideHeader :: [ParaElem]

189 , contentSlideContent :: [Shape]

206

207type ColWidth = Integer

208

209−data Graphic = Tbl TableProps [ColWidth] [Cell] [[Cell]]

209+data Graphic = Tbl TableProps [ColWidth] [Cell] [[Cell]]

210 deriving (Show, Eq)

211

212

217data HeaderType = TitleHeader | SlideHeader | InternalHeader Int

218 deriving (Show, Eq)

219

220−-- type StartingAt = Int

220+-- type StartingAt = Int

221

222-- data AutoNumType = ArabicNum

223-- | AlphaUpperNum

362 return [Paragraph pProps parElems]

363blockToParagraphs (Para ils) = do

364 parElems <- inlinesToParElems ils

365− pProps <- asks envParaProps

365+ pProps <- asks envParaProps

366 return [Paragraph pProps parElems]

367blockToParagraphs (LineBlock ilsList) = do

368 parElems <- inlinesToParElems $ intercalate [LineBreak] ilsList

380-- TODO: work out the format

381blockToParagraphs (RawBlock _ _) = return []

382 -- parElems <- inlinesToParElems [Str str]

383− -- paraProps <- asks envParaProps

383+ -- paraProps <- asks envParaProps

384 -- return [Paragraph paraProps parElems]

385−-- TODO: work out the format

385+-- TODO: work out the format

386blockToParagraphs (Header n _ ils) = do

387 slideLevel <- asks envSlideLevel

388 parElems <- inlinesToParElems ils

490 EQ -> splitBlocks' [h] (acc ++ (if null cur then [] else [cur])) blks

491 GT -> splitBlocks' (cur ++ [h]) acc blks

492splitBlocks' cur acc ((Para (img@(Image _ _ _):ils)) : blks) = do

493− slideLevel <- asks envSlideLevel

493+ slideLevel <- asks envSlideLevel

494 case cur of

495 (Header n _ _) : [] | n == slideLevel ->

496 splitBlocks' []

500 (acc ++ (if null cur then [] else [cur]) ++ [[Para [img]]])

501 (if null ils then blks else (Para ils) : blks)

502splitBlocks' cur acc ((Plain (img@(Image _ _ _):ils)) : blks) = do

503− slideLevel <- asks envSlideLevel

503+ slideLevel <- asks envSlideLevel

504 case cur of

505 (Header n _ _) : [] | n == slideLevel ->

506 splitBlocks' []

510 (acc ++ (if null cur then [] else [cur]) ++ [[Para [img]]])

511 (if null ils then blks else (Plain ils) : blks)

512splitBlocks' cur acc (tbl@(Table _ _ _ _ _) : blks) = do

513− slideLevel <- asks envSlideLevel

513+ slideLevel <- asks envSlideLevel

514 case cur of

515 (Header n _ _) : [] | n == slideLevel ->

516 splitBlocks' [] (acc ++ [cur ++ [tbl]]) blks

592 distArchive <- asks envDistArchive

593 let allEntries = nub $ filesInArchive refArchive ++ filesInArchive distArchive

594 return $ filter (isPrefixOf "ppt/media") allEntries

595−

595+

596

597copyFileToArchiveIfExists :: PandocMonad m => Archive -> FilePath -> P m Archive

598copyFileToArchiveIfExists arch fp = do

635 -- , "ppt/slides/_rels/slide2.xml.rels"

636 -- This is the one we're

637 -- going to build

638− -- , "ppt/slides/slide2.xml"

638+ -- , "ppt/slides/slide2.xml"

639 -- , "ppt/slides/slide1.xml"

640 , "ppt/viewProps.xml"

641 , "ppt/tableStyles.xml"

670 slideEntries ++

671 slideRelEntries ++

672 mediaEntries ++

673− [contentTypesEntry, presEntry, presRelsEntry]

673+ [contentTypesEntry, presEntry, presRelsEntry]

674

675--------------------------------------------------

676

726

727-- getContentTitleShape :: NameSpaces -> Element -> Maybe Element

728-- getContentTitleShape ns spTreeElem

729−-- | isElem ns "p" "spTree" spTreeElem =

729+-- | isElem ns "p" "spTree" spTreeElem =

730-- filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Title 1" e)) spTreeElem

731-- | otherwise = Nothing

732

733-- getSubtitleShape :: NameSpaces -> Element -> Maybe Element

734-- getSubtitleShape ns spTreeElem

735−-- | isElem ns "p" "spTree" spTreeElem =

735+-- | isElem ns "p" "spTree" spTreeElem =

736-- filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Subtitle 2" e)) spTreeElem

737-- | otherwise = Nothing

738

739-- getDateShape :: NameSpaces -> Element -> Maybe Element

740-- getDateShape ns spTreeElem

741−-- | isElem ns "p" "spTree" spTreeElem =

741+-- | isElem ns "p" "spTree" spTreeElem =

742-- filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns "Date Placeholder 3" e)) spTreeElem

743-- | otherwise = Nothing

744−

744+

745getContentShape :: NameSpaces -> Element -> Maybe Element

746getContentShape ns spTreeElem

747− | isElem ns "p" "spTree" spTreeElem =

747+ | isElem ns "p" "spTree" spTreeElem =

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

749 | otherwise = Nothing

750

831

832 (imgBytes, mbMt) <- P.fetchItem fp

833 let imgExt = (mbMt >>= extensionFromMimeType >>= (\x -> return $ '.':x))

834− <|>

834+ <|>

835 case imageType imgBytes of

836 Just Png -> Just ".png"

837 Just Jpeg -> Just ".jpeg"

840 Just Eps -> Just ".eps"

841 Just Svg -> Just ".svg"

842 Nothing -> Nothing

843−

843+

844 let newGlobalId = case M.lookup fp globalIds of

845 Just ident -> ident

846 Nothing -> maxGlobalId + 1

893 (floor x, floor y)

894 | x / fromIntegral pageWidth > y / fromIntegral pageWidth =

895 (pageWidth, floor $ ((fromIntegral pageWidth) / x) * y)

896− | otherwise =

896+ | otherwise =

897 (floor $ ((fromIntegral pageHeight) / y) * x, pageHeight)

898

899positionImage :: (Double, Double) -> Integer -> Integer -> (Integer, Integer)

957createCaption paraElements = do

958 let para = Paragraph def{pPropAlign = Just AlgnCenter} paraElements

959 elements <- mapM paragraphToElement [para]

960− let ((x, y), (cx, cy)) = captionPosition

960+ let ((x, y), (cx, cy)) = captionPosition

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

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

963 return $

1041 , blipFill

1042 , spPr ]

1043

1044−-- Currently hardcoded, until I figure out how to make it dynamic.

1044+-- Currently hardcoded, until I figure out how to make it dynamic.

1045blockQuoteSize :: Pixels

1046blockQuoteSize = 20

1047

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

1151 emptySpPr = mknode "p:spPr" [] ()

1152 return $

1153− surroundWithMathAlternate $

1153+ surroundWithMathAlternate $

1154 replaceNamedChildren ns "p" "txBody" [txBody] $

1155 replaceNamedChildren ns "p" "spPr" [emptySpPr] $

1156 sp

1199

1200hardcodedTableMargin :: Integer

1201hardcodedTableMargin = 36

1202−

1202+

1203

1204graphicToElement :: PandocMonad m => Graphic -> P m Element

1205graphicToElement (Tbl tblPr colWidths hdrCells rows) = do

1241

1242getShapeByName :: NameSpaces -> Element -> String -> Maybe Element

1243getShapeByName ns spTreeElem name

1244− | isElem ns "p" "spTree" spTreeElem =

1244+ | isElem ns "p" "spTree" spTreeElem =

1245 filterChild (\e -> (isElem ns "p" "sp" e) && (shapeHasName ns name e)) spTreeElem

1246 | otherwise = Nothing

1247

1266-- | ns <- elemToNameSpaces layout

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

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

1269−-- , Just sp <- getContentTitleShape ns spTree =

1269+-- , Just sp <- getContentTitleShape ns spTree =

1270-- let hdrPara = Paragraph def paraElems

1271-- txBody = mknode "p:txBody" [] $

1272-- [mknode "a:bodyPr" [] (), mknode "a:lstStyle" [] ()] ++

1387

1388slideToPresRel :: Monad m => Slide -> Int -> P m Relationship

1389slideToPresRel slide idNum = do

1390− n <- gets stSlideIdOffset

1390+ n <- gets stSlideIdOffset

1391 let rId = idNum + n

1392 fp = "slides/" ++ slideToFilePath slide idNum

1393 return $ Relationship { relId = rId

1429 modifyRelNum n = n - minRelNotOne + 2 + length slides

1430

1431 relsWithoutSlides' = map (\r -> r{relId = modifyRelNum $ relId r}) relsWithoutSlides

1432−

1432+

1433 return $ mySlideRels ++ relsWithoutSlides'

1434

1435relToElement :: Relationship -> Element

1479 let ext = case mInfoExt mInfo of

1480 Just e -> e

1481 Nothing -> ""

1482− in

1482+ in

1483 mknode "Relationship" [ ("Id", "rId" ++ (show $ mInfoLocalId mInfo))

1484 , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/image")

1485 , ("Target", "../media/image" ++ (show $ mInfoGlobalId mInfo) ++ ext)

1503 Nothing -> []

1504

1505 return $

1506− mknode "Relationships"

1506+ mknode "Relationships"

1507 [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]

1508 ([mknode "Relationship" [ ("Id", "rId1")

1509 , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slideLayout")

1546presentationToPresEntry :: PandocMonad m => Presentation -> P m Entry

1547presentationToPresEntry pres = presentationToPresentationElement pres >>=

1548 elemToEntry "ppt/presentation.xml"

1549−

1550

1549

1551−

1550+

1551+

1552

1553defaultContentTypeToElem :: DefaultContentType -> Element

1554defaultContentTypeToElem dct =

1558 ()

1559

1560overrideContentTypeToElem :: OverrideContentType -> Element

1561−overrideContentTypeToElem oct =

1561+overrideContentTypeToElem oct =

1562 mknode "Override"

1563 [("PartName", overrideContentTypesPart oct),

1564 ("ContentType", overrideContentTypesType oct)]

1571 mknode "Types" [("xmlns", ns)] $

1572 (map defaultContentTypeToElem $ contentTypesDefaults ct) ++

1573 (map overrideContentTypeToElem $ contentTypesOverrides ct)

1574−

1574+

1575data DefaultContentType = DefaultContentType

1576 { defContentTypesExt :: String

1577 , defContentTypesType:: MimeType

1634

1635noPresML :: String

1636noPresML = "application/vnd.openxmlformats-officedocument"

1637−

1637+

1638getContentType :: FilePath -> Maybe MimeType

1639getContentType fp

1640 | fp == "ppt/presentation.xml" = Just $ presML ++ ".presentation.main+xml"