ImageSize: extract dpi information from PNG and JPEG.
* ImageSize record now includes dpiX, dpiY, pxX, pxY. * New functions sizeInPixels and sizeInPoints.
This commit is contained in:
John MacFarlane
parent
28a043fe44
commit
691b7bdc66
2 changed files with 91 additions and 48 deletions
|
|
@ -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"
|
||||
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 }
|
||||
|
||||
gifSize :: ByteString -> Maybe (Width,Height)
|
||||
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
|
||||
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 }
|
||||
|
||||
findJpegLength :: ByteString -> Maybe (Width,Height)
|
||||
findJpegLength bs = do
|
||||
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"
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ->
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue