df68f25 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

ODT/OpenDocument writer: improved image attributes

df68f25mb2111 years ago

src/Text/Pandoc/Writers/ODT.hs+25−13

compare with master

unifiedsplit

@@ -40,7 +40,7 @@ import Codec.Archive.Zip

40import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..) )

41import Text.Pandoc.Shared ( stringify, fetchItem', warn,

42 getDefaultReferenceODT )

43−import Text.Pandoc.ImageSize ( imageSize, desiredSizeInPoints )

43+import Text.Pandoc.ImageSize

44import Text.Pandoc.MIME ( getMimeType, extensionFromMimeType )

45import Text.Pandoc.Definition

46import Text.Pandoc.Walk

@@ -125,22 +125,36 @@ writeODT opts doc@(Pandoc meta _) = do

125 $ addEntryToArchive metaEntry archive'

126 return $ fromArchive archive''

127

128+-- | transform both Image and Math elements

128transformPicMath :: WriterOptions -> IORef [Entry] -> Inline -> IO Inline

129transformPicMath :: WriterOptions -> IORef [Entry] -> Inline -> IO Inline

129−transformPicMath opts entriesRef (Image attr lab (src,t)) = do

130+transformPicMath opts entriesRef (Image attr@(id', cls, _) lab (src,t)) = do

130 res <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src

131 res <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src

131 case res of

132 case res of

132 Left (_ :: E.SomeException) -> do

133 Left (_ :: E.SomeException) -> do

133 warn $ "Could not find image `" ++ src ++ "', skipping..."

134 warn $ "Could not find image `" ++ src ++ "', skipping..."

134 return $ Emph lab

135 return $ Emph lab

135 Right (img, mbMimeType) -> do

136 Right (img, mbMimeType) -> do

136− (w,h) <- case imageSize img of

137+ (ptX, ptY) <- case imageSize img of

137− Right size -> return $

138+ Right s -> return $ sizeInPoints s

138− desiredSizeInPoints opts attr size

139− Left msg -> do

139+ Left msg -> do

140− warn $ "Could not determine image size in `" ++

140+ warn $ "Could not determine image size in `" ++

141− src ++ "': " ++ msg

141+ src ++ "': " ++ msg

142− return (0,0)

142+ return (100, 100)

143− let tit' = show w ++ "x" ++ show h

143+ let dims =

144+ case (getDim Width, getDim Height) of

145+ (Just w, Just h) -> [("width", show w), ("height", show h)]

146+ (Just w@(Percent _), Nothing) -> [("width", show w), ("style:rel-height", "scale")]

147+ (Nothing, Just h@(Percent _)) -> [("style:rel-width", "scale"), ("height", show h)]

148+ (Just w@(Inch i), Nothing) -> [("width", show w), ("height", show (i / ratio) ++ "in")]

149+ (Nothing, Just h@(Inch i)) -> [("width", show (i * ratio) ++ "in"), ("height", show h)]

150+ _ -> [("width", show ptX ++ "pt"), ("height", show ptY ++ "pt")]

151+ where

152+ ratio = ptX / ptY

153+ getDim dir = case (dimension dir attr) of

154+ Just (Percent i) -> Just $ Percent i

155+ Just dim -> Just $ Inch $ inInch opts dim

156+ Nothing -> Nothing

157+ let newattr = (id', cls, dims)

144 entries <- readIORef entriesRef

158 entries <- readIORef entriesRef

145 let extension = fromMaybe (takeExtension $ takeWhile (/='?') src)

159 let extension = fromMaybe (takeExtension $ takeWhile (/='?') src)

146 (mbMimeType >>= extensionFromMimeType)

160 (mbMimeType >>= extensionFromMimeType)

@@ -149,9 +163,7 @@ transformPicMath opts entriesRef (Image attr lab (src,t)) = do

149 epochtime <- floor `fmap` getPOSIXTime

163 epochtime <- floor `fmap` getPOSIXTime

150 let entry = toEntry newsrc epochtime $ toLazy img

164 let entry = toEntry newsrc epochtime $ toLazy img

151 modifyIORef entriesRef (entry:)

165 modifyIORef entriesRef (entry:)

152− let fig | "fig:" `isPrefixOf` t = "fig:"

153− | otherwise = ""

154− return $ Image attr lab (newsrc, fig++tit')

166+ return $ Image newattr lab (newsrc, t)

155transformPicMath _ entriesRef (Math t math) = do

167transformPicMath _ entriesRef (Math t math) = do

156 entries <- readIORef entriesRef

168 entries <- readIORef entriesRef

157 let dt = if t == InlineMath then DisplayInline else DisplayBlock

169 let dt = if t == InlineMath then DisplayInline else DisplayBlock

src/Text/Pandoc/Writers/OpenDocument.hs+9−14

@@ -39,7 +39,7 @@ import Text.Pandoc.Pretty

39import Text.Printf ( printf )

40import Control.Arrow ( (***), (>>>) )

41import Control.Monad.State hiding ( when )

42−import Data.Char (chr, isDigit)

42+import Data.Char (chr)

43import qualified Data.Map as Map

44import Text.Pandoc.Writers.Shared

@@ -405,11 +405,17 @@ inlineToOpenDocument o ils

405 , ("xlink:href" , s )

406 , ("office:name", t )

407 ] . inSpanTags "Definition"

408− mkImg _ s t = do

408+ mkImg (_, _, kvs) s _ = do

409 id' <- gets stImageId

410 modify (\st -> st{ stImageId = id' + 1 })

411+ let getDims [] = []

412+ getDims (("width", w) :xs) = ("svg:width", w) : getDims xs

413+ getDims (("height", h):xs) = ("svg:height", h) : getDims xs

414+ getDims (x@("style:rel-width", _) :xs) = x : getDims xs

415+ getDims (x@("style:rel-height", _):xs) = x : getDims xs

416+ getDims (_:xs) = getDims xs

411 return $ inTags False "draw:frame"

417 return $ inTags False "draw:frame"

412− (("draw:name", "img" ++ show id'):attrsFromTitle t) $

418+ (("draw:name", "img" ++ show id') : getDims kvs) $

413 selfClosingTag "draw:image" [ ("xlink:href" , s )

419 selfClosingTag "draw:image" [ ("xlink:href" , s )

414 , ("xlink:type" , "simple")

420 , ("xlink:type" , "simple")

415 , ("xlink:show" , "embed" )

421 , ("xlink:show" , "embed" )

@@ -425,17 +431,6 @@ inlineToOpenDocument o ils

425 addNote nn

431 addNote nn

426 return nn

432 return nn

427

433

428−-- a title of the form "120x140" will be interpreted as image

429−-- size in points.

430−attrsFromTitle :: String -> [(String,String)]

431−attrsFromTitle s = if null xs || null ys

432− then []

433− else [("svg:width",xs ++ "pt"),("svg:height",ys ++ "pt")]

434− where (xs,rest) = span isDigit s

435− ys = case rest of

436− ('x':zs) | all isDigit zs -> zs

437− _ -> ""

438−

439bulletListStyle :: Int -> State WriterState (Int,(Int,[Doc]))

434bulletListStyle :: Int -> State WriterState (Int,(Int,[Doc]))

440bulletListStyle l =

435bulletListStyle l =

441 let doStyles i = inTags True "text:list-level-style-bullet"

436 let doStyles i = inTags True "text:list-level-style-bullet"