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:
parent
c6cd92a0a3
commit
7c22c0202e
10 changed files with 178 additions and 60 deletions
69
MANUAL.txt
69
MANUAL.txt
|
@ -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` 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 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.)
|
||||||
|
|
||||||
|
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.
|
||||||
```
|
```
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
]
|
]
|
||||||
|
|
BIN
test/pptx/background-image/deleted-layouts.pptx
Normal file
BIN
test/pptx/background-image/deleted-layouts.pptx
Normal file
Binary file not shown.
17
test/pptx/background-image/input.native
Normal file
17
test/pptx/background-image/input.native
Normal 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."]]]
|
BIN
test/pptx/background-image/moved-layouts.pptx
Normal file
BIN
test/pptx/background-image/moved-layouts.pptx
Normal file
Binary file not shown.
BIN
test/pptx/background-image/output.pptx
Normal file
BIN
test/pptx/background-image/output.pptx
Normal file
Binary file not shown.
BIN
test/pptx/background-image/templated.pptx
Normal file
BIN
test/pptx/background-image/templated.pptx
Normal file
Binary file not shown.
Loading…
Reference in a new issue