@@ -54,6 +54,8 @@ import Control.Monad.Except
5454import Control.Applicative
5555import Data.Maybe (fromMaybe)
5656import qualified Data.Attoparsec.ByteString.Char8 as A
57+import qualified Codec.Picture.Metadata as Metadata
58+import Codec.Picture (decodeImageWithMetadata)
5759
5860-- quick and dirty functions to get image sizes
5961-- algorithms borrowed from wwwis.pl
@@ -122,7 +124,7 @@ findSvgTag img = "<svg" `B.isInfixOf` img || "<SVG" `B.isInfixOf` img
122124imageSize :: WriterOptions -> ByteString -> Either T.Text ImageSize
123125imageSize opts img = checkDpi <$>
124126 case imageType img of
125− Just Png -> mbToEither "could not determine PNG size" $ pngSize img
127+ Just Png -> pngSize img
126128 Just Gif -> mbToEither "could not determine GIF size" $ gifSize img
127129 Just Jpeg -> jpegSize img
128130 Just Svg -> mbToEither "could not determine SVG size" $ svgSize opts img
@@ -300,36 +302,22 @@ pPdfSize = do
300302 , dpiY = 72 }
301303 ) <|> pPdfSize
302304
303−pngSize :: ByteString -> Maybe ImageSize
304−pngSize img = do
305− let (h, rest) = B.splitAt 8 img
306− guard $ h == "\x8a\x4d\x4e\x47\x0d\x0a\x1a\x0a" ||
307− h == "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a"
308− let (i, rest') = B.splitAt 4 $ B.drop 4 rest
309− guard $ i == "MHDR" || i == "IHDR"
310− let (sizes, rest'') = B.splitAt 8 rest'
311− (x,y) <- case map fromIntegral $unpack sizes of
312− ([w1,w2,w3,w4,h1,h2,h3,h4] :: [Integer]) -> return
313− (shift w1 24 + shift w2 16 + shift w3 8 + w4,
314− shift h1 24 + shift h2 16 + shift h3 8 + h4)
315− _ -> Nothing -- "PNG parse error"
316− (dpix, dpiy) <- findpHYs rest''
317− return ImageSize { pxX = x, pxY = y, dpiX = dpix, dpiY = dpiy }
318−
319−findpHYs :: ByteString -> Maybe (Integer, Integer)
320−findpHYs x
321− | B.null x || "IDAT" `B.isPrefixOf` x = return (72,72)
322− | "pHYs" `B.isPrefixOf` x =
323− case map fromIntegral $ unpack $ B.take 9 $ B.drop 4 x of
324− [x1,x2,x3,x4,y1,y2,y3,y4,u] -> do
325− let factor = if u == 1 -- dots per meter
326− then \z -> z * 254 `div` 10000
327− else const 72
328− return
329− ( factor $ shift x1 24 + shift x2 16 + shift x3 8 + x4,
330− factor $ shift y1 24 + shift y2 16 + shift y3 8 + y4 )
331− _ -> mzero
332− | otherwise = findpHYs $ B.drop 1 x -- read another byte
305+pngSize :: ByteString -> Either T.Text ImageSize
306+pngSize img =
307+ case decodeImageWithMetadata img of
308+ Left e -> Left (T.pack e)
309+ Right (_, meta) -> do
310+ pxx <- maybe (Left "Could not determine width") Right $
311+ Metadata.lookup Metadata.Width meta
312+ pxy <- maybe (Left "Could not determine height") Right $
313+ Metadata.lookup Metadata.Height meta
314+ dpix <- maybe (Right 72) Right $ Metadata.lookup Metadata.DpiX meta
315+ dpiy <- maybe (Right 72) Right $ Metadata.lookup Metadata.DpiY meta
316+ return $ ImageSize
317+ { pxX = fromIntegral pxx
318+ , pxY = fromIntegral pxy
319+ , dpiX = fromIntegral dpix
320+ , dpiY = fromIntegral dpiy }
333321
334322gifSize :: ByteString -> Maybe ImageSize
335323gifSize img = do