diff options
Diffstat (limited to 'src/Text/Pandoc/ImageSize.hs')
| -rw-r--r-- | src/Text/Pandoc/ImageSize.hs | 232 |
1 files changed, 177 insertions, 55 deletions
diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index e46c91eda..4c76aac13 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings, ScopedTypeVariables, CPP #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} {- - Copyright (C) 2011-2016 John MacFarlane <jgm@berkeley.edu> + Copyright (C) 2011-2018 John MacFarlane <jgm@berkeley.edu> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -20,7 +20,7 @@ {- | Module : Text.Pandoc.ImageSize -Copyright : Copyright (C) 2011-2016 John MacFarlane +Copyright : Copyright (C) 2011-2018 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley.edu> @@ -38,8 +38,12 @@ module Text.Pandoc.ImageSize ( ImageType(..) , Dimension(..) , Direction(..) , dimension + , lengthToDim + , scaleDimension , inInch + , inPixel , inPoints + , inEm , numUnit , showInInch , showInPixel @@ -53,11 +57,13 @@ import Control.Monad import Data.Bits import Data.Binary import Data.Binary.Get -import Text.Pandoc.Shared (safeRead, hush) +import Text.Pandoc.Shared (safeRead) import Data.Default (Default) import Numeric (showFFloat) import Text.Pandoc.Definition import Text.Pandoc.Options +import qualified Text.Pandoc.UTF8 as UTF8 +import qualified Text.XML.Light as Xml import qualified Data.Map as M import Control.Monad.Except import Data.Maybe (fromMaybe) @@ -65,7 +71,7 @@ import Data.Maybe (fromMaybe) -- quick and dirty functions to get image sizes -- algorithms borrowed from wwwis.pl -data ImageType = Png | Gif | Jpeg | Pdf | Eps deriving Show +data ImageType = Png | Gif | Jpeg | Svg | Pdf | Eps | Emf deriving Show data Direction = Width | Height instance Show Direction where show Width = "width" @@ -73,13 +79,19 @@ instance Show Direction where data Dimension = Pixel Integer | Centimeter Double + | Millimeter Double | Inch Double | Percent Double + | Em Double + deriving Eq + instance Show Dimension where show (Pixel a) = show a ++ "px" show (Centimeter a) = showFl a ++ "cm" + show (Millimeter a) = showFl a ++ "mm" show (Inch a) = showFl a ++ "in" show (Percent a) = show a ++ "%" + show (Em a) = showFl a ++ "em" data ImageSize = ImageSize{ pxX :: Integer @@ -91,7 +103,13 @@ instance Default ImageSize where def = ImageSize 300 200 72 72 showFl :: (RealFloat a) => a -> String -showFl a = showFFloat (Just 5) a "" +showFl a = removeExtra0s $ showFFloat (Just 5) a "" + +removeExtra0s :: String -> String +removeExtra0s s = + case dropWhile (=='0') $ reverse s of + '.':xs -> reverse xs + xs -> reverse xs imageType :: ByteString -> Maybe ImageType imageType img = case B.take 4 img of @@ -100,19 +118,31 @@ imageType img = case B.take 4 img of "\xff\xd8\xff\xe0" -> return Jpeg -- JFIF "\xff\xd8\xff\xe1" -> return Jpeg -- Exif "%PDF" -> return Pdf + "<svg" -> return Svg + "<?xm" + | findSvgTag img + -> return Svg "%!PS" - | (B.take 4 $ B.drop 1 $ B.dropWhile (/=' ') img) == "EPSF" + | B.take 4 (B.drop 1 $ B.dropWhile (/=' ') img) == "EPSF" -> return Eps + "\x01\x00\x00\x00" + | B.take 4 (B.drop 40 img) == " EMF" + -> return Emf _ -> mzero -imageSize :: ByteString -> Either String ImageSize -imageSize img = +findSvgTag :: ByteString -> Bool +findSvgTag img = "<svg" `B.isInfixOf` img || "<SVG" `B.isInfixOf` img + +imageSize :: WriterOptions -> ByteString -> Either String ImageSize +imageSize opts img = case imageType img of Just Png -> mbToEither "could not determine PNG size" $ pngSize img Just Gif -> mbToEither "could not determine GIF size" $ gifSize img Just Jpeg -> jpegSize img + Just Svg -> mbToEither "could not determine SVG size" $ svgSize opts img Just Eps -> mbToEither "could not determine EPS size" $ epsSize img - Just Pdf -> Left "could not determine PDF size" -- TODO + Just Pdf -> mbToEither "could not determine PDF size" $ pdfSize img + Just Emf -> mbToEither "could not determine EMF size" $ emfSize img Nothing -> Left "could not determine image type" where mbToEither msg Nothing = Left msg mbToEither _ (Just x) = Right x @@ -145,7 +175,7 @@ desiredSizeInPoints opts attr s = (Nothing, Nothing) -> sizeInPoints s where ratio = fromIntegral (pxX s) / fromIntegral (pxY s) - getDim dir = case (dimension dir attr) of + getDim dir = case dimension dir attr of Just (Percent _) -> Nothing Just dim -> Just $ inPoints opts dim Nothing -> Nothing @@ -153,13 +183,30 @@ desiredSizeInPoints opts attr s = inPoints :: WriterOptions -> Dimension -> Double inPoints opts dim = 72 * inInch opts dim +inEm :: WriterOptions -> Dimension -> Double +inEm opts dim = (64/11) * inInch opts dim + inInch :: WriterOptions -> Dimension -> Double inInch opts dim = case dim of - (Pixel a) -> fromIntegral a / (fromIntegral $ writerDpi opts) + (Pixel a) -> fromIntegral a / fromIntegral (writerDpi opts) (Centimeter a) -> a * 0.3937007874 + (Millimeter a) -> a * 0.03937007874 (Inch a) -> a (Percent _) -> 0 + (Em a) -> a * (11/64) + +inPixel :: WriterOptions -> Dimension -> Integer +inPixel opts dim = + case dim of + (Pixel a) -> a + (Centimeter a) -> floor $ dpi * a * 0.3937007874 :: Integer + (Millimeter a) -> floor $ dpi * a * 0.03937007874 :: Integer + (Inch a) -> floor $ dpi * a :: Integer + (Percent _) -> 0 + (Em a) -> floor $ dpi * a * (11/64) :: Integer + where + dpi = fromIntegral $ writerDpi opts -- | Convert a Dimension to a String denoting its equivalent in inches, for example "2.00000". -- Note: Dimensions in percentages are converted to the empty string. @@ -170,14 +217,8 @@ showInInch opts dim = showFl $ inInch opts dim -- | Convert a Dimension to a String denoting its equivalent in pixels, for example "600". -- Note: Dimensions in percentages are converted to the empty string. showInPixel :: WriterOptions -> Dimension -> String -showInPixel opts dim = - case dim of - (Pixel a) -> show a - (Centimeter a) -> show (floor $ dpi * a * 0.3937007874 :: Int) - (Inch a) -> show (floor $ dpi * a :: Int) - (Percent _) -> "" - where - dpi = fromIntegral $ writerDpi opts +showInPixel _ (Percent _) = "" +showInPixel opts dim = show $ inPixel opts dim -- | Maybe split a string into a leading number and trailing unit, e.g. "3cm" to Just (3.0, "cm") numUnit :: String -> Maybe (Double, String) @@ -187,6 +228,17 @@ numUnit s = Just n -> Just (n, unit) Nothing -> Nothing +-- | Scale a dimension by a factor. +scaleDimension :: Double -> Dimension -> Dimension +scaleDimension factor dim = + case dim of + Pixel x -> Pixel (round $ factor * fromIntegral x) + Centimeter x -> Centimeter (factor * x) + Millimeter x -> Millimeter (factor * x) + Inch x -> Inch (factor * x) + Percent x -> Percent (factor * x) + Em x -> Em (factor * x) + -- | Read a Dimension from an Attr attribute. -- `dimension Width attr` might return `Just (Pixel 3)` or for example `Just (Centimeter 2.0)`, etc. dimension :: Direction -> Attr -> Maybe Dimension @@ -195,20 +247,21 @@ dimension dir (_, _, kvs) = Width -> extractDim "width" Height -> extractDim "height" where - extractDim key = - case lookup key kvs of - Just str -> - case numUnit str of - Just (num, unit) -> toDim num unit - Nothing -> Nothing - Nothing -> Nothing + extractDim key = lookup key kvs >>= lengthToDim + +lengthToDim :: String -> Maybe Dimension +lengthToDim s = numUnit s >>= uncurry toDim + where toDim a "cm" = Just $ Centimeter a - toDim a "mm" = Just $ Centimeter (a / 10) + toDim a "mm" = Just $ Millimeter a toDim a "in" = Just $ Inch a toDim a "inch" = Just $ Inch a toDim a "%" = Just $ Percent a toDim a "px" = Just $ Pixel (floor a::Integer) toDim a "" = Just $ Pixel (floor a::Integer) + toDim a "pt" = Just $ Inch (a / 72) + toDim a "pc" = Just $ Inch (a / 6) + toDim a "em" = Just $ Em a toDim _ _ = Nothing epsSize :: ByteString -> Maybe ImageSize @@ -218,7 +271,7 @@ epsSize img = do case ls' of [] -> mzero (x:_) -> case B.words x of - (_:_:_:ux:uy:[]) -> do + [_, _, _, ux, uy] -> do ux' <- safeRead $ B.unpack ux uy' <- safeRead $ B.unpack uy return ImageSize{ @@ -228,6 +281,29 @@ epsSize img = do , dpiY = 72 } _ -> mzero +pdfSize :: ByteString -> Maybe ImageSize +pdfSize img = + case dropWhile (\l -> not (l == "stream" || + "/MediaBox" `B.isPrefixOf` l)) (B.lines img) of + (x:_) + | "/MediaBox" `B.isPrefixOf` x + -> case B.words . B.takeWhile (/=']') + . B.drop 1 + . B.dropWhile (/='[') + $ x of + [x1, y1, x2, y2] -> do + x1' <- safeRead $ B.unpack x1 + x2' <- safeRead $ B.unpack x2 + y1' <- safeRead $ B.unpack y1 + y2' <- safeRead $ B.unpack y2 + return ImageSize{ + pxX = x2' - x1' + , pxY = y2' - y1' + , dpiX = 72 + , dpiY = 72 } + _ -> mzero + _ -> mzero + pngSize :: ByteString -> Maybe ImageSize pngSize img = do let (h, rest) = B.splitAt 8 img @@ -236,27 +312,26 @@ pngSize img = do let (i, rest') = B.splitAt 4 $ B.drop 4 rest guard $ i == "MHDR" || i == "IHDR" let (sizes, rest'') = B.splitAt 8 rest' - (x,y) <- case map fromIntegral $ unpack $ sizes of + (x,y) <- case map fromIntegral $unpack sizes of ([w1,w2,w3,w4,h1,h2,h3,h4] :: [Integer]) -> return - ((shift w1 24) + (shift w2 16) + (shift w3 8) + w4, - (shift h1 24) + (shift h2 16) + (shift h3 8) + h4) - _ -> (hush . Left) "PNG parse error" + (shift w1 24 + shift w2 16 + shift w3 8 + w4, + shift h1 24 + shift h2 16 + shift h3 8 + h4) + _ -> Nothing -- "PNG parse error" let (dpix, dpiy) = findpHYs rest'' - return $ ImageSize { pxX = x, pxY = y, dpiX = dpix, dpiY = dpiy } + return ImageSize { pxX = x, pxY = y, dpiX = dpix, dpiY = dpiy } findpHYs :: ByteString -> (Integer, Integer) -findpHYs x = - if B.null x || "IDAT" `B.isPrefixOf` x - then (72,72) -- default, no pHYs - else if "pHYs" `B.isPrefixOf` x - then let [x1,x2,x3,x4,y1,y2,y3,y4,u] = map fromIntegral - $ unpack $ B.take 9 $ B.drop 4 x - factor = if u == 1 -- dots per meter - then \z -> z * 254 `div` 10000 - else const 72 - in ( factor $ (shift x1 24) + (shift x2 16) + (shift x3 8) + x4, - factor $ (shift y1 24) + (shift y2 16) + (shift y3 8) + y4 ) - else findpHYs $ B.drop 1 x -- read another byte +findpHYs x + | B.null x || "IDAT" `B.isPrefixOf` x = (72,72) + | "pHYs" `B.isPrefixOf` x = + let [x1,x2,x3,x4,y1,y2,y3,y4,u] = + map fromIntegral $ unpack $ B.take 9 $ B.drop 4 x + factor = if u == 1 -- dots per meter + then \z -> z * 254 `div` 10000 + else const 72 + in ( factor $ shift x1 24 + shift x2 16 + shift x3 8 + x4, + factor $ shift y1 24 + shift y2 16 + shift y3 8 + y4 ) + | otherwise = findpHYs $ B.drop 1 x -- read another byte gifSize :: ByteString -> Maybe ImageSize gifSize img = do @@ -269,7 +344,55 @@ gifSize img = do dpiX = 72, dpiY = 72 } - _ -> (hush . Left) "GIF parse error" + _ -> Nothing -- "GIF parse error" + +svgSize :: WriterOptions -> ByteString -> Maybe ImageSize +svgSize opts img = do + doc <- Xml.parseXMLDoc $ UTF8.toString img + let dpi = fromIntegral $ writerDpi opts + let dirToInt dir = do + dim <- Xml.findAttrBy (== Xml.QName dir Nothing Nothing) doc >>= lengthToDim + return $ inPixel opts dim + w <- dirToInt "width" + h <- dirToInt "height" + return ImageSize { + pxX = w + , pxY = h + , dpiX = dpi + , dpiY = dpi + } + +emfSize :: ByteString -> Maybe ImageSize +emfSize img = + let + parseheader = runGetOrFail $ do + skip 0x18 -- 0x00 + frameL <- getWord32le -- 0x18 measured in 1/100 of a millimetre + frameT <- getWord32le -- 0x1C + frameR <- getWord32le -- 0x20 + frameB <- getWord32le -- 0x24 + skip 0x20 -- 0x28 + deviceX <- getWord32le -- 0x48 pixels of reference device + deviceY <- getWord32le -- 0x4C + mmX <- getWord32le -- 0x50 real mm of reference device (always 320*240?) + mmY <- getWord32le -- 0x58 + -- end of header + let + w = (deviceX * (frameR - frameL)) `quot` (mmX * 100) + h = (deviceY * (frameB - frameT)) `quot` (mmY * 100) + dpiW = (deviceX * 254) `quot` (mmX * 10) + dpiH = (deviceY * 254) `quot` (mmY * 10) + return $ ImageSize + { pxX = fromIntegral w + , pxY = fromIntegral h + , dpiX = fromIntegral dpiW + , dpiY = fromIntegral dpiH + } + in + case parseheader . BL.fromStrict $ img of + Left _ -> Nothing + Right (_, _, size) -> Just size + jpegSize :: ByteString -> Either String ImageSize jpegSize img = @@ -284,16 +407,16 @@ jpegSize img = jfifSize :: ByteString -> Either String ImageSize jfifSize rest = let [dpiDensity,dpix1,dpix2,dpiy1,dpiy2] = map fromIntegral - $ unpack $ B.take 5 $ B.drop 9 $ rest + $ unpack $ B.take 5 $B.drop 9 rest factor = case dpiDensity of 1 -> id - 2 -> \x -> (x * 254 `div` 10) + 2 -> \x -> x * 254 `div` 10 _ -> const 72 dpix = factor (shift dpix1 8 + dpix2) dpiy = factor (shift dpiy1 8 + dpiy2) in case findJfifSize rest of Left msg -> Left msg - Right (w,h) -> Right $ ImageSize { pxX = w + Right (w,h) ->Right ImageSize { pxX = w , pxY = h , dpiX = dpix , dpiY = dpiy } @@ -327,7 +450,7 @@ runGet' p bl = exifSize :: ByteString -> Either String ImageSize -exifSize bs = runGet' header $ bl +exifSize bs =runGet' header bl where bl = BL.fromChunks [bs] header = runExceptT $ exifHeader bl -- NOTE: It would be nicer to do @@ -397,14 +520,13 @@ exifHeader hdr = do Left msg -> throwError msg Right x -> return x return (tag, payload) - entries <- sequence $ replicate (fromIntegral numentries) ifdEntry + entries <- replicateM (fromIntegral numentries) ifdEntry subentries <- case lookup ExifOffset entries of Just (UnsignedLong offset') -> do pos <- lift bytesRead lift $ skip (fromIntegral offset' - (fromIntegral pos - 8)) numsubentries <- lift getWord16 - sequence $ - replicate (fromIntegral numsubentries) ifdEntry + replicateM (fromIntegral numsubentries) ifdEntry _ -> return [] let allentries = entries ++ subentries (wdth, hght) <- case (lookup ExifImageWidth allentries, @@ -415,13 +537,13 @@ exifHeader hdr = do -- we return a default width and height when -- the exif header doesn't contain these let resfactor = case lookup ResolutionUnit allentries of - Just (UnsignedShort 1) -> (100 / 254) + Just (UnsignedShort 1) -> 100 / 254 _ -> 1 let xres = maybe 72 (\(UnsignedRational x) -> floor $ x * resfactor) $ lookup XResolution allentries let yres = maybe 72 (\(UnsignedRational x) -> floor $ x * resfactor) $ lookup YResolution allentries - return $ ImageSize{ + return ImageSize{ pxX = wdth , pxY = hght , dpiX = xres |