@@ -35,6 +35,9 @@ Presentation.
3535module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation
3636 , Presentation(..)
3737 , Slide(..)
38+ , Layout(..)
39+ , Notes(..)
40+ , SlideId(..)
3841 , Shape(..)
3942 , Graphic(..)
4043 , BulletType(..)
@@ -76,7 +79,7 @@ data WriterEnv = WriterEnv { envMetadata :: Meta
7679 , envSlideHasHeader :: Bool
7780 , envInList :: Bool
7881 , envInNoteSlide :: Bool
79− , envCurSlideId :: Int
82+ , envCurSlideId :: SlideId
8083 }
8184 deriving (Show)
8285
@@ -89,13 +92,13 @@ instance Default WriterEnv where
8992 , envSlideHasHeader = False
9093 , envInList = False
9194 , envInNoteSlide = False
92− , envCurSlideId = 1
95+ , envCurSlideId = SlideId "1"
9396 }
9497
9598
9699data WriterState = WriterState { stNoteIds :: M.Map Int [Block]
97100 -- associate anchors with slide id
98− , stAnchorMap :: M.Map String Int
101+ , stAnchorMap :: M.Map String SlideId
99102 , stLog :: [LogMessage]
100103 } deriving (Show, Eq)
101104
@@ -124,7 +127,20 @@ type Pixels = Integer
124127data Presentation = Presentation [Slide]
125128 deriving (Show)
126129
127−data Slide = MetadataSlide { metadataSlideTitle :: [ParaElem]
130+
131+data Slide = Slide SlideId Layout (Maybe Notes)
132+ deriving (Show, Eq)
133+
134+newtype SlideId = SlideId String
135+ deriving (Show, Eq)
136+
137+-- In theory you could have anything on a notes slide but it seems
138+-- designed mainly for one textbox, so we'll just put in the contents
139+-- of that textbox, to avoid other shapes that won't work as well.
140+newtype Notes = Notes [Paragraph]
141+ deriving (Show, Eq)
142+
143+data Layout = MetadataSlide { metadataSlideTitle :: [ParaElem]
128144 , metadataSlideSubtitle :: [ParaElem]
129145 , metadataSlideAuthors :: [[ParaElem]]
130146 , metadataSlideDate :: [ParaElem]
@@ -204,7 +220,7 @@ data Capitals = NoCapitals | SmallCapitals | AllCapitals
204220type URL = String
205221
206222data LinkTarget = ExternalTarget (URL, String)
207− | InternalTarget Int -- slideId
223+ | InternalTarget SlideId
208224 deriving (Show, Eq)
209225
210226data RunProps = RunProps { rPropBold :: Bool
@@ -513,18 +529,20 @@ blocksToSlide' :: Int -> [Block] -> Pres Slide
513529blocksToSlide' lvl ((Header n (ident, _, _) ils) : blks)
514530 | n < lvl = do
515531 registerAnchorId ident
532+ slideId <- asks envCurSlideId
516533 hdr <- inlinesToParElems ils
517− return $ TitleSlide {titleSlideHeader = hdr}
534+ return $ Slide slideId (TitleSlide {titleSlideHeader = hdr}) Nothing
518535 | n == lvl = do
519536 registerAnchorId ident
520537 hdr <- inlinesToParElems ils
521538 -- Now get the slide without the header, and then add the header
522539 -- in.
523− slide <- blocksToSlide' lvl blks
524− return $ case slide of
525− ContentSlide _ cont -> ContentSlide hdr cont
526− TwoColumnSlide _ contL contR -> TwoColumnSlide hdr contL contR
527− slide' -> slide'
540+ (Slide slideId layout mbNotes) <- blocksToSlide' lvl blks
541+ let layout' = case layout of
542+ ContentSlide _ cont -> ContentSlide hdr cont
543+ TwoColumnSlide _ contL contR -> TwoColumnSlide hdr contL contR
544+ layout'' -> layout''
545+ return $ Slide slideId layout' mbNotes
528546blocksToSlide' _ (blk : blks)
529547 | Div (_, classes, _) divBlks <- blk
530548 , "columns" `elem` classes
@@ -544,21 +562,36 @@ blocksToSlide' _ (blk : blks)
544562 [] -> []
545563 shapesL <- blocksToShapes blksL'
546564 shapesR <- blocksToShapes blksR'
547− return $ TwoColumnSlide { twoColumnSlideHeader = []
548− , twoColumnSlideLeft = shapesL
549− , twoColumnSlideRight = shapesR
550− }
565+ slideId <- asks envCurSlideId
566+ return $ Slide
567+ slideId
568+ TwoColumnSlide { twoColumnSlideHeader = []
569+ , twoColumnSlideLeft = shapesL
570+ , twoColumnSlideRight = shapesR
571+ }
572+ Nothing
551573blocksToSlide' _ (blk : blks) = do
552574 inNoteSlide <- asks envInNoteSlide
553575 shapes <- if inNoteSlide
554576 then forceFontSize noteSize $ blocksToShapes (blk : blks)
555577 else blocksToShapes (blk : blks)
556− return $ ContentSlide { contentSlideHeader = []
557− , contentSlideContent = shapes
558− }
559−blocksToSlide' _ [] = return $ ContentSlide { contentSlideHeader = []
560− , contentSlideContent = []
561− }
578+ slideId <- asks envCurSlideId
579+ return $
580+ Slide
581+ slideId
582+ ContentSlide { contentSlideHeader = []
583+ , contentSlideContent = shapes
584+ }
585+ Nothing
586+blocksToSlide' _ [] = do
587+ slideId <- asks envCurSlideId
588+ return $
589+ Slide
590+ slideId
591+ ContentSlide { contentSlideHeader = []
592+ , contentSlideContent = []
593+ }
594+ Nothing
562595
563596blocksToSlide :: [Block] -> Pres Slide
564597blocksToSlide blks = do
@@ -612,13 +645,20 @@ getMetaSlide = do
612645 _ -> []
613646 authors <- mapM inlinesToParElems $ docAuthors meta
614647 date <- inlinesToParElems $ docDate meta
648+ slideId <- asks envCurSlideId
615649 if null title && null subtitle && null authors && null date
616650 then return Nothing
617− else return $ Just $ MetadataSlide { metadataSlideTitle = title
618− , metadataSlideSubtitle = subtitle
619− , metadataSlideAuthors = authors
620− , metadataSlideDate = date
621− }
651+ else return $
652+ Just $
653+ Slide
654+ slideId
655+ MetadataSlide { metadataSlideTitle = title
656+ , metadataSlideSubtitle = subtitle
657+ , metadataSlideAuthors = authors
658+ , metadataSlideDate = date
659+ }
660+ Nothing
661+
622662-- adapted from the markdown writer
623663elementToListItem :: Shared.Element -> Pres [Block]
624664elementToListItem (Shared.Sec lev _nums (ident,_,_) headerText subsecs) = do
@@ -676,26 +716,35 @@ applyToShape f (TextBox paras) = do
676716 paras' <- mapM (applyToParagraph f) paras
677717 return $ TextBox paras'
678718
679−applyToSlide :: Monad m => (ParaElem -> m ParaElem) -> Slide -> m Slide
680−applyToSlide f (MetadataSlide title subtitle authors date) = do
719+applyToLayout :: Monad m => (ParaElem -> m ParaElem) -> Layout -> m Layout
720+applyToLayout f (MetadataSlide title subtitle authors date) = do
681721 title' <- mapM f title
682722 subtitle' <- mapM f subtitle
683723 authors' <- mapM (mapM f) authors
684724 date' <- mapM f date
685725 return $ MetadataSlide title' subtitle' authors' date'
686−applyToSlide f (TitleSlide title) = do
726+applyToLayout f (TitleSlide title) = do
687727 title' <- mapM f title
688728 return $ TitleSlide title'
689−applyToSlide f (ContentSlide hdr content) = do
729+applyToLayout f (ContentSlide hdr content) = do
690730 hdr' <- mapM f hdr
691731 content' <- mapM (applyToShape f) content
692732 return $ ContentSlide hdr' content'
693−applyToSlide f (TwoColumnSlide hdr contentL contentR) = do
733+applyToLayout f (TwoColumnSlide hdr contentL contentR) = do
694734 hdr' <- mapM f hdr
695735 contentL' <- mapM (applyToShape f) contentL
696736 contentR' <- mapM (applyToShape f) contentR
697737 return $ TwoColumnSlide hdr' contentL' contentR'
698738
739+applyToSlide :: Monad m => (ParaElem -> m ParaElem) -> Slide -> m Slide
740+applyToSlide f (Slide slideId layout mbNotes) = do
741+ layout' <- applyToLayout f layout
742+ mbNotes' <- case mbNotes of
743+ Just (Notes notes) -> (Just . Notes) <$>
744+ mapM (applyToParagraph f) notes
745+ Nothing -> return Nothing
746+ return $ Slide slideId layout' mbNotes'
747+
699748replaceAnchor :: ParaElem -> Pres ParaElem
700749replaceAnchor (Run rProps s)
701750 | Just (ExternalTarget ('#':anchor, _)) <- rLink rProps = do
@@ -728,7 +777,7 @@ blocksToPresentation blks = do
728777 let bodyStartNum = tocStartNum + tocSlidesLength
729778 blksLst <- splitBlocks blks
730779 bodyslides <- mapM
731− (\(bs, n) -> local (\st -> st{envCurSlideId = n}) (blocksToSlide bs))
780+ (\(bs, n) -> local (\st -> st{envCurSlideId = SlideId $ show n}) (blocksToSlide bs))
732781 (zip blksLst [bodyStartNum..])
733782 let endNoteStartNum = bodyStartNum + length bodyslides
734783 endNotesSlideBlocks <- makeEndNotesSlideBlocks
@@ -742,7 +791,7 @@ blocksToPresentation blks = do
742791 endNotesSlides <- if null endNotesSlideBlocks
743792 then return []
744793 else do endNotesSlide <- local
745− (\env -> env { envCurSlideId = endNoteStartNum
794+ (\env -> env { envCurSlideId = SlideId $ show endNoteStartNum
746795 , envInNoteSlide = True
747796 })
748797 (blocksToSlide $ endNotesSlideBlocks)