diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Text/Pandoc/App.hs | 21 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 41 |
2 files changed, 56 insertions, 6 deletions
diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index 0b7f2458d..15236896c 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -26,7 +26,7 @@ module Text.Pandoc.App ( , applyFilters ) where import qualified Control.Exception as E -import Control.Monad ( (>=>), when ) +import Control.Monad ( (>=>), when, forM_ ) import Control.Monad.Trans ( MonadIO(..) ) import Control.Monad.Except (throwError, catchError) import qualified Data.ByteString as BS @@ -45,12 +45,14 @@ import qualified Data.Text.Encoding.Error as TSE import Network.URI (URI (..), parseURI) import System.Directory (doesDirectoryExist) import System.Exit (exitSuccess) -import System.FilePath ( takeBaseName, takeExtension ) +import System.FilePath ( takeBaseName, takeExtension) import System.IO (nativeNewline, stdout) import qualified System.IO as IO (Newline (..)) import Text.Pandoc import Text.Pandoc.Builder (setMeta) +import Text.Pandoc.MediaBag (mediaItems) import Text.Pandoc.MIME (getCharset, MimeType) +import Text.Pandoc.Image (svgToPng) import Text.Pandoc.App.FormatHeuristics (formatFromFilePaths) import Text.Pandoc.App.Opt (Opt (..), LineEnding (..), defaultOpts, IpynbOutput (..)) @@ -71,7 +73,6 @@ import qualified Text.Pandoc.UTF8 as UTF8 import System.Posix.IO (stdOutput) import System.Posix.Terminal (queryTerminal) #endif --- import Debug.Trace convertWithOpts :: Opt -> IO () convertWithOpts opts = do @@ -274,6 +275,7 @@ convertWithOpts opts = do mconcat <$> mapM (r readerOpts . inputToLazyByteString) inputs) >>= ( (if isJust (optExtractMedia opts) + || writerNameBase == "docx" -- for fallback png creation then fillMediaBag else return) >=> return . adjustMetadata (metadataFromFile <>) @@ -284,6 +286,19 @@ convertWithOpts opts = do >=> maybe return extractMedia (optExtractMedia opts) ) + when (writerNameBase == "docx") $ do -- create fallback pngs for svgs + items <- mediaItems <$> getMediaBag + forM_ items $ \(fp, mt, bs) -> + case T.takeWhile (/=';') mt of + "image/svg+xml" -> do + res <- svgToPng (writerDpi writerOptions) bs + case res of + Right bs' -> do + let fp' = fp <> ".png" + insertMedia fp' (Just "image/png") bs' + Left e -> report $ CouldNotConvertImage (T.pack fp) (tshow e) + _ -> return () + output <- case writer of ByteStringWriter f -> BinaryOutput <$> f writerOptions doc TextWriter f -> case outputPdfProgram outputSettings of diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index efd8b2658..c0e2aae97 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -36,7 +36,9 @@ import Data.Time.Clock.POSIX import Data.Digest.Pure.SHA (sha1, showDigest) import Skylighting import Text.Collate.Lang (renderLang) -import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang, translateTerm) +import Text.Pandoc.Class (PandocMonad, report, toLang, translateTerm, + getMediaBag) +import Text.Pandoc.MediaBag (lookupMedia, mediaItems, MediaItem(..)) import qualified Text.Pandoc.Translations as Term import qualified Text.Pandoc.Class.PandocMonad as P import Data.Time @@ -1233,9 +1235,42 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do imgs <- gets stImages let stImage = M.lookup (T.unpack src) imgs - generateImgElt (ident, _, _, img) = do + generateImgElt (ident, _fp, mt, img) = do docprid <- getUniqueId nvpicprid <- getUniqueId + (blipAttrs, blipContents) <- + case T.takeWhile (/=';') <$> mt of + Just "image/svg+xml" -> do + -- get fallback png + mediabag <- getMediaBag + mbFallback <- + case lookupMedia (T.unpack (src <> ".png")) mediabag of + Just item -> do + id' <- T.unpack . ("rId" <>) <$> getUniqueId + let fp' = "media/" <> id' <> ".png" + let imgdata = (id', + fp', + Just (mediaMimeType item), + BL.toStrict $ mediaContents item) + modify $ \st -> st { stImages = + M.insert fp' imgdata $ stImages st } + return $ Just id' + Nothing -> return Nothing + let extLst = mknode "a:extLst" [] + [ mknode "a:ext" + [("uri","{28A0092B-C50C-407E-A947-70E740481C1C}")] + [ mknode "a14:useLocalDpi" + [("xmlns:a14","http://schemas.microsoft.com/office/drawing/2010/main"), + ("val","0")] () ] + , mknode "a:ext" + [("uri","{96DAC541-7B7A-43D3-8B79-37D633B846F1}")] + [ mknode "asvg:svgBlip" + [("xmlns:asvg", "http://schemas.microsoft.com/office/drawing/2016/SVG/main"), + ("r:embed",T.pack ident)] () ] + ] + return (maybe [] (\id'' -> [("r:embed", T.pack id'')]) mbFallback, + [extLst]) + _ -> return ([("r:embed", T.pack ident)], []) let (xpt,ypt) = desiredSizeInPoints opts attr (either (const def) id (imageSize opts img)) @@ -1252,7 +1287,7 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do ,("name","Picture")] () , cNvPicPr ] blipFill = mknode "pic:blipFill" [] - [ mknode "a:blip" [("r:embed",T.pack ident)] () + [ mknode "a:blip" blipAttrs blipContents , mknode "a:stretch" [] $ mknode "a:fillRect" [] () ] |