{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns      #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
{- |
Module      : Text.Pandoc.ImageSize
Copyright   : Copyright (C) 2011-2023 John MacFarlane
License     : GNU GPL, version 2 or above

Maintainer  : John MacFarlane <jgm@berkeley.edu>
Stability   : alpha
Portability : portable

Functions for determining the size of a PNG, JPEG, or GIF image.
-}
module Text.Pandoc.ImageSize ( ImageType(..)
                             , imageType
                             , imageSize
                             , sizeInPixels
                             , sizeInPoints
                             , desiredSizeInPoints
                             , Dimension(..)
                             , Direction(..)
                             , dimension
                             , lengthToDim
                             , scaleDimension
                             , inInch
                             , inPixel
                             , inPoints
                             , inEm
                             , numUnit
                             , showInInch
                             , showInPixel
                             , showFl
                             ) where
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as BL
import Data.Binary.Get
import Data.Char (isDigit)
import Control.Monad
import Text.Pandoc.Shared (safeRead)
import Data.Default (Default)
import Numeric (showFFloat)
import Text.Pandoc.Definition
import Text.Pandoc.Options
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.XML.Light hiding (Attr)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Encoding as TE
import Control.Applicative
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Codec.Picture.Metadata as Metadata
import qualified Codec.Picture.Metadata.Exif as Exif
import Codec.Picture (decodeImageWithMetadata)

-- quick and dirty functions to get image sizes
-- algorithms borrowed from wwwis.pl

data ImageType = Png | Gif | Jpeg | Svg | Pdf | Eps | Emf | Tiff
                 deriving Int -> ImageType -> ShowS
[ImageType] -> ShowS
ImageType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageType] -> ShowS
$cshowList :: [ImageType] -> ShowS
show :: ImageType -> String
$cshow :: ImageType -> String
showsPrec :: Int -> ImageType -> ShowS
$cshowsPrec :: Int -> ImageType -> ShowS
Show
data Direction = Width | Height
instance Show Direction where
  show :: Direction -> String
show Direction
Width  = String
"width"
  show Direction
Height = String
"height"

data Dimension = Pixel Integer
               | Centimeter Double
               | Millimeter Double
               | Inch Double
               | Percent Double
               | Em Double
               deriving Dimension -> Dimension -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dimension -> Dimension -> Bool
$c/= :: Dimension -> Dimension -> Bool
== :: Dimension -> Dimension -> Bool
$c== :: Dimension -> Dimension -> Bool
Eq

instance Show Dimension where
  show :: Dimension -> String
show (Pixel Integer
a)      = forall a. Show a => a -> String
show Integer
a              forall a. [a] -> [a] -> [a]
++ String
"px"
  show (Centimeter Double
a) = Text -> String
T.unpack (forall a. RealFloat a => a -> Text
showFl Double
a) forall a. [a] -> [a] -> [a]
++ String
"cm"
  show (Millimeter Double
a) = Text -> String
T.unpack (forall a. RealFloat a => a -> Text
showFl Double
a) forall a. [a] -> [a] -> [a]
++ String
"mm"
  show (Inch Double
a)       = Text -> String
T.unpack (forall a. RealFloat a => a -> Text
showFl Double
a) forall a. [a] -> [a] -> [a]
++ String
"in"
  show (Percent Double
a)    = forall a. Show a => a -> String
show Double
a              forall a. [a] -> [a] -> [a]
++ String
"%"
  show (Em Double
a)         = Text -> String
T.unpack (forall a. RealFloat a => a -> Text
showFl Double
a) forall a. [a] -> [a] -> [a]
++ String
"em"

