From 965f1ddd4a9d1317455094b8c41016624d92f8ce Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 13 May 2017 23:30:13 +0200 Subject: Update dates in copyright notices This follows the suggestions given by the FSF for GPL licensed software. --- src/Text/Pandoc/ImageSize.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc/ImageSize.hs') diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index 8b2d577a9..a0800e499 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 + Copyright (C) 2011-2017 John MacFarlane 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-2017 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane -- cgit v1.2.3 From 03cb05f4c614f08600bcd8e90a7fd1ca13ae33a2 Mon Sep 17 00:00:00 2001 From: Marc Schreiber Date: Thu, 20 Apr 2017 11:11:01 +0200 Subject: Improve SVG image size code. The old code made some unwise assumptions about how the svg file would look. See #3580. --- pandoc.cabal | 4 + src/Text/Pandoc/ImageSize.hs | 2 +- test/command/SVG_logo-without-xml-declaration.svg | 32 ++++++ test/command/SVG_logo.svg | 33 ++++++ test/command/corrupt.svg | 5 + test/command/inkscape-cube.svg | 119 ++++++++++++++++++++ test/command/svg.md | 129 ++++++++++++++++++++++ 7 files changed, 323 insertions(+), 1 deletion(-) create mode 100644 test/command/SVG_logo-without-xml-declaration.svg create mode 100644 test/command/SVG_logo.svg create mode 100644 test/command/corrupt.svg create mode 100644 test/command/inkscape-cube.svg create mode 100644 test/command/svg.md (limited to 'src/Text/Pandoc/ImageSize.hs') diff --git a/pandoc.cabal b/pandoc.cabal index 61ef5c522..14a407b85 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -136,6 +136,10 @@ Extra-Source-Files: test/*.native test/command/*.md test/command/abbrevs + test/command/SVG_logo-without-xml-declaration.svg + test/command/SVG_logo.svg + test/command/corrupt.svg + test/command/inkscape-cube.svg test/command/sub-file-chapter-1.tex test/command/sub-file-chapter-2.tex test/command/3510-subdoc.org diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index a0800e499..4d914a10c 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -116,7 +116,7 @@ imageType img = case B.take 4 img of _ -> mzero findSvgTag :: ByteString -> Bool -findSvgTag img = B.null $ snd (B.breakSubstring img " ByteString -> Either String ImageSize imageSize opts img = diff --git a/test/command/SVG_logo-without-xml-declaration.svg b/test/command/SVG_logo-without-xml-declaration.svg new file mode 100644 index 000000000..febcab6ca --- /dev/null +++ b/test/command/SVG_logo-without-xml-declaration.svg @@ -0,0 +1,32 @@ + +SVG Logo + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/test/command/SVG_logo.svg b/test/command/SVG_logo.svg new file mode 100644 index 000000000..5333a5ddb --- /dev/null +++ b/test/command/SVG_logo.svg @@ -0,0 +1,33 @@ + + +SVG Logo + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/test/command/corrupt.svg b/test/command/corrupt.svg new file mode 100644 index 000000000..cfaa697f0 --- /dev/null +++ b/test/command/corrupt.svg @@ -0,0 +1,5 @@ +Lorem ipsum dolor sit amet etiam. A pede dolor neque pretium luctus pharetra vel rutrum. Orci nonummy ac. At eu est tempor +proin wisi. Nunc tincidunt proin. Suspendisse lorem commodo. Integer diam diam semper commodo dictum et tellus eu ultrices +nec erat pulvinar porttitor nulla nulla mauris orci libero eros elementum et possimus voluptate. Velit morbi et. Luctus diam +in. Lorem tincidunt sem dolor rerum mauris. Dis taciti posuere pellentesque sed rutrum. Lectus donec fusce in dictum pede. +In etiam congue. Aliquam aliquet elit arcu mauris enim. Risus at enim. diff --git a/test/command/inkscape-cube.svg b/test/command/inkscape-cube.svg new file mode 100644 index 000000000..995c3c734 --- /dev/null +++ b/test/command/inkscape-cube.svg @@ -0,0 +1,119 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + + + + diff --git a/test/command/svg.md b/test/command/svg.md new file mode 100644 index 000000000..bcf00ddae --- /dev/null +++ b/test/command/svg.md @@ -0,0 +1,129 @@ +``` +% pandoc -f latex -t icml +\includegraphics{command/corrupt.svg} +^D + + + + + + + + + + + + + + + + + + + $ID/Embedded + + + + + + + +``` + +``` +% pandoc -f latex -t icml +\includegraphics{command/SVG_logo.svg} +^D + + + + + + + + + + + + + + + + + + + $ID/Embedded + + + + + + + +``` + +``` +% pandoc -f latex -t icml +\includegraphics{command/SVG_logo-without-xml-declaration.svg} +^D + + + + + + + + + + + + + + + + + + + $ID/Embedded + + + + + + + +``` + + +``` +% pandoc -f latex -t icml +\includegraphics{command/inkscape-cube.svg} +^D + + + + + + + + + + + + + + + + + + + $ID/Embedded + + + + + + + +``` + -- cgit v1.2.3 From cb7b0a69859cbf838519c5ad5f35d40ffd4f4246 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Thu, 25 May 2017 22:48:27 +0200 Subject: Allow em for image height/width in HTML, LaTeX. - Export `inEm` from ImageSize [API change]. - Change `showFl` and `show` instance for `Dimension` so extra decimal places are omitted. - Added `Em` as a constructor of `Dimension` [API change]. - Allow `em`, `cm`, `in` to pass through without conversion in HTML, LaTeX. Closes #3450. --- src/Text/Pandoc/ImageSize.hs | 20 +++++++++++++++-- src/Text/Pandoc/Writers/HTML.hs | 7 +++--- test/command/3450.md | 12 +++++++++++ test/command/svg.md | 48 ++++++++++++++++++++--------------------- test/writer.icml | 24 ++++++++++----------- 5 files changed, 69 insertions(+), 42 deletions(-) create mode 100644 test/command/3450.md (limited to 'src/Text/Pandoc/ImageSize.hs') diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index 4d914a10c..eec8658c5 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -43,6 +43,7 @@ module Text.Pandoc.ImageSize ( ImageType(..) , inInch , inPixel , inPoints + , inEm , numUnit , showInInch , showInPixel @@ -80,12 +81,14 @@ data Dimension = Pixel Integer | Centimeter Double | Inch Double | Percent Double + | Em Double instance Show Dimension where show (Pixel a) = show a ++ "px" show (Centimeter a) = showFl a ++ "cm" show (Inch a) = showFl a ++ "in" show (Percent a) = show a ++ "%" + show (Em a) = showFl a ++ "em" data ImageSize = ImageSize{ pxX :: Integer @@ -97,7 +100,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 @@ -167,6 +176,9 @@ 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 @@ -174,6 +186,7 @@ inInch opts dim = (Centimeter a) -> a * 0.3937007874 (Inch a) -> a (Percent _) -> 0 + (Em a) -> a * (11/64) inPixel :: WriterOptions -> Dimension -> Integer inPixel opts dim = @@ -181,7 +194,8 @@ inPixel opts dim = (Pixel a) -> a (Centimeter a) -> floor $ dpi * a * 0.3937007874 :: Integer (Inch a) -> floor $ dpi * a :: Integer - _ -> 0 + (Percent _) -> 0 + (Em a) -> floor $ dpi * a * (11/64) :: Integer where dpi = fromIntegral $ writerDpi opts @@ -213,6 +227,7 @@ scaleDimension factor dim = Centimeter x -> Centimeter (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. @@ -236,6 +251,7 @@ lengthToDim s = numUnit s >>= uncurry toDim 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 diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 63e839684..2a72f6f3d 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -533,10 +533,9 @@ dimensionsToAttrList :: WriterOptions -> Attr -> [(String, String)] dimensionsToAttrList opts attr = (go Width) ++ (go Height) where go dir = case (dimension dir attr) of - (Just (Percent a)) -> [("style", show dir ++ ":" ++ show (Percent a))] - (Just dim) -> [(show dir, showInPixel opts dim)] - _ -> [] - + (Just (Pixel a)) -> [(show dir, show a)] + (Just x) -> [("style", show dir ++ ":" ++ show x)] + Nothing -> [] imageExts :: [String] imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf", diff --git a/test/command/3450.md b/test/command/3450.md new file mode 100644 index 000000000..8759aa0c1 --- /dev/null +++ b/test/command/3450.md @@ -0,0 +1,12 @@ +``` +% pandoc -fmarkdown-implicit_figures +![image](lalune.jpg){height=2em} +^D +

