diff options
| -rw-r--r-- | src/Text/Pandoc/ImageSize.hs | 134 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/ODT.hs | 9 |
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 -> |