data ImageSize = ImageSize{
                     ImageSize -> Integer
pxX   :: Integer
                   , ImageSize -> Integer
pxY   :: Integer
                   , ImageSize -> Integer
dpiX  :: Integer
                   , ImageSize -> Integer
dpiY  :: Integer
                   } deriving (ReadPrec [ImageSize]
ReadPrec ImageSize
Int -> ReadS ImageSize
ReadS [ImageSize]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImageSize]
$creadListPrec :: ReadPrec [ImageSize]
readPrec :: ReadPrec ImageSize
$creadPrec :: ReadPrec ImageSize
readList :: ReadS [ImageSize]
$creadList :: ReadS [ImageSize]
readsPrec :: Int -> ReadS ImageSize
$creadsPrec :: Int -> ReadS ImageSize
Read, Int -> ImageSize -> ShowS
[ImageSize] -> ShowS
ImageSize -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageSize] -> ShowS
$cshowList :: [ImageSize] -> ShowS
show :: ImageSize -> String
$cshow :: ImageSize -> String
showsPrec :: Int -> ImageSize -> ShowS
$cshowsPrec :: Int -> ImageSize -> ShowS
Show, ImageSize -> ImageSize -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageSize -> ImageSize -> Bool
$c/= :: ImageSize -> ImageSize -> Bool
== :: ImageSize -> ImageSize -> Bool
$c== :: ImageSize -> ImageSize -> Bool
Eq)
instance Default ImageSize where
  def :: ImageSize
def = Integer -> Integer -> Integer -> Integer -> ImageSize
ImageSize Integer
300 Integer
200 Integer
72 Integer
72

showFl :: (RealFloat a) => a -> T.Text
showFl :: forall a. RealFloat a => a -> Text
showFl a
a = Text -> Text
removeExtra0s forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (forall a. a -> Maybe a
Just Int
5) a
a String
""

removeExtra0s :: T.Text -> T.Text
removeExtra0s :: Text -> Text
removeExtra0s Text
s = case (Char -> Bool) -> Text -> Text
T.dropWhileEnd (forall a. Eq a => a -> a -> Bool
==Char
'0') Text
s of
  (Text -> Maybe (Text, Char)
T.unsnoc -> Just (Text
xs, Char
'.')) -> Text
xs
  Text
xs                           -> Text
xs

dropBOM :: ByteString -> ByteString
dropBOM :: ByteString -> ByteString
dropBOM ByteString
bs =
 if ByteString
"\xEF\xBB\xBF" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
bs
    then Int -> ByteString -> ByteString
B.drop Int
3 ByteString
bs
    else ByteString
bs

imageType :: ByteString -> Maybe ImageType
imageType :: ByteString -> Maybe ImageType
imageType ByteString
img = case Int -> ByteString -> ByteString
B.take Int
4 ByteString
img of
                     ByteString
"\x89\x50\x4e\x47" -> forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Png
                     ByteString
"\x47\x49\x46\x38" -> forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Gif
                     ByteString
"\x49\x49\x2a\x00" -> forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Tiff
                     ByteString
"\x4D\x4D\x00\x2a" -> forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Tiff
                     ByteString
"\xff\xd8\xff\xe0" -> forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Jpeg  -- JFIF
                     ByteString
"\xff\xd8\xff\xe1" -> forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Jpeg  -- Exif
                     ByteString
"%PDF"             -> forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Pdf
                     ByteString
"<svg"             -> forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Svg
                     ByteString
"<?xm"
                       | ByteString -> Bool
findSvgTag ByteString
img
                                        -> forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Svg
                     ByteString
"%!PS"
                       |  Int -> ByteString -> ByteString
B.take Int
4 (Int -> ByteString -> ByteString
B.drop Int
1 forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
B.dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
' ') ByteString
img) forall a. Eq a => a -> a -> Bool
== ByteString
"EPSF"
                                        -> forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Eps
                     ByteString
"\x01\x00\x00\x00"
                       | Int -> ByteString -> ByteString
B.take Int
4 (Int -> ByteString -> ByteString
B.drop Int
40 ByteString
img) forall a. Eq a => a -> a -> Bool
== ByteString
" EMF"
                                        -> forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Emf
                     ByteString
"\xEF\xBB\xBF<" -- BOM before svg
                          -> ByteString -> Maybe ImageType
