ImageSize: extract dpi information from PNG and JPEG.

* ImageSize record now includes dpiX, dpiY, pxX, pxY.
* New functions sizeInPixels and sizeInPoints.

2 files changed, 93 insertions, 50 deletions

diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs
index 4a7a21dd3..23bb2f739 100644
--- a/src/Text/Pandoc/ImageSize.hs
+++ b/src/Text/Pandoc/ImageSize.hs
@@ -1,37 +1,38 @@
 {-# LANGUAGE OverloadedStrings, ScopedTypeVariables  #-}
 {-
-Copyright (C) 2011 John MacFarlane <jgm@berkeley.edu>
+  Copyright (C) 2011 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
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
+    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
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
 
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-GNU General Public License for more details.
+    This program is distributed in the hope that it will be useful,
+         but WITHOUT ANY WARRANTY; without even the implied warranty of
+           MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+           GNU General Public License for more details.
 
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
--}
+           You should have received a copy of the GNU General Public License
+           along with this program; if not, write to the Free Software
+           Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+           -}
 
 {- |
-   Module      : Text.Pandoc.ImageSize
-   Copyright   : Copyright (C) 2011 John MacFarlane
-   License     : GNU GPL, version 2 or above
+Module      : Text.Pandoc.ImageSize
+                Copyright   : Copyright (C) 2011 John MacFarlane
+                License     : GNU GPL, version 2 or above
 
-   Maintainer  : John MacFarlane <jgm@berkeley.edu>
-   Stability   : alpha
-   Portability : portable
+                Maintainer  : John MacFarlane <jgm@berkeley.edu>
+                Stability   : alpha
+                Portability : portable
 
-Functions for determining the size of a PNG, JPEG, or GIF image.
+                Functions for determining the size of a PNG, JPEG, or GIF image.
 
-Algorithms borrowwed from wwwis.pl (c) 2005 Alex K, released
-under the GPL.
--}
-module Text.Pandoc.ImageSize ( ImageType(..), imageType, imageSize, readImageSize ) where
+                Algorithms borrowwed from wwwis.pl (c) 2005 Alex K, released
+                under the GPL.
+                -}
+                module Text.Pandoc.ImageSize ( ImageType(..), imageType, imageSize,
+                    sizeInPixels, sizeInPoints, readImageSize ) where
 import Data.ByteString.Lazy (ByteString, unpack)
 import qualified Data.ByteString.Lazy.Char8 as B
 import Control.Monad
@@ -42,10 +43,15 @@ import Data.Bits
 
 data ImageType = Png | Gif | Jpeg deriving Show
 
-type Height = Integer
-type Width = Integer
+data ImageSize = ImageSize{
+                     pxX   :: Integer
+                   , pxY   :: Integer
+                   , dpiX  :: Integer
+                   , dpiY  :: Integer
+                   } deriving (Read, Show, Eq)
 
-readImageSize :: FilePath -> IO (Maybe (Width,Height))
+
+readImageSize :: FilePath -> IO (Maybe ImageSize)
 readImageSize fp = imageSize `fmap` B.readFile fp
 
 imageType :: ByteString -> Maybe ImageType
@@ -55,7 +61,7 @@ imageType img = case B.take 4 img of
                      "\xff\xd8\xff\xe0" -> return Jpeg
                      _                  -> fail "Unknown image type"
 
-imageSize :: ByteString -> Maybe (Width,Height)
+imageSize :: ByteString -> Maybe ImageSize
 imageSize img = do
   t <- imageType img
   case t of
@@ -63,35 +69,73 @@ imageSize img = do
        Gif  -> gifSize img
        Jpeg -> jpegSize img
 
