@@ -54,6 +54,8 @@ import Control.Monad.Except
54import Control.Applicative
54import Control.Applicative
55import Data.Maybe (fromMaybe)
55import Data.Maybe (fromMaybe)
56import qualified Data.Attoparsec.ByteString.Char8 as A
56import qualified Data.Attoparsec.ByteString.Char8 as A
57+import qualified Codec.Picture.Metadata as Metadata
58+import Codec.Picture (decodeImageWithMetadata)
58-- quick and dirty functions to get image sizes
60-- quick and dirty functions to get image sizes
59-- algorithms borrowed from wwwis.pl
61-- algorithms borrowed from wwwis.pl
@@ -122,7 +124,7 @@ findSvgTag img = "<svg" `B.isInfixOf` img || "<SVG" `B.isInfixOf` img
122imageSize :: WriterOptions -> ByteString -> Either T.Text ImageSize
124imageSize :: WriterOptions -> ByteString -> Either T.Text ImageSize
123imageSize opts img = checkDpi <$>
125imageSize opts img = checkDpi <$>
124 case imageType img of
126 case imageType img of
125− Just Png -> mbToEither "could not determine PNG size" $ pngSize img
127+ Just Png -> pngSize img
126 Just Gif -> mbToEither "could not determine GIF size" $ gifSize img
128 Just Gif -> mbToEither "could not determine GIF size" $ gifSize img
127 Just Jpeg -> jpegSize img
129 Just Jpeg -> jpegSize img
128 Just Svg -> mbToEither "could not determine SVG size" $ svgSize opts img
130 Just Svg -> mbToEither "could not determine SVG size" $ svgSize opts img
@@ -300,36 +302,22 @@ pPdfSize = do
300 , dpiY = 72 }
302 , dpiY = 72 }
301 ) <|> pPdfSize
303 ) <|> pPdfSize
303−pngSize :: ByteString -> Maybe ImageSize
305+pngSize :: ByteString -> Either T.Text ImageSize
304−pngSize img = do
306+pngSize img =
305− let (h, rest) = B.splitAt 8 img
307+ case decodeImageWithMetadata img of
306− guard $ h == "\x8a\x4d\x4e\x47\x0d\x0a\x1a\x0a" ||
308+ Left e -> Left (T.pack e)
307− h == "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a"
309+ Right (_, meta) -> do
308− let (i, rest') = B.splitAt 4 $ B.drop 4 rest
310+ pxx <- maybe (Left "Could not determine width") Right $
309− guard $ i == "MHDR" || i == "IHDR"
311+ Metadata.lookup Metadata.Width meta
310− let (sizes, rest'') = B.splitAt 8 rest'
312+ pxy <- maybe (Left "Could not determine height") Right $
311− (x,y) <- case map fromIntegral $unpack sizes of
313+ Metadata.lookup Metadata.Height meta
312− ([w1,w2,w3,w4,h1,h2,h3,h4] :: [Integer]) -> return
314+ dpix <- maybe (Right 72) Right $ Metadata.lookup Metadata.DpiX meta
313− (shift w1 24 + shift w2 16 + shift w3 8 + w4,
315+ dpiy <- maybe (Right 72) Right $ Metadata.lookup Metadata.DpiY meta
314− shift h1 24 + shift h2 16 + shift h3 8 + h4)
316+ return $ ImageSize
315− _ -> Nothing -- "PNG parse error"
317+ { pxX = fromIntegral pxx
316− (dpix, dpiy) <- findpHYs rest''
318+ , pxY = fromIntegral pxy
317− return ImageSize { pxX = x, pxY = y, dpiX = dpix, dpiY = dpiy }
319+ , dpiX = fromIntegral dpix
318−
320+ , dpiY = fromIntegral dpiy }
319−findpHYs :: ByteString -> Maybe (Integer, Integer)
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
329− ( factor $ shift x1 24 + shift x2 16 + shift x3 8 + x4,
330− factor $ shift y1 24 + shift y2 16 + shift y3 8 + y4 )
332− | otherwise = findpHYs $ B.drop 1 x -- read another byte
334gifSize :: ByteString -> Maybe ImageSize
322gifSize :: ByteString -> Maybe ImageSize
335gifSize img = do
323gifSize img = do