imageType (Int -> ByteString -> ByteString
B.drop Int
3 ByteString
img)
                     ByteString
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

findSvgTag :: ByteString -> Bool
findSvgTag :: ByteString -> Bool
findSvgTag ByteString
img = ByteString
"<svg" ByteString -> ByteString -> Bool
`B.isInfixOf` ByteString
img Bool -> Bool -> Bool
|| ByteString
"<SVG" ByteString -> ByteString -> Bool
`B.isInfixOf` ByteString
img

imageSize :: WriterOptions -> ByteString -> Either T.Text ImageSize
imageSize :: WriterOptions -> ByteString -> Either Text ImageSize
imageSize WriterOptions
opts ByteString
img = ImageSize -> ImageSize
checkDpi forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  case ByteString -> Maybe ImageType
imageType ByteString
img of
       Just ImageType
Png  -> ByteString -> Either Text ImageSize
getSize ByteString
img
       Just ImageType
Gif  -> ByteString -> Either Text ImageSize
getSize ByteString
img
       Just ImageType
Jpeg -> ByteString -> Either Text ImageSize
getSize ByteString
img
       Just ImageType
Tiff -> ByteString -> Either Text ImageSize
getSize ByteString
img
       Just ImageType
Svg  -> forall {a} {b}. a -> Maybe b -> Either a b
mbToEither Text
"could not determine SVG size" forall a b. (a -> b) -> a -> b
$ WriterOptions -> ByteString -> Maybe ImageSize
svgSize WriterOptions
opts ByteString
img
       Just ImageType
Eps  -> forall {a} {b}. a -> Maybe b -> Either a b
mbToEither Text
"could not determine EPS size" forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ImageSize
epsSize ByteString
img
       Just ImageType
Pdf  -> forall {a} {b}. a -> Maybe b -> Either a b
mbToEither Text
"could not determine PDF size" forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ImageSize
pdfSize ByteString
img
       Just ImageType
Emf  -> forall {a} {b}. a -> Maybe b -> Either a b
mbToEither Text
"could not determine EMF size" forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ImageSize
emfSize ByteString
img
       Maybe ImageType
Nothing   -> forall a b. a -> Either a b
Left Text
"could not determine image type"
  where mbToEither :: a -> Maybe b -> Either a b
mbToEither a
msg Maybe b
Nothing  = forall a b. a -> Either a b
Left a
msg
        mbToEither a
_   (Just b
x) = forall a b. b -> Either a b
Right b
x
        -- see #6880, some defective JPEGs may encode dpi 0, so default to 72
        -- if that value is 0
        checkDpi :: ImageSize -> ImageSize
checkDpi ImageSize
size =
          ImageSize
size{ dpiX :: Integer
dpiX = if ImageSize -> Integer
dpiX ImageSize
size forall a. Eq a => a -> a -> Bool
== Integer
0 then Integer
72 else ImageSize -> Integer
dpiX ImageSize
size
              , dpiY :: Integer
dpiY = if ImageSize -> Integer
dpiY ImageSize
size forall a. Eq a => a -> a -> Bool
== Integer
0 then Integer
72 else ImageSize -> Integer
dpiY ImageSize
size }


sizeInPixels :: ImageSize -> (Integer, Integer)
sizeInPixels :: ImageSize -> (Integer, Integer)
sizeInPixels ImageSize
s = (ImageSize -> Integer
pxX ImageSize
s, ImageSize -> Integer
pxY ImageSize
s)

-- | Calculate (height, width) in points using the image file's dpi metadata,
-- using 72 Points == 1 Inch.
sizeInPoints :: ImageSize -> (Double, Double)
sizeInPoints :: ImageSize -> (Double, Double)
sizeInPoints ImageSize
s = (Double
pxXf forall a. Num a => a -> a -> a
* Double
72 forall a. Fractional a => a -> a -> a
/ Double
dpiXf, Double
pxYf forall a. Num a => a -> a -> a
* Double
72 forall a. Fractional a => a -> a -> a
/ Double
dpiYf)
  where
    pxXf :: Double
