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`,
`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
to beamer slide shows.
Background images can be added to self-contained reveal.js slide shows,
beamer slide shows, and pptx slide shows.
For the same image on every slide, use the configuration
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.)
### On all slides (beamer, reveal.js, pptx)
For reveal.js, you can instead use the reveal.js-native option
`parallaxBackgroundImage`. You can also set `parallaxBackgroundHorizontal`
and `parallaxBackgroundVertical` the same way and must also set
`parallaxBackgroundSize` to have your values take effect.
With beamer and reveal.js, the configuration option `background-image` can be
used either in the YAML metadata block or as a command-line variable to get the
same image on every slide.
To set an image for a particular reveal.js slide, add
`{data-background-image="/path/to/image"}`
to the first slide-level heading on the slide (which may even be empty).
For pptx, you can use a [reference doc](#option--reference-doc) in which
background images have been set on the [relevant
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
only on the first slide.
Other reveal.js background settings also work on individual slides, including
`data-background-size`, `data-background-repeat`, `data-background-color`,
`data-transition`, and `data-transition-speed`.
### On individual slides (reveal.js, pptx)
To add a background image to the automatically generated title slide, use the
`title-slide-attributes` variable in the YAML metadata block. It must contain
a map of attribute names and values.
To set an image for a particular reveal.js or pptx slide, add
`{background-image="/path/to/image"}` to the first slide-level heading on the
slide (which may even be empty).
See the [reveal.js documentation](https://revealjs.com/backgrounds/) for more
details.
As the [HTML writers pass unknown attributes
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.
## {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.
```

View file

@ -380,6 +380,8 @@ extra-source-files:
test/rtf/*.native
test/rtf/*.rtf
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/*.pptx
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.Foldable (toList)
import Data.List.NonEmpty (nonEmpty, NonEmpty ((:|)))
import Data.Ratio ((%), Ratio)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Read (decimal)
@ -439,9 +440,9 @@ makeSpeakerNotesMap :: Presentation -> M.Map Int Int
makeSpeakerNotesMap (Presentation _ slides) =
M.fromList $
mapMaybe f (slides `zip` [1..]) `zip` [1..]
where f (Slide _ _ notes, n) = if notes == mempty
then Nothing
else Just n
where f (Slide _ _ notes _, n) = if notes == mempty
then Nothing
else Just n
presentationToArchive :: PandocMonad m
=> WriterOptions -> Meta -> Presentation -> m Archive
@ -1570,8 +1571,9 @@ metadataToElement layout titleElems subtitleElems authorsElems dateElems
metadataToElement _ _ _ _ _ = return (Nothing, mknode "p:sp" [] ())
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
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(shapeIds, spTree)
<- local (\env -> if null hdrElems
then env
@ -1585,9 +1587,10 @@ slideToElement (Slide _ l@(ContentSlide hdrElems shapes) _ )= do
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] (mknode "p:cSld" [] [spTree] : animations)
slideToElement (Slide _ l@(TwoColumnSlide hdrElems shapesL shapesR) _) = do
] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
slideToElement (Slide _ l@(TwoColumnSlide hdrElems shapesL shapesR) _ backgroundImage) = do
layout <- getLayout l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(shapeIds, spTree) <- local (\env -> if null hdrElems
then env
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:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] (mknode "p:cSld" [] [spTree] : animations)
slideToElement (Slide _ l@(ComparisonSlide hdrElems shapesL shapesR) _) = do
] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
slideToElement (Slide _ l@(ComparisonSlide hdrElems shapesL shapesR) _ backgroundImage) = do
layout <- getLayout l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(shapeIds, spTree) <- local (\env -> if null hdrElems
then env
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:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] (mknode "p:cSld" [] [spTree] : animations)
slideToElement (Slide _ l@(TitleSlide hdrElems) _) = do
] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
slideToElement (Slide _ l@(TitleSlide hdrElems) _ backgroundImage) = do
layout <- getLayout l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(_, spTree) <- titleToElement layout hdrElems
return $ mknode "p:sld"
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] [mknode "p:cSld" [] [spTree]]
slideToElement (Slide _ l@(MetadataSlide titleElems subtitleElems authorElems dateElems) _) = do
] [mknode "p:cSld" [] (toList backgroundImageElement <> [spTree])]
slideToElement (Slide
_
l@(MetadataSlide titleElems subtitleElems authorElems dateElems)
_
backgroundImage) = do
layout <- getLayout l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(_, spTree) <- metadataToElement layout titleElems subtitleElems authorElems dateElems
return $ mknode "p:sld"
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] [mknode "p:cSld" [] [spTree]]
slideToElement (Slide _ l@(ContentWithCaptionSlide hdrElems captionShapes contentShapes) _) = do
] [mknode "p:cSld" [] (toList backgroundImageElement <> [spTree])]
slideToElement (Slide
_
l@(ContentWithCaptionSlide hdrElems captionShapes contentShapes)
_
backgroundImage) = do
layout <- getLayout l
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
(shapeIds, spTree) <- contentWithCaptionToElement layout hdrElems captionShapes contentShapes
let animations = case shapeIds of
Nothing -> []
@ -1650,15 +1665,63 @@ slideToElement (Slide _ l@(ContentWithCaptionSlide hdrElems captionShapes conten
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
] (mknode "p:cSld" [] [spTree] : animations)
slideToElement (Slide _ BlankSlide _) = do
] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
slideToElement (Slide _ BlankSlide _ backgroundImage) = do
layout <- getLayout BlankSlide
backgroundImageElement <- traverse backgroundImageToElement backgroundImage
spTree <- blankToElement layout
return $ mknode "p:sld"
[ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
("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 ::
[(ShapeId, Shape)] ->
@ -1790,8 +1853,8 @@ speakerNotesSlideNumber pgNum fieldId =
]
slideToSpeakerNotesElement :: PandocMonad m => Slide -> P m (Maybe Element)
slideToSpeakerNotesElement (Slide _ _ (SpeakerNotes [])) = return Nothing
slideToSpeakerNotesElement slide@(Slide _ _ (SpeakerNotes paras)) = do
slideToSpeakerNotesElement (Slide _ _ (SpeakerNotes []) _) = return Nothing
slideToSpeakerNotesElement slide@(Slide _ _ (SpeakerNotes paras) _) = do
master <- getNotesMaster
fieldId <- getSlideNumberFieldId master
num <- slideNum slide
@ -2037,7 +2100,7 @@ slideToSpeakerNotesEntry slide = do
_ -> return Nothing
slideToSpeakerNotesRelElement :: PandocMonad m => Slide -> P m (Maybe Element)
slideToSpeakerNotesRelElement (Slide _ _ (SpeakerNotes [])) = return Nothing
slideToSpeakerNotesRelElement (Slide _ _ (SpeakerNotes []) _) = return Nothing
slideToSpeakerNotesRelElement slide@Slide{} = do
idNum <- slideNum slide
return $ Just $
@ -2124,13 +2187,13 @@ slideToSlideRelElement slide = do
target <- flip fmap getSlideLayouts $
T.pack . ("../slideLayouts/" <>) . takeFileName .
slPath . case slide of
(Slide _ MetadataSlide{} _) -> metadata
(Slide _ TitleSlide{} _) -> title
(Slide _ ContentSlide{} _) -> content
(Slide _ TwoColumnSlide{} _) -> twoColumn
(Slide _ ComparisonSlide{} _) -> comparison
(Slide _ ContentWithCaptionSlide{} _) -> contentWithCaption
(Slide _ BlankSlide _) -> blank
(Slide _ MetadataSlide{} _ _) -> metadata
(Slide _ TitleSlide{} _ _) -> title
(Slide _ ContentSlide{} _ _) -> content
(Slide _ TwoColumnSlide{} _ _) -> twoColumn
(Slide _ ComparisonSlide{} _ _) -> comparison
(Slide _ ContentWithCaptionSlide{} _ _) -> contentWithCaption
(Slide _ BlankSlide _ _) -> blank
speakerNotesRels <- maybeToList <$> speakerNotesSlideRelElement slide

View file

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

View file

@ -240,4 +240,8 @@ tests = groupPptxTests [ pptxTests "Inline formatting"
def
"pptx/incremental-lists/without-flag/input.native"
"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.