-pngSize :: ByteString -> Maybe (Width,Height)
+sizeInPixels :: ImageSize -> (Integer, Integer)
+sizeInPixels s = (pxX s, pxY s)
+
+sizeInPoints :: ImageSize -> (Integer, Integer)
+sizeInPoints s = (pxX s `div` dpiX s * 72, pxY s `div` dpiY s * 72)
+
+pngSize :: ByteString -> Maybe ImageSize
 pngSize img = do
   let (h, rest) = B.splitAt 8 img
   guard $ h == "\x8a\x4d\x4e\x47\x0d\x0a\x1a\x0a" ||
           h == "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a"
   let (i, rest') = B.splitAt 4 $ B.drop 4 rest
   guard $ i == "MHDR" || i == "IHDR"
-  case map fromIntegral $ unpack $ B.take 8 rest' 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)
-       _ -> fail "PNG parse error"
-
-gifSize :: ByteString -> Maybe (Width,Height)
+  let (sizes, rest'') = B.splitAt 8 rest'
+  (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)
+                _ -> fail "PNG parse error"
+  let (dpix, dpiy) = findpHYs rest''
+  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
+
+gifSize :: ByteString -> Maybe ImageSize
 gifSize img = do
   let (h, rest) = B.splitAt 6 img
   guard $ h == "GIF87a" || h == "GIF89a"
   case map fromIntegral $ unpack $ B.take 4 rest of
-       [w2,w1,h2,h1] -> return (shift w1 8 + w2, shift h1 8 + h2)
+       [w2,w1,h2,h1] -> return ImageSize {
+                          pxX  = shift w1 8 + w2,
+                          pxY  = shift h1 8 + h2,
+                          dpiX = 72,
+                          dpiY = 72
+                          }
        _             -> fail "GIF parse error"
 
-jpegSize :: ByteString -> Maybe (Width,Height)
+jpegSize :: ByteString -> Maybe ImageSize
 jpegSize img = do
-  let (h, rest) = B.splitAt 2 img
-  guard $ h == "\xff\xd8"
-  findJpegLength rest
-
-findJpegLength :: ByteString -> Maybe (Width,Height)
-findJpegLength bs = do
+  let (hdr, rest) = B.splitAt 4 img
+  guard $ hdr == "\xff\xd8\xff\xe0"
+  guard $ B.length rest >= 14
+  let [dpiDensity,dpix1,dpix2,dpiy1,dpiy2] = map fromIntegral
+                                           $ unpack $ B.take 5 $ B.drop 9 $ rest
+  let factor = case dpiDensity of
+                    1 -> id
+                    2 -> \x -> (x * 254 `div` 10)
+                    _ -> const 72
+  let dpix = factor (shift dpix1 8 + dpix2)
+  let dpiy = factor (shift dpiy1 8 + dpiy2)
+  (w,h) <- findJpegSize rest
+  return $ ImageSize { pxX = w, pxY = h, dpiX = dpix, dpiY = dpiy }
+
+findJpegSize :: ByteString -> Maybe (Integer,Integer)
+findJpegSize bs = do
   let bs' = B.dropWhile (=='\xff') $ B.dropWhile (/='\xff') bs
   case B.uncons bs' of
        Just (c,bs'') | c >= '\xc0' && c <= '\xc3' -> do
@@ -103,7 +147,7 @@ findJpegLength bs = do
               [c1,c2] -> do
                 let len = shift c1 8 + c2
                 -- skip variables
-                findJpegLength $ B.drop len bs''
+                findJpegSize $ B.drop len bs''
               _       -> fail "JPEG parse error"
        Nothing -> fail "Did not find length record"
 
diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
index f5030e6d8..5c6f22ec6 100644
--- a/src/Text/Pandoc/Writers/ODT.hs
+++ b/src/Text/Pandoc/Writers/ODT.hs
@@ -37,7 +37,7 @@ import Codec.Archive.Zip
 import System.Time
 import Paths_pandoc ( getDataFileName )
 import Text.Pandoc.Shared ( WriterOptions(..) )
-import Text.Pandoc.ImageSize ( readImageSize )
+import Text.Pandoc.ImageSize ( readImageSize, sizeInPoints )
 import Text.Pandoc.MIME ( getMimeType )
 import Text.Pandoc.Definition
 import Text.Pandoc.Generic
@@ -104,11 +104,10 @@ transformPic :: FilePath -> IORef [Entry] -> Inline -> IO Inline
 transformPic sourceDir entriesRef (Image lab (src,tit)) = do
   let src' = unEscapeString src
   mbSize <- readImageSize src'
-  let pxToPoints px = px * 72 `div` 96
   let tit' = case mbSize of
-                  Just (w,h)  -> show (pxToPoints w) ++ "x" ++
-                                 show (pxToPoints h)
-                  Nothing     -> tit
+                  Just s   -> let (w,h) = sizeInPoints s
+                              in  show w ++ "x" ++ show h
+                  Nothing  -> tit
   entries <- readIORef entriesRef
   let newsrc = "Pictures/" ++ show (length entries) ++ takeExtension src'
   catch (readEntry [] (sourceDir </> src') >>= \entry ->