pxXf  = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ImageSize -> Integer
pxX ImageSize
s
    pxYf :: Double
pxYf  = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ImageSize -> Integer
pxY ImageSize
s
    dpiXf :: Double
dpiXf = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ImageSize -> Integer
dpiX ImageSize
s
    dpiYf :: Double
dpiYf = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ImageSize -> Integer
dpiY ImageSize
s

-- | Calculate (height, width) in points, considering the desired dimensions in the
-- attribute, while falling back on the image file's dpi metadata if no dimensions
-- are specified in the attribute (or only dimensions in percentages).
desiredSizeInPoints :: WriterOptions -> Attr -> ImageSize -> (Double, Double)
desiredSizeInPoints :: WriterOptions -> Attr -> ImageSize -> (Double, Double)
desiredSizeInPoints WriterOptions
opts Attr
attr ImageSize
s =
  case (Direction -> Maybe Double
getDim Direction
Width, Direction -> Maybe Double
getDim Direction
Height) of
    (Just Double
w, Just Double
h)   -> (Double
w, Double
h)
    (Just Double
w, Maybe Double
Nothing)  -> (Double
w, Double
w forall a. Fractional a => a -> a -> a
/ Double
ratio)
    (Maybe Double
Nothing, Just Double
h)  -> (Double
h forall a. Num a => a -> a -> a
* Double
ratio, Double
h)
    (Maybe Double
Nothing, Maybe Double
Nothing) -> ImageSize -> (Double, Double)
sizeInPoints ImageSize
s
  where
    ratio :: Double
ratio = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ImageSize -> Integer
pxX ImageSize
s) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ImageSize -> Integer
pxY ImageSize
s)
    getDim :: Direction -> Maybe Double
getDim Direction
dir = case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
                   Just (Percent Double
_) -> forall a. Maybe a
Nothing
                   Just Dimension
dim         -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Dimension -> Double
inPoints WriterOptions
opts Dimension
dim
                   Maybe Dimension
Nothing          -> forall a. Maybe a
Nothing

inPoints :: WriterOptions -> Dimension -> Double
inPoints :: WriterOptions -> Dimension -> Double
inPoints WriterOptions
opts Dimension
dim = Double
72 forall a. Num a => a -> a -> a
* WriterOptions -> Dimension -> Double
inInch WriterOptions
opts Dimension
dim

inEm :: WriterOptions -> Dimension -> Double
inEm :: WriterOptions -> Dimension -> Double
inEm WriterOptions
opts Dimension
dim = (Double
64forall a. Fractional a => a -> a -> a
/Double
11) forall a. Num a => a -> a -> a
* WriterOptions -> Dimension -> Double
inInch WriterOptions
opts Dimension
dim

inInch :: WriterOptions -> Dimension -> Double
inInch :: WriterOptions -> Dimension -> Double
inInch WriterOptions
opts Dimension
dim =
  case Dimension
dim of
    (Pixel Integer
a)      -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (WriterOptions -> Int
writerDpi WriterOptions
opts)
    (Centimeter Double
a) -> Double
a forall a. Num a => a -> a -> a
* Double
0.3937007874
    (Millimeter Double
a) -> Double
a forall a. Num a => a -> a -> a
* Double
0.03937007874
    (Inch Double
a)       -> Double
a
    (Percent Double
_)    -> Double
0
    (Em Double
a)         -> Double
a forall a. Num a => a -> a -> a
* (Double
11forall a. Fractional a => a -> a -> a
/Double
64)

inPixel :: WriterOptions -> Dimension -> Integer
inPixel :: WriterOptions -> Dimension -> Integer
inPixel WriterOptions
opts Dimension
dim =
  case Dimension
