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.

10 files changed, 178 insertions, 60 deletions

diff --git a/MANUAL.txt b/MANUAL.txt
index 82fc21684..98a2f4299 100644
--- a/MANUAL.txt
+++ b/MANUAL.txt
@@ -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 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).
+
+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.)
+
+Note: `data-background-image` is also supported in pptx for consistency with
+reveal.js – if `background-image` isn’t 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, use the
-`title-slide-attributes` variable in the YAML metadata block. It must contain
-a map of attribute names and values.
+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 isn’t added automatically.)
 
-See the [reveal.js documentation](https://revealjs.com/backgrounds/) for more
-details.
+For pptx, pass a [reference doc](#option--reference-doc) with the background
+image set on the “Title Slide” layout.
 
-For example in reveal.js:
+### 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.
 ```
diff --git a/pandoc.cabal b/pandoc.cabal
index 6fcc384f9..0c8cf0d61 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -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
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index 5eadf1312..1431469d3 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -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
 
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index a7660fc5e..fb4518bd7 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
@@ -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
diff --git a/test/Tests/Writers/Powerpoint.hs b/test/Tests/Writers/Powerpoint.hs
index 6eb8c7f67..6e676dc37 100644
--- a/test/Tests/Writers/Powerpoint.hs
+++ b/test/Tests/Writers/Powerpoint.hs
@@ -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"
                        ]
diff --git a/test/pptx/background-image/deleted-layouts.pptx b/test/pptx/background-image/deleted-layouts.pptx
new file mode 100644
index 000000000..05d4104b7
--- /dev/null
+++ b/test/pptx/background-image/deleted-layouts.pptx
diff --git a/test/pptx/background-image/input.native b/test/pptx/background-image/input.native
new file mode 100644
index 000000000..22b089a95
--- /dev/null
+++ b/test/pptx/background-image/input.native
@@ -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."]]]
diff --git a/test/pptx/background-image/moved-layouts.pptx b/test/pptx/background-image/moved-layouts.pptx
new file mode 100644
index 000000000..73b69e1d6
--- /dev/null
+++ b/test/pptx/background-image/moved-layouts.pptx
diff --git a/test/pptx/background-image/output.pptx b/test/pptx/background-image/output.pptx
new file mode 100644
index 000000000..9738eefb8
--- /dev/null
+++ b/test/pptx/background-image/output.pptx
diff --git a/test/pptx/background-image/templated.pptx b/test/pptx/background-image/templated.pptx
new file mode 100644
index 000000000..52d304957
--- /dev/null
+++ b/test/pptx/background-image/templated.pptx