@@ -32,9 +32,14 @@ module Text.Pandoc.ImageSize ( ImageType(..), imageType, imageSize,
32 sizeInPixels, sizeInPoints ) where
32 sizeInPixels, sizeInPoints ) where
33import Data.ByteString (ByteString, unpack)
33import Data.ByteString (ByteString, unpack)
34import qualified Data.ByteString.Char8 as B
34import qualified Data.ByteString.Char8 as B
35+import qualified Data.ByteString.Lazy as BL
36+import Control.Applicative
35import Control.Monad
37import Control.Monad
36import Data.Bits
38import Data.Bits
40+import Data.Binary.Get
37import Text.Pandoc.Shared (safeRead)
41import Text.Pandoc.Shared (safeRead)
42+import qualified Data.Map as M
39-- quick and dirty functions to get image sizes
44-- quick and dirty functions to get image sizes
40-- algorithms borrowed from wwwis.pl
45-- algorithms borrowed from wwwis.pl
@@ -143,7 +148,7 @@ jpegSize img = do
143 guard $ B.length rest >= 14
148 guard $ B.length rest >= 14
144 case hdr of
149 case hdr of
145 "\xff\xd8\xff\xe0" -> jfifSize rest
150 "\xff\xd8\xff\xe0" -> jfifSize rest
146− "\xff\xd8\xff\xe1" -> exifSize rest
151+ "\xff\xd8\xff\xe1" -> exifSize $ B.takeWhile (/= '\xff') rest
147 _ -> mzero
152 _ -> mzero
149jfifSize :: ByteString -> Maybe ImageSize
154jfifSize :: ByteString -> Maybe ImageSize
@@ -177,18 +182,208 @@ findJfifSize bs = do
177 Nothing -> fail "Did not find length record"
182 Nothing -> fail "Did not find length record"
179exifSize :: ByteString -> Maybe ImageSize
184exifSize :: ByteString -> Maybe ImageSize
180−exifSize rest = do
185+exifSize = -- runGet ((Just <$> exifHeader) `mplus` return Nothing) .
181− let bs' = B.takeWhile (/='\xff') $ B.drop 8 rest -- exif data
186+ runGet (Just <$> exifHeader) .
182− let (_,bs'') = B.breakSubstring "\xa0\x02" bs' -- width
187+ BL.fromChunks . (:[])
183− let rawWidth = B.take 2 $ B.drop 10 bs''
184− let (_,bs''') = B.breakSubstring "\xa0\x03" bs' -- height
185− let rawHeight = B.take 2 $ B.drop 10 bs'''
186− let tonum bs = case map fromIntegral $ unpack bs of
187− [x,y] -> Just $ shift x 8 + y
189− case (tonum rawWidth, tonum rawHeight) of
191− return $ ImageSize { pxX = w, pxY = h, dpiX = 72, dpiY = 72 }
192− _ -> fail "Could not determine exif image size"
193− -- some day, figure out how to parse dpi from exif
189+exifHeader :: Get ImageSize
191+ _app1DataSize <- getWord16be
192+ exifHdr <- getWord32be
193+ unless (exifHdr == 0x45786966) $ fail "Did not find exif header"
194+ zeros <- getWord16be
195+ unless (zeros == 0) $ fail "Expected zeros after exif header"
196+ -- beginning of tiff header -- we read whole thing to use
197+ -- in getting data from offsets:
198+ tiffHeader <- lookAhead getRemainingLazyByteString
199+ byteAlign <- getWord16be
200+ let bigEndian = byteAlign == 0x4d4d
201+ let (getWord16, getWord32, getWord64) =
203+ then (getWord16be, getWord32be, getWord64be)
204+ else (getWord16le, getWord32le, getWord64le)
205+ let getRational = do
208+ return $ fromIntegral num / fromIntegral den
209+ tagmark <- getWord16
210+ unless (tagmark == 0x002a) $ fail "Failed alignment sanity check"
211+ ifdOffset <- getWord32
212+ skip (fromIntegral ifdOffset - 8) -- skip to IDF
213+ numentries <- getWord16
215+ tag <- getWord16 >>= \t ->
216+ maybe (fail $ "Unknown tag type " ++ show t) return
217+ (M.lookup t tagTypeTable)
218+ dataFormat <- getWord16
219+ numComponents <- getWord32
220+ (fmt, bytesPerComponent) <-
222+ 1 -> return (UnsignedByte . runGet getWord8, 1)
223+ 2 -> return (AsciiString, 1)
224+ 3 -> return (UnsignedShort . runGet getWord16, 2)
225+ 4 -> return (UnsignedLong . runGet getWord32, 4)
226+ 5 -> return (UnsignedRational . runGet getRational, 8)
227+ 6 -> return (SignedByte . runGet getWord8, 1)
228+ 7 -> return (Undefined . runGet getWord8, 1)
229+ 8 -> return (SignedShort . runGet getWord16, 2)
230+ 9 -> return (SignedLong . runGet getWord32, 4)
231+ 10 -> return (SignedRational . runGet getRational, 8)
232+ 11 -> return (SingleFloat . runGet getWord32 {- TODO -}, 4)
233+ 12 -> return (DoubleFloat . runGet getWord64 {- TODO -}, 8)
234+ _ -> fail $ "Unknown data format " ++ show dataFormat
235+ let totalBytes = fromIntegral $ numComponents * bytesPerComponent
236+ payload <- if totalBytes <= 4 -- data is right here
237+ then (fmt . BL.fromChunks . (:[])) <$>
238+ (getByteString totalBytes <*
239+ skip (4 - totalBytes))
240+ else do -- get data from offset
242+ return $ fmt $ BL.take (fromIntegral totalBytes) $
243+ BL.drop (fromIntegral offs) tiffHeader
244+ return (tag, payload)
245+ entries <- sequence $ replicate (fromIntegral numentries) ifdEntry
246+ subentries <- case lookup ExifOffset entries of
247+ Just (UnsignedLong offset) -> do
249+ skip (fromIntegral offset - (fromIntegral pos - 8))
250+ numsubentries <- getWord16
252+ replicate (fromIntegral numsubentries) ifdEntry
254+ let allentries = entries ++ subentries
255+ (width, height) <- case (lookup ExifImageWidth allentries,
256+ lookup ExifImageHeight allentries) of
257+ (Just (UnsignedLong w), Just (UnsignedLong h)) ->
258+ return (fromIntegral w, fromIntegral h)
259+ _ -> fail "Could not determine image width, height"
260+ let resfactor = case lookup ResolutionUnit allentries of
261+ Just (UnsignedShort 1) -> (100 / 254)
263+ let xres = maybe 72 (\(UnsignedRational x) -> floor $ x * resfactor)
264+ $ lookup XResolution allentries
265+ let yres = maybe 72 (\(UnsignedRational x) -> floor $ x * resfactor)
266+ $ lookup YResolution allentries
273+data DataFormat = UnsignedByte Word8
274+ | AsciiString BL.ByteString
275+ | UnsignedShort Word16
276+ | UnsignedLong Word32
277+ | UnsignedRational Rational
280+ | SignedShort Word16
282+ | SignedRational Rational
283+ | SingleFloat Word32
284+ | DoubleFloat Word64
287+data TagType = ImageDescription
297+ | PrimaryChromaticities
300+ | ReferenceBlackWhite
310+ | ComponentConfiguration
311+ | CompressedBitsPerPixel
329+ | ExifInteroperabilityOffset
330+ | FocalPlaneXResolution
331+ | FocalPlaneYResolution
332+ | FocalPlaneResolutionUnit
336+ deriving (Show, Eq, Ord)
338+tagTypeTable :: M.Map Word16 TagType
339+tagTypeTable = M.fromList
340+ [ (0x010e, ImageDescription)
343+ , (0x0112, Orientation)
344+ , (0x011a, XResolution)
345+ , (0x011b, YResolution)
346+ , (0x0128, ResolutionUnit)
347+ , (0x0131, Software)
348+ , (0x0132, DateTime)
349+ , (0x013e, WhitePoint)
350+ , (0x013f, PrimaryChromaticities)
351+ , (0x0211, YCbCrCoefficients)
352+ , (0x0213, YCbCrPositioning)
353+ , (0x0214, ReferenceBlackWhite)
354+ , (0x8298, Copyright)
355+ , (0x8769, ExifOffset)
356+ , (0x829a, ExposureTime)
358+ , (0x8822, ExposureProgram)
359+ , (0x8827, ISOSpeedRatings)
360+ , (0x9000, ExifVersion)
361+ , (0x9003, DateTimeOriginal)
362+ , (0x9004, DateTimeDigitized)
363+ , (0x9101, ComponentConfiguration)
364+ , (0x9102, CompressedBitsPerPixel)
365+ , (0x9201, ShutterSpeedValue)
366+ , (0x9202, ApertureValue)
367+ , (0x9203, BrightnessValue)
368+ , (0x9204, ExposureBiasValue)
369+ , (0x9205, MaxApertureValue)
370+ , (0x9206, SubjectDistance)
371+ , (0x9207, MeteringMode)
372+ , (0x9208, LightSource)
374+ , (0x920a, FocalLength)
375+ , (0x927c, MakerNote)
376+ , (0x9286, UserComment)
377+ , (0xa000, FlashPixVersion)
378+ , (0xa001, ColorSpace)
379+ , (0xa002, ExifImageWidth)
380+ , (0xa003, ExifImageHeight)
381+ , (0xa004, RelatedSoundFile)
382+ , (0xa005, ExifInteroperabilityOffset)
383+ , (0xa20e, FocalPlaneXResolution)
384+ , (0xa20f, FocalPlaneYResolution)
385+ , (0xa210, FocalPlaneResolutionUnit)
386+ , (0xa217, SensingMethod)
387+ , (0xa300, FileSource)
388+ , (0xa301, SceneType)