dim of
    (Pixel Integer
a)      -> Integer
a
    (Centimeter Double
a) -> forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ Double
dpi forall a. Num a => a -> a -> a
* Double
a forall a. Num a => a -> a -> a
* Double
0.3937007874 :: Integer
    (Millimeter Double
a) -> forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ Double
dpi forall a. Num a => a -> a -> a
* Double
a forall a. Num a => a -> a -> a
* Double
0.03937007874 :: Integer
    (Inch Double
a)       -> forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ Double
dpi forall a. Num a => a -> a -> a
* Double
a :: Integer
    (Percent Double
_)    -> Integer
0
    (Em Double
a)         -> forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ Double
dpi forall a. Num a => a -> a -> a
* Double
a forall a. Num a => a -> a -> a
* (Double
11forall a. Fractional a => a -> a -> a
/Double
64) :: Integer
  where
    dpi :: Double
dpi = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerDpi WriterOptions
opts

-- | Convert a Dimension to Text denoting its equivalent in inches, for example "2.00000".
-- Note: Dimensions in percentages are converted to the empty string.
showInInch :: WriterOptions -> Dimension -> T.Text
showInInch :: WriterOptions -> Dimension -> Text
showInInch WriterOptions
_ (Percent Double
_) = Text
""
showInInch WriterOptions
opts Dimension
dim = forall a. RealFloat a => a -> Text
showFl forall a b. (a -> b) -> a -> b
$ WriterOptions -> Dimension -> Double
inInch WriterOptions
opts Dimension
dim

-- | Convert a Dimension to Text denoting its equivalent in pixels, for example "600".
-- Note: Dimensions in percentages are converted to the empty string.
showInPixel :: WriterOptions -> Dimension -> T.Text
showInPixel :: WriterOptions -> Dimension -> Text
showInPixel WriterOptions
_ (Percent Double
_) = Text
""
showInPixel WriterOptions
opts Dimension
dim = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ WriterOptions -> Dimension -> Integer
inPixel WriterOptions
opts Dimension
dim

-- | Maybe split a string into a leading number and trailing unit, e.g. "3cm" to Just (3.0, "cm")
numUnit :: T.Text -> Maybe (Double, T.Text)
numUnit :: Text -> Maybe (Double, Text)
numUnit Text
s =
  let (Text
nums, Text
unit) = (Char -> Bool) -> Text -> (Text, Text)
T.span (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| (Char
'.'forall a. Eq a => a -> a -> Bool
==Char
c)) Text
s
  in (\Double
n -> (Double
n, Text
unit)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
nums

-- | Scale a dimension by a factor.
scaleDimension :: Double -> Dimension -> Dimension
scaleDimension :: Double -> Dimension -> Dimension
scaleDimension Double
factor Dimension
dim =
  case Dimension
dim of
        Pixel Integer
x      -> Integer -> Dimension
Pixel (forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Double
factor forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
        Centimeter Double
x -> Double -> Dimension
Centimeter (Double
factor forall a. Num a => a -> a -> a
* Double
x)
        Millimeter Double
x -> Double -> Dimension
Millimeter (Double
factor forall a. Num a => a -> a -> a
* Double
x)
        Inch Double
x       -> Double -> Dimension
Inch (Double
factor forall a. Num a => a -> a -> a
* Double
x)
        Percent Double
x    -> Double -> Dimension
Percent (Double
factor forall a. Num a => a -> a -> a
* Double
x)
        Em Double
x         -> Double -> Dimension
Em (Double
factor forall a. Num a => a -> a -> a
* Double
x)

-- | Read a Dimension from an Attr attribute.
-- `dimension Width attr` might return `Just (Pixel 3)` or for example `Just (Centimeter 2.0)`, etc.
dimension :: Direction -> Attr -> Maybe Dimension
dimension :: Direction -> Attr -> Maybe Dimension
dimension Direction
dir (Text
_, [Text]
_, [(Text, Text)]
kvs) =
  case Direction
dir of
    Direction
Width  -> Text -> Maybe Dimension
extractDim Text
"width"
    Direction
Height -> Text -> Maybe Dimension
extractDim Text
"height"
  where
    extractDim :: Text -> Maybe Dimension
extractDim Text
key = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
key [(Text, Text)]
kvs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Dimension
lengthToDim

lengthToDim :: T.Text -> Maybe Dimension
lengthToDim :: Text -> Maybe Dimension
lengthToDim Text
s = Text -> Maybe (Double, Text)
numUnit Text
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {a}. (Eq a, IsString a) => Double -> a -> Maybe Dimension
toDim
  where
    toDim :: Double -> a -> Maybe Dimension
toDim Double
a a
"cm"   = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Centimeter Double
a
    toDim Double
a a
"mm"   = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Millimeter Double
a
    toDim Double
a a
"in"   = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Inch Double
a
    toDim Double
a a
"inch" = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Inch Double
a
    toDim Double
a a
"%"    = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Percent Double
a
    toDim Double
a a
"px"   = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Integer -> Dimension
Pixel (forall a b. (RealFrac a, Integral b) => a -> b
floor Double
a::Integer)
    toDim Double
a a
""     = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Integer -> Dimension
Pixel (forall a b. (RealFrac a, Integral b) => a -> b
floor Double
a::Integer)
    toDim Double
a a
"pt"   = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Inch (Double
a forall a. Fractional a => a -> a -> a
/ Double
72)
    toDim Double
a a
"pc"   = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Inch (Double
a forall a. Fractional a => a -> a -> a
/ Double
6)
    toDim Double
a a
"em"   = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Em Double
a
    toDim Double
_ a
_      = forall a. Maybe a
Nothing

epsSize :: ByteString -> Maybe ImageSize
epsSize :: ByteString -> Maybe ImageSize
epsSize ByteString
img = do
  let ls :: [ByteString]
ls = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (ByteString
"%" ByteString -> ByteString -> Bool
`B.isPrefixOf`) forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
B.lines ByteString
img
  let ls' :: [ByteString]
ls' = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
"%%BoundingBox:" ByteString -> ByteString -> Bool
`B.isPrefixOf`)) [ByteString]
ls
  case [ByteString]
