ODT/OpenDocument writer: improved image attributes
- support for percentage widths/heights - use Attr instead of title to get dimensions from ODT walker to writeOpenDocument
This commit is contained in:
parent
37931cb0c5
commit
df68f25459
2 changed files with 34 additions and 27 deletions
|
@ -40,7 +40,7 @@ import Codec.Archive.Zip
|
|||
import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..) )
|
||||
import Text.Pandoc.Shared ( stringify, fetchItem', warn,
|
||||
getDefaultReferenceODT )
|
||||
import Text.Pandoc.ImageSize ( imageSize, desiredSizeInPoints )
|
||||
import Text.Pandoc.ImageSize
|
||||
import Text.Pandoc.MIME ( getMimeType, extensionFromMimeType )
|
||||
import Text.Pandoc.Definition
|
||||
import Text.Pandoc.Walk
|
||||
|
@ -125,22 +125,36 @@ writeODT opts doc@(Pandoc meta _) = do
|
|||
$ addEntryToArchive metaEntry archive'
|
||||
return $ fromArchive archive''
|
||||
|
||||
-- | transform both Image and Math elements
|
||||
transformPicMath :: WriterOptions -> IORef [Entry] -> Inline -> IO Inline
|
||||
transformPicMath opts entriesRef (Image attr lab (src,t)) = do
|
||||
transformPicMath opts entriesRef (Image attr@(id', cls, _) lab (src,t)) = do
|
||||
res <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
|
||||
case res of
|
||||
Left (_ :: E.SomeException) -> do
|
||||
warn $ "Could not find image `" ++ src ++ "', skipping..."
|
||||
return $ Emph lab
|
||||
Right (img, mbMimeType) -> do
|
||||
(w,h) <- case imageSize img of
|
||||
Right size -> return $
|
||||
desiredSizeInPoints opts attr size
|
||||
(ptX, ptY) <- case imageSize img of
|
||||
Right s -> return $ sizeInPoints s
|
||||
Left msg -> do
|
||||
warn $ "Could not determine image size in `" ++
|
||||
src ++ "': " ++ msg
|
||||
return (0,0)
|
||||
let tit' = show w ++ "x" ++ show h
|
||||
return (100, 100)
|
||||
let dims =
|
||||
case (getDim Width, getDim Height) of
|
||||
(Just w, Just h) -> [("width", show w), ("height", show h)]
|
||||
(Just w@(Percent _), Nothing) -> [("width", show w), ("style:rel-height", "scale")]
|
||||
(Nothing, Just h@(Percent _)) -> [("style:rel-width", "scale"), ("height", show h)]
|
||||
(Just w@(Inch i), Nothing) -> [("width", show w), ("height", show (i / ratio) ++ "in")]
|
||||
(Nothing, Just h@(Inch i)) -> [("width", show (i * ratio) ++ "in"), ("height", show h)]
|
||||
_ -> [("width", show ptX ++ "pt"), ("height", show ptY ++ "pt")]
|
||||
where
|
||||
ratio = ptX / ptY
|
||||
getDim dir = case (dimension dir attr) of
|
||||
Just (Percent i) -> Just $ Percent i
|
||||
Just dim -> Just $ Inch $ inInch opts dim
|
||||
Nothing -> Nothing
|
||||
let newattr = (id', cls, dims)
|
||||
entries <- readIORef entriesRef
|
||||
let extension = fromMaybe (takeExtension $ takeWhile (/='?') src)
|
||||
(mbMimeType >>= extensionFromMimeType)
|
||||
|
@ -149,9 +163,7 @@ transformPicMath opts entriesRef (Image attr lab (src,t)) = do
|
|||
epochtime <- floor `fmap` getPOSIXTime
|
||||
let entry = toEntry newsrc epochtime $ toLazy img
|
||||
modifyIORef entriesRef (entry:)
|
||||
let fig | "fig:" `isPrefixOf` t = "fig:"
|
||||
| otherwise = ""
|
||||
return $ Image attr lab (newsrc, fig++tit')
|
||||
return $ Image newattr lab (newsrc, t)
|
||||
transformPicMath _ entriesRef (Math t math) = do
|
||||
entries <- readIORef entriesRef
|
||||
let dt = if t == InlineMath then DisplayInline else DisplayBlock
|
||||
|
|
|
@ -39,7 +39,7 @@ import Text.Pandoc.Pretty
|
|||
import Text.Printf ( printf )
|
||||
import Control.Arrow ( (***), (>>>) )
|
||||
import Control.Monad.State hiding ( when )
|
||||
import Data.Char (chr, isDigit)
|
||||
import Data.Char (chr)
|
||||
import qualified Data.Map as Map
|
||||
import Text.Pandoc.Writers.Shared
|
||||
|
||||
|
@ -405,11 +405,17 @@ inlineToOpenDocument o ils
|
|||
, ("xlink:href" , s )
|
||||
, ("office:name", t )
|
||||
] . inSpanTags "Definition"
|
||||
mkImg _ s t = do
|
||||
mkImg (_, _, kvs) s _ = do
|
||||
id' <- gets stImageId
|
||||
modify (\st -> st{ stImageId = id' + 1 })
|
||||
let getDims [] = []
|
||||
getDims (("width", w) :xs) = ("svg:width", w) : getDims xs
|
||||
getDims (("height", h):xs) = ("svg:height", h) : getDims xs
|
||||
getDims (x@("style:rel-width", _) :xs) = x : getDims xs
|
||||
getDims (x@("style:rel-height", _):xs) = x : getDims xs
|
||||
getDims (_:xs) = getDims xs
|
||||
return $ inTags False "draw:frame"
|
||||
(("draw:name", "img" ++ show id'):attrsFromTitle t) $
|
||||
(("draw:name", "img" ++ show id') : getDims kvs) $
|
||||
selfClosingTag "draw:image" [ ("xlink:href" , s )
|
||||
, ("xlink:type" , "simple")
|
||||
, ("xlink:show" , "embed" )
|
||||
|
@ -425,17 +431,6 @@ inlineToOpenDocument o ils
|
|||
addNote nn
|
||||
return nn
|
||||
|
||||
-- a title of the form "120x140" will be interpreted as image
|
||||
-- size in points.
|
||||
attrsFromTitle :: String -> [(String,String)]
|
||||
attrsFromTitle s = if null xs || null ys
|
||||
then []
|
||||
else [("svg:width",xs ++ "pt"),("svg:height",ys ++ "pt")]
|
||||
where (xs,rest) = span isDigit s
|
||||
ys = case rest of
|
||||
('x':zs) | all isDigit zs -> zs
|
||||
_ -> ""
|
||||
|
||||
bulletListStyle :: Int -> State WriterState (Int,(Int,[Doc]))
|
||||
bulletListStyle l =
|
||||
let doStyles i = inTags True "text:list-level-style-bullet"
|
||||
|
|
Loading…
Reference in a new issue