image

+``` +``` +% pandoc -fmarkdown-implicit_figures -t latex +![image](lalune.jpg){height=2em} +^D +\includegraphics[height=2em]{lalune.jpg} +``` diff --git a/test/command/svg.md b/test/command/svg.md index 36ca2fdb7..b48745f9a 100644 --- a/test/command/svg.md +++ b/test/command/svg.md @@ -5,20 +5,20 @@ [warning] Could not determine image size for 'command/corrupt.svg': could not determine image type - + - - - - + + + + - + $ID/Embedded @@ -38,20 +38,20 @@ [warning] Could not determine image size for 'command/SVG_logo.svg': could not determine SVG size - + - - - - + + + + - + $ID/Embedded @@ -71,20 +71,20 @@ [warning] Could not determine image size for 'command/SVG_logo-without-xml-declaration.svg': could not determine SVG size - + - - - - + + + + - + $ID/Embedded @@ -104,20 +104,20 @@ ^D - + - - - - + + + + - + $ID/Embedded diff --git a/test/writer.icml b/test/writer.icml index c39915120..6e070e264 100644 --- a/test/writer.icml +++ b/test/writer.icml @@ -2833,20 +2833,20 @@ These should not be escaped: \$ \\ \> \[ \{
- + - - - - + + + + - + $ID/Embedded @@ -2869,20 +2869,20 @@ These should not be escaped: \$ \\ \> \[ \{ Here is a movie - + - - - - + + + + - + $ID/Embedded -- cgit v1.2.3 From b61a51ee1551c62558369d9bcdaff32de7f3e2eb Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 2 Jun 2017 15:06:14 +0200 Subject: hlint suggestions. --- pandoc.hs | 1 + src/Text/Pandoc/App.hs | 1 + src/Text/Pandoc/CSS.hs | 2 +- src/Text/Pandoc/Class.hs | 2 +- src/Text/Pandoc/Compat/Time.hs | 2 +- src/Text/Pandoc/Error.hs | 2 +- src/Text/Pandoc/Highlighting.hs | 6 ++--- src/Text/Pandoc/ImageSize.hs | 57 ++++++++++++++++++++--------------------- 8 files changed, 37 insertions(+), 36 deletions(-) (limited to 'src/Text/Pandoc/ImageSize.hs') diff --git a/pandoc.hs b/pandoc.hs index 970fc8778..7b749229c 100644 --- a/pandoc.hs +++ b/pandoc.hs @@ -40,3 +40,4 @@ import Text.Pandoc.Error (PandocError, handleError) main :: IO () main = E.catch (parseOptions options defaultOpts >>= convertWithOpts) (\(e :: PandocError) -> handleError (Left e)) + diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index 58044860b..4d42b2f2b 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -1554,3 +1554,4 @@ splitField s = case break (`elem` ":=") s of (k,_:v) -> (k,v) (k,[]) -> (k,"true") + diff --git a/src/Text/Pandoc/CSS.hs b/src/Text/Pandoc/CSS.hs index 3e2fd6309..41be1ea13 100644 --- a/src/Text/Pandoc/CSS.hs +++ b/src/Text/Pandoc/CSS.hs @@ -11,7 +11,7 @@ import Text.Parsec.String ruleParser :: Parser (String, String) ruleParser = do p <- many1 (noneOf ":") <* char ':' - v <- many1 (noneOf ":;") <* (optional $ char ';') <* spaces + v <- many1 (noneOf ":;") <* optional (char ';') <* spaces return (trim p, trim v) styleAttrParser :: Parser [(String, String)] diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs index 49b20bd30..91731d396 100644 --- a/src/Text/Pandoc/Class.hs +++ b/src/Text/Pandoc/Class.hs @@ -365,7 +365,7 @@ fillMediaBag sourceURL d = walkM handleImage d let fname = basename <.> ext insertMedia fname mt bs' return $ Image attr lab (fname, tit)) - (\e -> + (\e -> case e of PandocResourceNotFound _ -> do report $ CouldNotFetchResource src diff --git a/src/Text/Pandoc/Compat/Time.hs b/src/Text/Pandoc/Compat/Time.hs index b1cde82a4..1de197801 100644 --- a/src/Text/Pandoc/Compat/Time.hs +++ b/src/Text/Pandoc/Compat/Time.hs @@ -27,4 +27,4 @@ where import Data.Time import System.Locale ( defaultTimeLocale ) -#endif +#endif \ No newline at end of file diff --git a/src/Text/Pandoc/Error.hs b/src/Text/Pandoc/Error.hs index 077413056..3cf381168 100644 --- a/src/Text/Pandoc/Error.hs +++ b/src/Text/Pandoc/Error.hs @@ -83,7 +83,7 @@ handleError (Left e) = errColumn = sourceColumn errPos ls = lines input ++ [""] errorInFile = if length ls > errLine - 1 - then concat ["\n", (ls !! (errLine - 1)) + then concat ["\n", ls !! (errLine - 1) ,"\n", replicate (errColumn - 1) ' ' ,"^"] else "" diff --git a/src/Text/Pandoc/Highlighting.hs b/src/Text/Pandoc/Highlighting.hs index 183155d5b..0754aae4c 100644 --- a/src/Text/Pandoc/Highlighting.hs +++ b/src/Text/Pandoc/Highlighting.hs @@ -91,7 +91,7 @@ highlight syntaxmap formatter (_, classes, keyvals) rawCode = , traceOutput = False } classes' = map T.pack classes rawCode' = T.pack rawCode - in case msum (map (\l -> lookupSyntax l syntaxmap) classes') of + in case msum (map ((`lookupSyntax` syntaxmap)) classes') of Nothing | numberLines fmtOpts -> Right $ formatter fmtOpts{ codeClasses = [], @@ -100,9 +100,9 @@ highlight syntaxmap formatter (_, classes, keyvals) rawCode = $ T.lines rawCode' | otherwise -> Left "" Just syntax -> - (formatter fmtOpts{ codeClasses = + formatter fmtOpts{ codeClasses = [T.toLower (sShortname syntax)], - containerClasses = classes' }) <$> + containerClasses = classes' } <$> tokenize tokenizeOpts syntax rawCode' -- Functions for correlating latex listings package's language names diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index eec8658c5..61ff006cf 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -120,7 +120,7 @@ imageType img = case B.take 4 img of | 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 _ -> mzero @@ -168,7 +168,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 @@ -182,7 +182,7 @@ 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 (Inch a) -> a (Percent _) -> 0 @@ -261,7 +261,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{ @@ -279,27 +279,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) + (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 @@ -343,16 +342,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 } @@ -386,7 +385,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 @@ -456,14 +455,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, @@ -474,13 +472,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 @@ -604,3 +602,4 @@ tagTypeTable = M.fromList , (0xa300, FileSource) , (0xa301, SceneType) ] + -- cgit v1.2.3