ls' of
       []    -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
       (ByteString
x:[ByteString]
_) -> case ByteString -> [ByteString]
B.words ByteString
x of
                     [ByteString
_, ByteString
_, ByteString
_, ByteString
ux, ByteString
uy] -> do
                        Integer
ux' <- forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 ByteString
ux
                        Integer
uy' <- forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 ByteString
uy
                        forall (m :: * -> *) a. Monad m => a -> m a
return ImageSize{
                            pxX :: Integer
pxX  = Integer
ux'
                          , pxY :: Integer
pxY  = Integer
uy'
                          , dpiX :: Integer
dpiX = Integer
72
                          , dpiY :: Integer
dpiY = Integer
72 }
                     [ByteString]
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

pdfSize :: ByteString -> Maybe ImageSize
pdfSize :: ByteString -> Maybe ImageSize
pdfSize ByteString
img =
  case forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser ImageSize
pPdfSize ByteString
img of
    Left String
_   -> forall a. Maybe a
Nothing
    Right ImageSize
sz -> forall a. a -> Maybe a
Just ImageSize
sz

pPdfSize :: A.Parser ImageSize
pPdfSize :: Parser ImageSize
pPdfSize = do
  (Char -> Bool) -> Parser ()
A.skipWhile (forall a. Eq a => a -> a -> Bool
/=Char
'/')
  Char -> Parser Word8
