pptx: Support specifying slide background images

In the reveal-js output, it’s possible to use reveal’s
`data-background-image` class on a slide’s title to specify a background
image for the slide.

With this commit, it’s possible to use `background-image` in the same
way for pptx output. Only the “stretch” mode is supported, and the
background image is centred around the slide in the image’s larger axis,
matching the observed default behaviour of PowerPoint.

- Support `background-image` per slide.
- Add tests.
- Update manual.
This commit is contained in:
Emily Bourke 2021-09-13 18:16:19 +01:00 committed by John MacFarlane
parent c6cd92a0a3
commit 7c22c0202e
10 changed files with 178 additions and 60 deletions

View file

@ -6054,40 +6054,61 @@ the [Beamer User's Guide] may also be used: `allowdisplaybreaks`,
`allowframebreaks`, `b`, `c`, `t`, `environment`, `label`, `plain`, `allowframebreaks`, `b`, `c`, `t`, `environment`, `label`, `plain`,
`shrink`, `standout`, `noframenumbering`. `shrink`, `standout`, `noframenumbering`.
## Background in reveal.js and beamer ## Background in reveal.js, beamer, and pptx
Background images can be added to self-contained reveal.js slide shows and Background images can be added to self-contained reveal.js slide shows,
to beamer slide shows. beamer slide shows, and pptx slide shows.
For the same image on every slide, use the configuration ### On all slides (beamer, reveal.js, pptx)
option `background-image` either in the YAML metadata block
or as a command-line variable. (There are no other options in
beamer and the rest of this section concerns reveal.js slide shows.)
For reveal.js, you can instead use the reveal.js-native option With beamer and reveal.js, the configuration option `background-image` can be
`parallaxBackgroundImage`. You can also set `parallaxBackgroundHorizontal` used either in the YAML metadata block or as a command-line variable to get the
and `parallaxBackgroundVertical` the same way and must also set same image on every slide.
`parallaxBackgroundSize` to have your values take effect.
To set an image for a particular reveal.js slide, add For pptx, you can use a [reference doc](#option--reference-doc) in which
`{data-background-image="/path/to/image"}` background images have been set on the [relevant
to the first slide-level heading on the slide (which may even be empty). layouts](#powerpoint-layout-choice).
#### `parallaxBackgroundImage` (reveal.js)
For reveal.js, there is also the reveal.js-native option
`parallaxBackgroundImage`, which can be used instead of `background-image` to
produce a parallax scrolling background. You must also set
`parallaxBackgroundSize`, and can optionally set `parallaxBackgroundHorizontal`
and `parallaxBackgroundVertical` to configure the scrolling behaviour. See the
[reveal.js documentation](https://revealjs.com/backgrounds/#parallax-background)
for more details about the meaning of these options.
In reveal.js's overview mode, the parallaxBackgroundImage will show up In reveal.js's overview mode, the parallaxBackgroundImage will show up
only on the first slide. only on the first slide.
Other reveal.js background settings also work on individual slides, including ### On individual slides (reveal.js, pptx)
`data-background-size`, `data-background-repeat`, `data-background-color`,
`data-transition`, and `data-transition-speed`.
To add a background image to the automatically generated title slide, use the To set an image for a particular reveal.js or pptx slide, add
`title-slide-attributes` variable in the YAML metadata block. It must contain `{background-image="/path/to/image"}` to the first slide-level heading on the
a map of attribute names and values. slide (which may even be empty).
See the [reveal.js documentation](https://revealjs.com/backgrounds/) for more As the [HTML writers pass unknown attributes
details. through](#extension-link_attributes), other reveal.js background settings also
work on individual slides, including `background-size`, `background-repeat`,
`background-color`, `transition`, and `transition-speed`. (The `data-` prefix
will automatically be added.)
For example in reveal.js: Note: `data-background-image` is also supported in pptx for consistency with
reveal.js if `background-image` isnt found, `data-background-image` will be
checked.
### On the title slide (reveal.js, pptx)
To add a background image to the automatically generated title slide for
reveal.js, use the `title-slide-attributes` variable in the YAML metadata block.
It must contain a map of attribute names and values. (Note that the `data-`
prefix is required here, as it isnt added automatically.)
For pptx, pass a [reference doc](#option--reference-doc) with the background
image set on the “Title Slide” layout.
### Example (reveal.js)
``` ```
--- ---
@ -6102,7 +6123,7 @@ title-slide-attributes:
Slide 1 has background_image.png as its background. Slide 1 has background_image.png as its background.
## {data-background-image="/path/to/special_image.jpg"} ## {background-image="/path/to/special_image.jpg"}
Slide 2 has a special image for its background, even though the heading has no content. Slide 2 has a special image for its background, even though the heading has no content.
``` ```

View file

@ -380,6 +380,8 @@ extra-source-files:
test/rtf/*.native test/rtf/*.native
test/rtf/*.rtf test/rtf/*.rtf
test/pptx/*.pptx test/pptx/*.pptx
test/pptx/background-image/input.native
test/pptx/background-image/*.pptx
test/pptx/blanks/just-speaker-notes/input.native test/pptx/blanks/just-speaker-notes/input.native
test/pptx/blanks/just-speaker-notes/*.pptx test/pptx/blanks/just-speaker-notes/*.pptx
test/pptx/blanks/nbsp-in-body/input.native test/pptx/blanks/nbsp-in-body/input.native

View file

@ -31,6 +31,7 @@ import qualified Data.CaseInsensitive as CI
import Data.Default import Data.Default
import Data.Foldable (toList) import Data.Foldable (toList)
import Data.List.NonEmpty (nonEmpty, NonEmpty ((:|))) import Data.List.NonEmpty (nonEmpty, NonEmpty ((:|)))
import Data.Ratio ((%), Ratio)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Read (decimal) import Data.Text.Read (decimal)
@ -439,9 +440,9 @@ makeSpeakerNotesMap :: Presentation -> M.Map Int Int
makeSpeakerNotesMap (Presentation _ slides) = makeSpeakerNotesMap (Presentation _ slides) =
M.fromList $ M.fromList $
mapMaybe f (slides `zip` [1..]) `zip` [1..] mapMaybe f (slides `zip` [1..]) `zip` [1..]
where f (Slide _ _ notes, n) = if notes == mempty where f (Slide _ _ notes _, n) = if notes == mempty
then Nothing then Nothing
else Just n else Just n
presentationToArchive :: PandocMonad m presentationToArchive :: PandocMonad m
=> WriterOptions -> Meta -> Presentation -> m Archive => WriterOptions -> Meta -> Presentation -> m Archive
@ -1570,8 +1571,9 @@ metadataToElement layout titleElems subtitleElems authorsElems dateElems
metadataToElement _ _ _ _ _ = return (Nothing, mknode "p:sp" [] ()) metadataToElement _ _ _ _ _ = return (Nothing, mknode "p:sp" [] ())
slideToElement :: PandocMonad m => Slide -> P m Element slideToElement :: PandocMonad m => Slide -> P m Element
slideToElement (Slide _ l@(ContentSlide hdrElems shapes) _ )= do slideToElement (Slide _ l@(ContentSlide hdrElems shapes) _ backgroundImage) = do
layout <- getLayout l layout <- getLayout l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(shapeIds, spTree) (shapeIds, spTree)
<- local (\env -> if null hdrElems <- local (\env -> if null hdrElems
then env then env
@ -1585,9 +1587,10 @@ slideToElement (Slide _ l@(ContentSlide hdrElems shapes) _ )= do
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"), [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"), ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main") ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] (mknode "p:cSld" [] [spTree] : animations) ] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
slideToElement (Slide _ l@(TwoColumnSlide hdrElems shapesL shapesR) _) = do slideToElement (Slide _ l@(TwoColumnSlide hdrElems shapesL shapesR) _ backgroundImage) = do
layout <- getLayout l layout <- getLayout l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(shapeIds, spTree) <- local (\env -> if null hdrElems (shapeIds, spTree) <- local (\env -> if null hdrElems
then env then env
else env{envSlideHasHeader=True}) $ else env{envSlideHasHeader=True}) $
@ -1601,9 +1604,10 @@ slideToElement (Slide _ l@(TwoColumnSlide hdrElems shapesL shapesR) _) = do
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"), [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"), ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main") ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] (mknode "p:cSld" [] [spTree] : animations) ] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
slideToElement (Slide _ l@(ComparisonSlide hdrElems shapesL shapesR) _) = do slideToElement (Slide _ l@(ComparisonSlide hdrElems shapesL shapesR) _ backgroundImage) = do
layout <- getLayout l layout <- getLayout l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(shapeIds, spTree) <- local (\env -> if null hdrElems (shapeIds, spTree) <- local (\env -> if null hdrElems
then env then env
else env{envSlideHasHeader=True}) $ else env{envSlideHasHeader=True}) $
@ -1620,25 +1624,36 @@ slideToElement (Slide _ l@(ComparisonSlide hdrElems shapesL shapesR) _) = do
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"), [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"), ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main") ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] (mknode "p:cSld" [] [spTree] : animations) ] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
slideToElement (Slide _ l@(TitleSlide hdrElems) _) = do slideToElement (Slide _ l@(TitleSlide hdrElems) _ backgroundImage) = do
layout <- getLayout l layout <- getLayout l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(_, spTree) <- titleToElement layout hdrElems (_, spTree) <- titleToElement layout hdrElems
return $ mknode "p:sld" return $ mknode "p:sld"
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"), [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"), ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main") ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] [mknode "p:cSld" [] [spTree]] ] [mknode "p:cSld" [] (toList backgroundImageElement <> [spTree])]
slideToElement (Slide _ l@(MetadataSlide titleElems subtitleElems authorElems dateElems) _) = do slideToElement (Slide
_
l@(MetadataSlide titleElems subtitleElems authorElems dateElems)
_
backgroundImage) = do
layout <- getLayout l layout <- getLayout l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(_, spTree) <- metadataToElement layout titleElems subtitleElems authorElems dateElems (_, spTree) <- metadataToElement layout titleElems subtitleElems authorElems dateElems
return $ mknode "p:sld" return $ mknode "p:sld"
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"), [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"), ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main") ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] [mknode "p:cSld" [] [spTree]] ] [mknode "p:cSld" [] (toList backgroundImageElement <> [spTree])]
slideToElement (Slide _ l@(ContentWithCaptionSlide hdrElems captionShapes contentShapes) _) = do slideToElement (Slide
_
l@(ContentWithCaptionSlide hdrElems captionShapes contentShapes)
_
backgroundImage) = do
layout <- getLayout l layout <- getLayout l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(shapeIds, spTree) <- contentWithCaptionToElement layout hdrElems captionShapes contentShapes (shapeIds, spTree) <- contentWithCaptionToElement layout hdrElems captionShapes contentShapes
let animations = case shapeIds of let animations = case shapeIds of
Nothing -> [] Nothing -> []
@ -1650,15 +1665,63 @@ slideToElement (Slide _ l@(ContentWithCaptionSlide hdrElems captionShapes conten
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"), [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"), ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main") ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] (mknode "p:cSld" [] [spTree] : animations) ] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
slideToElement (Slide _ BlankSlide _) = do slideToElement (Slide _ BlankSlide _ backgroundImage) = do
layout <- getLayout BlankSlide layout <- getLayout BlankSlide
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
spTree <- blankToElement layout spTree <- blankToElement layout
return $ mknode "p:sld" return $ mknode "p:sld"
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"), [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"), ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main") ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] [mknode "p:cSld" [] [spTree]] ] [mknode "p:cSld" [] (toList backgroundImageElement <> [spTree])]
backgroundImageToElement :: PandocMonad m => FilePath -> P m Element
backgroundImageToElement path = do
MediaInfo{mInfoLocalId, mInfoFilePath} <- registerMedia path []
(imgBytes, _) <- P.fetchItem (T.pack mInfoFilePath)
opts <- asks envOpts
let imageDimensions = either (const Nothing)
(Just . sizeInPixels)
(imageSize opts imgBytes)
pageSize <- asks envPresentationSize
let fillRectAttributes = maybe [] (offsetAttributes pageSize) imageDimensions
let rId = "rId" <> T.pack (show mInfoLocalId)
return
$ mknode "p:bg" []
$ mknode "p:bgPr" []
[ mknode "a:blipFill" [("dpi", "0"), ("rotWithShape", "1")]
[ mknode "a:blip" [("r:embed", rId)]
$ mknode "a:lum" [] ()
, mknode "a:srcRect" [] ()
, mknode "a:stretch" []
$ mknode "a:fillRect" fillRectAttributes ()
]
, mknode "a:effectsLst" [] ()
]
where
offsetAttributes :: (Integer, Integer) -> (Integer, Integer) -> [(Text, Text)]
offsetAttributes (pageWidth, pageHeight) (pictureWidth, pictureHeight) = let
widthRatio = pictureWidth % pageWidth
heightRatio = pictureHeight % pageHeight
getOffset :: Ratio Integer -> Text
getOffset proportion = let
percentageOffset = (proportion - 1) * (-100 % 2)
integerOffset = round percentageOffset * 1000 :: Integer
in T.pack (show integerOffset)
in case compare widthRatio heightRatio of
EQ -> []
LT -> let
offset = getOffset ((pictureHeight % pageHeight) / widthRatio)
in [ ("t", offset)
, ("b", offset)
]
GT -> let
offset = getOffset ((pictureWidth % pageWidth) / heightRatio)
in [ ("l", offset)
, ("r", offset)
]
slideToIncrementalAnimations :: slideToIncrementalAnimations ::
[(ShapeId, Shape)] -> [(ShapeId, Shape)] ->
@ -1790,8 +1853,8 @@ speakerNotesSlideNumber pgNum fieldId =
] ]
slideToSpeakerNotesElement :: PandocMonad m => Slide -> P m (Maybe Element) slideToSpeakerNotesElement :: PandocMonad m => Slide -> P m (Maybe Element)
slideToSpeakerNotesElement (Slide _ _ (SpeakerNotes [])) = return Nothing slideToSpeakerNotesElement (Slide _ _ (SpeakerNotes []) _) = return Nothing
slideToSpeakerNotesElement slide@(Slide _ _ (SpeakerNotes paras)) = do slideToSpeakerNotesElement slide@(Slide _ _ (SpeakerNotes paras) _) = do
master <- getNotesMaster master <- getNotesMaster
fieldId <- getSlideNumberFieldId master fieldId <- getSlideNumberFieldId master
num <- slideNum slide num <- slideNum slide
@ -2037,7 +2100,7 @@ slideToSpeakerNotesEntry slide = do
_ -> return Nothing _ -> return Nothing
slideToSpeakerNotesRelElement :: PandocMonad m => Slide -> P m (Maybe Element) slideToSpeakerNotesRelElement :: PandocMonad m => Slide -> P m (Maybe Element)
slideToSpeakerNotesRelElement (Slide _ _ (SpeakerNotes [])) = return Nothing slideToSpeakerNotesRelElement (Slide _ _ (SpeakerNotes []) _) = return Nothing
slideToSpeakerNotesRelElement slide@Slide{} = do slideToSpeakerNotesRelElement slide@Slide{} = do
idNum <- slideNum slide idNum <- slideNum slide
return $ Just $ return $ Just $
@ -2124,13 +2187,13 @@ slideToSlideRelElement slide = do
target <- flip fmap getSlideLayouts $ target <- flip fmap getSlideLayouts $
T.pack . ("../slideLayouts/" <>) . takeFileName . T.pack . ("../slideLayouts/" <>) . takeFileName .
slPath . case slide of slPath . case slide of
(Slide _ MetadataSlide{} _) -> metadata (Slide _ MetadataSlide{} _ _) -> metadata
(Slide _ TitleSlide{} _) -> title (Slide _ TitleSlide{} _ _) -> title
(Slide _ ContentSlide{} _) -> content (Slide _ ContentSlide{} _ _) -> content
(Slide _ TwoColumnSlide{} _) -> twoColumn (Slide _ TwoColumnSlide{} _ _) -> twoColumn
(Slide _ ComparisonSlide{} _) -> comparison (Slide _ ComparisonSlide{} _ _) -> comparison
(Slide _ ContentWithCaptionSlide{} _) -> contentWithCaption (Slide _ ContentWithCaptionSlide{} _ _) -> contentWithCaption
(Slide _ BlankSlide _) -> blank (Slide _ BlankSlide _ _) -> blank
speakerNotesRels <- maybeToList <$> speakerNotesSlideRelElement slide speakerNotesRels <- maybeToList <$> speakerNotesSlideRelElement slide

View file

@ -63,7 +63,7 @@ import Text.Pandoc.Writers.Shared (lookupMetaInlines, lookupMetaBlocks
, toLegacyTable) , toLegacyTable)
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
import Data.Maybe (maybeToList, fromMaybe, listToMaybe) import Data.Maybe (maybeToList, fromMaybe, listToMaybe, isNothing)
import Text.Pandoc.Highlighting import Text.Pandoc.Highlighting
import qualified Data.Text as T import qualified Data.Text as T
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
@ -201,6 +201,7 @@ data DocProps = DocProps { dcTitle :: Maybe T.Text
data Slide = Slide { slideId :: SlideId data Slide = Slide { slideId :: SlideId
, slideLayout :: Layout , slideLayout :: Layout
, slideSpeakerNotes :: SpeakerNotes , slideSpeakerNotes :: SpeakerNotes
, slideBackgroundImage :: Maybe FilePath
} deriving (Show, Eq) } deriving (Show, Eq)
newtype SlideId = SlideId T.Text newtype SlideId = SlideId T.Text
@ -223,7 +224,7 @@ data Layout = MetadataSlide [ParaElem] [ParaElem] [[ParaElem]] [ParaElem]
| ComparisonSlide [ParaElem] ([Shape], [Shape]) ([Shape], [Shape]) | ComparisonSlide [ParaElem] ([Shape], [Shape]) ([Shape], [Shape])
-- heading left@(text, content) right@(text, content) -- heading left@(text, content) right@(text, content)
| ContentWithCaptionSlide [ParaElem] [Shape] [Shape] | ContentWithCaptionSlide [ParaElem] [Shape] [Shape]
-- heading text content -- heading text content
| BlankSlide | BlankSlide
deriving (Show, Eq) deriving (Show, Eq)
@ -725,6 +726,7 @@ bodyBlocksToSlide _ (blk : blks) spkNotes
sldId sldId
(TwoColumnSlide [] shapesL shapesR) (TwoColumnSlide [] shapesL shapesR)
spkNotes spkNotes
Nothing
let mkComparison blksL1 blksL2 blksR1 blksR2 = do let mkComparison blksL1 blksL2 blksR1 blksR2 = do
shapesL1 <- blocksToShapes blksL1 shapesL1 <- blocksToShapes blksL1
shapesL2 <- blocksToShapes blksL2 shapesL2 <- blocksToShapes blksL2
@ -735,6 +737,7 @@ bodyBlocksToSlide _ (blk : blks) spkNotes
sldId sldId
(ComparisonSlide [] (shapesL1, shapesL2) (shapesR1, shapesR2)) (ComparisonSlide [] (shapesL1, shapesL2) (shapesR1, shapesR2))
spkNotes spkNotes
Nothing
let (blksL1, blksL2) = break notText blksL let (blksL1, blksL2) = break notText blksL
(blksR1, blksR2) = break notText blksR (blksR1, blksR2) = break notText blksR
if (any null [blksL1, blksL2]) && (any null [blksR1, blksR2]) if (any null [blksL1, blksL2]) && (any null [blksR1, blksR2])
@ -744,7 +747,7 @@ bodyBlocksToSlide _ (blk : blks) spkNotes = do
sldId <- asks envCurSlideId sldId <- asks envCurSlideId
inNoteSlide <- asks envInNoteSlide inNoteSlide <- asks envInNoteSlide
let mkSlide s = let mkSlide s =
Slide sldId s spkNotes Slide sldId s spkNotes Nothing
if inNoteSlide if inNoteSlide
then mkSlide . ContentSlide [] <$> then mkSlide . ContentSlide [] <$>
forceFontSize noteSize (blocksToShapes (blk : blks)) forceFontSize noteSize (blocksToShapes (blk : blks))
@ -767,14 +770,15 @@ bodyBlocksToSlide _ [] spkNotes = do
sldId sldId
BlankSlide BlankSlide
spkNotes spkNotes
Nothing
blocksToSlide' :: Int -> [Block] -> SpeakerNotes -> Pres Slide blocksToSlide' :: Int -> [Block] -> SpeakerNotes -> Pres Slide
blocksToSlide' lvl (Header n (ident, _, _) ils : blks) spkNotes blocksToSlide' lvl (Header n (ident, _, attributes) ils : blks) spkNotes
| n < lvl = do | n < lvl = do
registerAnchorId ident registerAnchorId ident
sldId <- asks envCurSlideId sldId <- asks envCurSlideId
hdr <- inlinesToParElems ils hdr <- inlinesToParElems ils
return $ Slide sldId (TitleSlide hdr) spkNotes return $ Slide sldId (TitleSlide hdr) spkNotes backgroundImage
| n == lvl || lvl == 0 = do | n == lvl || lvl == 0 = do
registerAnchorId ident registerAnchorId ident
hdr <- inlinesToParElems ils hdr <- inlinesToParElems ils
@ -788,7 +792,10 @@ blocksToSlide' lvl (Header n (ident, _, _) ils : blks) spkNotes
ContentWithCaptionSlide _ text content -> ContentWithCaptionSlide hdr text content ContentWithCaptionSlide _ text content -> ContentWithCaptionSlide hdr text content
BlankSlide -> if all inlineIsBlank ils then BlankSlide else ContentSlide hdr [] BlankSlide -> if all inlineIsBlank ils then BlankSlide else ContentSlide hdr []
layout' -> layout' layout' -> layout'
return $ slide{slideLayout = layout} return $ slide{slideLayout = layout, slideBackgroundImage = backgroundImage}
where
backgroundImage = T.unpack <$> (lookup "background-image" attributes
<|> lookup "data-background-image" attributes)
blocksToSlide' lvl blks spkNotes = bodyBlocksToSlide lvl blks spkNotes blocksToSlide' lvl blks spkNotes = bodyBlocksToSlide lvl blks spkNotes
blockToSpeakerNotes :: Block -> Pres SpeakerNotes blockToSpeakerNotes :: Block -> Pres SpeakerNotes
@ -869,12 +876,13 @@ getMetaSlide = do
metadataSlideId metadataSlideId
(MetadataSlide title subtitle authors date) (MetadataSlide title subtitle authors date)
mempty mempty
Nothing
addSpeakerNotesToMetaSlide :: Slide -> [Block] -> Pres (Slide, [Block]) addSpeakerNotesToMetaSlide :: Slide -> [Block] -> Pres (Slide, [Block])
addSpeakerNotesToMetaSlide (Slide sldId layout@MetadataSlide{} spkNotes) blks = addSpeakerNotesToMetaSlide (Slide sldId layout@MetadataSlide{} spkNotes backgroundImage) blks =
do let (ntsBlks, blks') = span isNotesDiv blks do let (ntsBlks, blks') = span isNotesDiv blks
spkNotes' <- mconcat <$> mapM blockToSpeakerNotes ntsBlks spkNotes' <- mconcat <$> mapM blockToSpeakerNotes ntsBlks
return (Slide sldId layout (spkNotes <> spkNotes'), blks') return (Slide sldId layout (spkNotes <> spkNotes') backgroundImage, blks')
addSpeakerNotesToMetaSlide sld blks = return (sld, blks) addSpeakerNotesToMetaSlide sld blks = return (sld, blks)
makeTOCSlide :: [Block] -> Pres Slide makeTOCSlide :: [Block] -> Pres Slide
@ -1010,7 +1018,10 @@ emptyLayout layout = case layout of
emptySlide :: Slide -> Bool emptySlide :: Slide -> Bool
emptySlide (Slide _ layout notes) = (notes == mempty) && emptyLayout layout emptySlide (Slide _ layout notes backgroundImage)
= (notes == mempty)
&& emptyLayout layout
&& isNothing backgroundImage
makesBlankSlide :: [Block] -> Bool makesBlankSlide :: [Block] -> Bool
makesBlankSlide = all blockIsBlank makesBlankSlide = all blockIsBlank

View file

@ -240,4 +240,8 @@ tests = groupPptxTests [ pptxTests "Inline formatting"
def def
"pptx/incremental-lists/without-flag/input.native" "pptx/incremental-lists/without-flag/input.native"
"pptx/incremental-lists/without-flag/output.pptx" "pptx/incremental-lists/without-flag/output.pptx"
, pptxTests "Background images"
def
"pptx/background-image/input.native"
"pptx/background-image/output.pptx"
] ]

Binary file not shown.

View file

@ -0,0 +1,17 @@
[Header 1 ("section-header-with-background-image",[],[("background-image","movie.jpg")]) [Str "Section",Space,Str "Header",Space,Str "(with",Space,Str "background",Space,Str "image)"]
,Header 2 ("slide-1",[],[("background-image","lalune.jpg")]) [Str "Slide",Space,Str "1"]
,Para [Str "This",Space,Str "slide",Space,Str "has",Space,Str "a",Space,Str "moon",Space,Str "background."]
,Header 2 ("slide-2",[],[("background-image","movie.jpg")]) [Str "Slide",Space,Str "2"]
,Para [Str "This",Space,Str "slide",Space,Str "has",Space,Str "a",Space,Str "movie",Space,Str "background."]
,Header 2 ("slide-3",[],[("background-image","movie.jpg")]) [Str "Slide",Space,Str "3"]
,Div ("",["columns"],[])
[Div ("",["column"],[])
[Para [Str "Background",Space,Str "images",Space,Str "work",Space,Str "in",Space,Str "two-column",Space,Str "layout."]]
,Div ("",["column"],[])
[Para [Str "hello"]]]
,Header 2 ("slide-4",[],[("background-image","movie.jpg")]) [Str "Slide",Space,Str "4"]
,Para [Str "You",Space,Str "can",Space,Str "have",Space,Str "images",Space,Str "on",Space,Str "slides",Space,Str "that",Space,Str "have",Space,Str "background",Space,Str "images:"]
,Para [Image ("",[],[]) [Str "An",Space,Str "image"] ("lalune.jpg","fig:")]
,Header 2 ("section",[],[("background-image","lalune.jpg")]) []
,Div ("",["notes"],[])
[Para [Str "Blank",Space,Str "slides",Space,Str "can",Space,Str "have",Space,Str "background",Space,Str "images."]]]

Binary file not shown.

Binary file not shown.

Binary file not shown.