@@ -32,9 +32,14 @@ module Text.Pandoc.ImageSize ( ImageType(..), imageType, imageSize,
3232 sizeInPixels, sizeInPoints ) where
3333import Data.ByteString (ByteString, unpack)
3434import qualified Data.ByteString.Char8 as B
35+import qualified Data.ByteString.Lazy as BL
36+import Control.Applicative
3537import Control.Monad
3638import Data.Bits
39+import Data.Binary
40+import Data.Binary.Get
3741import Text.Pandoc.Shared (safeRead)
42+import qualified Data.Map as M
3843
3944-- quick and dirty functions to get image sizes
4045-- algorithms borrowed from wwwis.pl
@@ -143,7 +148,7 @@ jpegSize img = do
143148 guard $ B.length rest >= 14
144149 case hdr of
145150 "\xff\xd8\xff\xe0" -> jfifSize rest
146− "\xff\xd8\xff\xe1" -> exifSize rest
151+ "\xff\xd8\xff\xe1" -> exifSize $ B.takeWhile (/= '\xff') rest
147152 _ -> mzero
148153
149154jfifSize :: ByteString -> Maybe ImageSize
@@ -177,18 +182,208 @@ findJfifSize bs = do
177182 Nothing -> fail "Did not find length record"
178183
179184exifSize :: ByteString -> Maybe ImageSize
180−exifSize rest = do
181− let bs' = B.takeWhile (/='\xff') $ B.drop 8 rest -- exif data
182− let (_,bs'') = B.breakSubstring "\xa0\x02" bs' -- width
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
188− _ -> Nothing
189− case (tonum rawWidth, tonum rawHeight) of
190− (Just w, Just h) ->
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
185+exifSize = -- runGet ((Just <$> exifHeader) `mplus` return Nothing) .
186+ runGet (Just <$> exifHeader) .
187+ BL.fromChunks . (:[])
194188
189+exifHeader :: Get ImageSize
190+exifHeader = do
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) =
202+ if bigEndian
203+ then (getWord16be, getWord32be, getWord64be)
204+ else (getWord16le, getWord32le, getWord64le)
205+ let getRational = do
206+ num <- getWord32
207+ den <- getWord32
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
214+ let ifdEntry = do
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) <-
221+ case dataFormat of
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
241+ offs <- getWord32
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
248+ pos <- bytesRead
249+ skip (fromIntegral offset - (fromIntegral pos - 8))
250+ numsubentries <- getWord16
251+ sequence $
252+ replicate (fromIntegral numsubentries) ifdEntry
253+ _ -> return []
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)
262+ _ -> 1
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
267+ return $ ImageSize{
268+ pxX = width
269+ , pxY = height
270+ , dpiX = xres
271+ , dpiY = yres }
272+
273+data DataFormat = UnsignedByte Word8
274+ | AsciiString BL.ByteString
275+ | UnsignedShort Word16
276+ | UnsignedLong Word32
277+ | UnsignedRational Rational
278+ | SignedByte Word8
279+ | Undefined Word8
280+ | SignedShort Word16
281+ | SignedLong Word32
282+ | SignedRational Rational
283+ | SingleFloat Word32
284+ | DoubleFloat Word64
285+ deriving (Show)
286+
287+data TagType = ImageDescription
288+ | Make
289+ | Model
290+ | Orientation
291+ | XResolution
292+ | YResolution
293+ | ResolutionUnit
294+ | Software
295+ | DateTime
296+ | WhitePoint
297+ | PrimaryChromaticities
298+ | YCbCrCoefficients
299+ | YCbCrPositioning
300+ | ReferenceBlackWhite
301+ | Copyright
302+ | ExifOffset
303+ | ExposureTime
304+ | FNumber
305+ | ExposureProgram
306+ | ISOSpeedRatings
307+ | ExifVersion
308+ | DateTimeOriginal
309+ | DateTimeDigitized
310+ | ComponentConfiguration
311+ | CompressedBitsPerPixel
312+ | ShutterSpeedValue
313+ | ApertureValue
314+ | BrightnessValue
315+ | ExposureBiasValue
316+ | MaxApertureValue
317+ | SubjectDistance
318+ | MeteringMode
319+ | LightSource
320+ | Flash
321+ | FocalLength
322+ | MakerNote
323+ | UserComment
324+ | FlashPixVersion
325+ | ColorSpace
326+ | ExifImageWidth
327+ | ExifImageHeight
328+ | RelatedSoundFile
329+ | ExifInteroperabilityOffset
330+ | FocalPlaneXResolution
331+ | FocalPlaneYResolution
332+ | FocalPlaneResolutionUnit
333+ | SensingMethod
334+ | FileSource
335+ | SceneType
336+ deriving (Show, Eq, Ord)
337+
338+tagTypeTable :: M.Map Word16 TagType
339+tagTypeTable = M.fromList
340+ [ (0x010e, ImageDescription)
341+ , (0x010f, Make)
342+ , (0x0110, Model)
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)
357+ , (0x829d, FNumber)
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)
373+ , (0x9209, Flash)
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)
389+ ]