A.char8 Char
'/'
  (do ByteString -> Parser ByteString
A.string ByteString
"MediaBox"
      Parser ()
A.skipSpace
      Char -> Parser Word8
A.char8 Char
'['
      Parser ()
A.skipSpace
      [Integer
x1,Integer
y1,Integer
x2,Integer
y2] <- forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
A.count Int
4 forall a b. (a -> b) -> a -> b
$ do
        Parser ()
A.skipSpace
        String
raw <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Char
A.satisfy (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.')
        case forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
raw of
          Just (Double
r :: Double) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
floor Double
r
          Maybe Double
Nothing            -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
      Parser ()
A.skipSpace
      Char -> Parser Word8
A.char8 Char
']'
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ImageSize{
              pxX :: Integer
pxX  = Integer
x2 forall a. Num a => a -> a -> a
- Integer
x1
            , pxY :: Integer
pxY  = Integer
y2 forall a. Num a => a -> a -> a
- Integer
y1
            , dpiX :: Integer
dpiX = Integer
72
            , dpiY :: Integer
dpiY = Integer
72 }
   ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ImageSize
pPdfSize

getSize :: ByteString -> Either T.Text ImageSize
getSize :: ByteString -> Either Text ImageSize
getSize ByteString
img =
  case ByteString -> Either String (DynamicImage, Metadatas)
decodeImageWithMetadata ByteString
img of
    Left String
e -> forall a b. a -> Either a b
Left (String -> Text
T.pack String
e)
    Right (DynamicImage
_, Metadatas
meta) -> do
      Word
pxx <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Text
"Could not determine width") forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
                   -- first look for exif image width, then width
                   (forall a. Keys a -> Metadatas -> Maybe a
Metadata.lookup
                     (ExifTag -> Keys ExifData
Metadata.Exif (Word16 -> ExifTag
Exif.TagUnknown Word16
0xA002)) Metadatas
meta forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                       forall {a}. Num a => ExifData -> Maybe a
exifDataToWord) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                   forall a. Keys a -> Metadatas -> Maybe a
Metadata.lookup Keys Word
Metadata.Width Metadatas
meta
      Word
pxy <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Text
"Could not determine height") forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
                  -- first look for exif image height, then height
                  (forall a. Keys a -> Metadatas -> Maybe a
Metadata.lookup
                     (ExifTag -> Keys ExifData
Metadata.Exif (Word16 -> ExifTag
Exif.TagUnknown Word16
0xA003)) Metadatas
meta forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                       forall {a}. Num a => ExifData -> Maybe a
exifDataToWord) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                  forall a. Keys a -> Metadatas -> Maybe a
Metadata.lookup Keys Word
Metadata.Height Metadatas
meta
      Word
dpix <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. b -> Either a b
Right Word
72) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Keys a -> Metadatas -> Maybe a
Metadata.lookup Keys Word
Metadata.DpiX Metadatas
meta
      Word
dpiy <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. b -> Either a b
Right Word
72) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Keys a -> Metadatas -> Maybe a
Metadata.lookup Keys Word
Metadata.DpiY Metadatas
meta
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ImageSize
                { pxX :: Integer
pxX = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
pxx
                , pxY :: Integer
pxY = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
pxy
                , dpiX :: Integer
dpiX = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
dpix
                , dpiY :: Integer
dpiY = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
dpiy }
 where
  exifDataToWord :: ExifData -> Maybe a
exifDataToWord (Exif.ExifLong Word32
x) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x
  exifDataToWord (Exif.ExifShort Word16
x) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x
  exifDataToWord ExifData
_ = forall a. Maybe a
Nothing


svgSize :: WriterOptions -> ByteString -> Maybe ImageSize
svgSize :: WriterOptions -> ByteString -> Maybe ImageSize
svgSize WriterOptions
opts ByteString
img = do
  Element
doc <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Either Text Element
parseXMLElement
                                     forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict forall a b. (a -> b) -> a -> b
$ ByteString -> Text
UTF8.toText forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
dropBOM ByteString
img
  let viewboxSize :: Maybe (Integer, Integer)
viewboxSize = do
        Text
vb <- (QName -> Bool) -> Element -> Maybe Text
findAttrBy (forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text -> Maybe Text -> QName
QName Text
"viewBox" forall a. Maybe a
Nothing forall a. Maybe a
Nothing) Element
doc
        [Integer
_,Integer
_,Integer
w,Integer
h] <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> [Text]
T.words Text
vb)
        forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
w,Integer
h)
  let dpi :: Integer
dpi = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerDpi WriterOptions
opts
  let dirToInt :: Text -> Maybe Integer
dirToInt Text
dir = do
        Dimension
dim <- (QName -> Bool) -> Element -> Maybe Text
findAttrBy (forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text -> Maybe Text -> QName
QName Text
dir forall a. Maybe a
Nothing forall a. Maybe a
Nothing) Element
doc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Dimension
lengthToDim
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WriterOptions -> Dimension -> Integer
inPixel WriterOptions
opts Dimension
dim
  Integer
w <- Text -> Maybe Integer
dirToInt Text
"width" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Integer, Integer)
viewboxSize)
  Integer
h <- Text -> Maybe Integer
dirToInt Text
"height" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Integer, Integer)
viewboxSize)
  forall (m :: * -> *) a. Monad m => a -> m a
return ImageSize {
    pxX :: Integer
pxX  = Integer
w
  , pxY :: Integer
pxY  = Integer
h
  , dpiX :: Integer
dpiX = Integer
dpi
  , dpiY :: Integer
dpiY = Integer
dpi
  }

emfSize :: ByteString -> Maybe ImageSize
emfSize :: ByteString -> Maybe ImageSize
emfSize ByteString
img =
  let
    parseheader :: ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, ImageSize)
parseheader = forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail forall a b. (a -> b) -> a -> b
$ do
      Int -> Get ()
skip Int
0x18             -- 0x00
      Word32
frameL <- Get Word32
getWord32le -- 0x18  measured in 1/100 of a millimetre
      Word32
frameT <- Get Word32
getWord32le -- 0x1C
      Word32
frameR <- Get Word32
getWord32le -- 0x20
      Word32
frameB <- Get Word32
getWord32le -- 0x24
      Int -> Get ()
skip Int
0x20             -- 0x28
      Word32
deviceX <- Get Word32
getWord32le  -- 0x48 pixels of reference device
      Word32
deviceY <- Get Word32
getWord32le  -- 0x4C
      Word32
mmX <- Get Word32
getWord32le      -- 0x50 real mm of reference device (always 320*240?)
      Word32
mmY <- Get Word32
getWord32le      -- 0x58
      -- end of header
      let
        w :: Word32
w = (Word32
deviceX forall a. Num a => a -> a -> a
* (Word32
frameR forall a. Num a => a -> a -> a
- Word32
frameL)) forall a. Integral a => a -> a -> a
`quot` (Word32
mmX forall a. Num a => a -> a -> a
* Word32
100)
        h :: Word32
h = (Word32
deviceY forall a. Num a => a -> a -> a
* (Word32
frameB forall a. Num a => a -> a -> a
- Word32
frameT)) forall a. Integral a => a -> a -> a
`quot` (Word32
mmY forall a. Num a => a -> a -> a
* Word32
100)
        dpiW :: Word32
dpiW = (Word32
deviceX forall a. Num a => a -> a -> a
* Word32
254) forall a. Integral a => a -> a -> a
`quot` (Word32
mmX forall a. Num a => a -> a -> a
* Word32
10)
        dpiH :: Word32
dpiH = (Word32
deviceY forall a. Num a => a -> a -> a
* Word32
254) forall a. Integral a => a -> a -> a
`quot` (Word32
mmY forall a. Num a => a -> a -> a
* Word32
10)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ImageSize
        { pxX :: Integer
pxX = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w
        , pxY :: Integer
pxY = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
h
        , dpiX :: Integer
dpiX = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
dpiW
        , dpiY :: Integer
dpiY = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
dpiH
        }
  in
    case ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, ImageSize)
parseheader forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict forall a b. (a -> b) -> a -> b
$ ByteString
img of
      Left (ByteString, ByteOffset, String)
_ -> forall a. Maybe a
Nothing
      Right (ByteString
_, ByteOffset
_, ImageSize
size) -> forall a. a -> Maybe a
Just ImageSize
size