{-# 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
(Int -> ImageType -> ShowS)
-> (ImageType -> String)
-> ([ImageType] -> ShowS)
-> Show ImageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImageType -> ShowS
showsPrec :: Int -> ImageType -> ShowS
$cshow :: ImageType -> String
show :: ImageType -> String
$cshowList :: [ImageType] -> ShowS
showList :: [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
(Dimension -> Dimension -> Bool)
-> (Dimension -> Dimension -> Bool) -> Eq Dimension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dimension -> Dimension -> Bool
== :: Dimension -> Dimension -> Bool
$c/= :: Dimension -> Dimension -> Bool
/= :: Dimension -> Dimension -> Bool
Eq

instance Show Dimension where
  show :: Dimension -> String
show (Pixel Integer
a)      = Integer -> String
forall a. Show a => a -> String
show Integer
a              String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"px"
  show (Centimeter Double
a) = Text -> String
T.unpack (Double -> Text
forall a. RealFloat a => a -> Text
showFl Double
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"cm"
  show (Millimeter Double
a) = Text -> String
T.unpack (Double -> Text
forall a. RealFloat a => a -> Text
showFl Double
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"mm"
  show (Inch Double
a)       = Text -> String
T.unpack (Double -> Text
forall a. RealFloat a => a -> Text
showFl Double
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"in"
  show (Percent Double
a)    = Double -> String
forall a. Show a => a -> String
show Double
a              String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"%"
  show (Em Double
a)         = Text -> String
T.unpack (Double -> Text
forall a. RealFloat a => a -> Text
showFl Double
a) String -> ShowS
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]
(Int -> ReadS ImageSize)
-> ReadS [ImageSize]
-> ReadPrec ImageSize
-> ReadPrec [ImageSize]
-> Read ImageSize
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ImageSize
readsPrec :: Int -> ReadS ImageSize
$creadList :: ReadS [ImageSize]
readList :: ReadS [ImageSize]
$creadPrec :: ReadPrec ImageSize
readPrec :: ReadPrec ImageSize
$creadListPrec :: ReadPrec [ImageSize]
readListPrec :: ReadPrec [ImageSize]
Read, Int -> ImageSize -> ShowS
[ImageSize] -> ShowS
ImageSize -> String
(Int -> ImageSize -> ShowS)
-> (ImageSize -> String)
-> ([ImageSize] -> ShowS)
-> Show ImageSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImageSize -> ShowS
showsPrec :: Int -> ImageSize -> ShowS
$cshow :: ImageSize -> String
show :: ImageSize -> String
$cshowList :: [ImageSize] -> ShowS
showList :: [ImageSize] -> ShowS
Show, ImageSize -> ImageSize -> Bool
(ImageSize -> ImageSize -> Bool)
-> (ImageSize -> ImageSize -> Bool) -> Eq ImageSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImageSize -> ImageSize -> Bool
== :: ImageSize -> ImageSize -> Bool
$c/= :: ImageSize -> ImageSize -> Bool
/= :: 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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
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 (Char -> Char -> Bool
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

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" -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Png
                     ByteString
"\x47\x49\x46\x38" -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Gif
                     ByteString
"\x49\x49\x2a\x00" -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Tiff
                     ByteString
"\x4D\x4D\x00\x2a" -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Tiff
                     ByteString
"\xff\xd8\xff\xe0" -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Jpeg  -- JFIF
                     ByteString
"\xff\xd8\xff\xe1" -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Jpeg  -- Exif
                     ByteString
"%PDF"             -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Pdf
                     ByteString
"<svg"             -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Svg
                     ByteString
"<?xm"
                       | ByteString -> Bool
findSvgTag ByteString
img
                                        -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
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 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
B.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') ByteString
img) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"EPSF"
                                        -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
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) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
" EMF"
                                        -> ImageType -> Maybe ImageType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
Emf
                     ByteString
_                  -> Maybe ImageType
forall a. Maybe a
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 (ImageSize -> ImageSize)
-> Either Text ImageSize -> Either Text ImageSize
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  -> Text -> Maybe ImageSize -> Either Text ImageSize
forall {a} {b}. a -> Maybe b -> Either a b
mbToEither Text
"could not determine SVG size" (Maybe ImageSize -> Either Text ImageSize)
-> Maybe ImageSize -> Either Text ImageSize
forall a b. (a -> b) -> a -> b
$ WriterOptions -> ByteString -> Maybe ImageSize
svgSize WriterOptions
opts ByteString
img
       Just ImageType
Eps  -> Text -> Maybe ImageSize -> Either Text ImageSize
forall {a} {b}. a -> Maybe b -> Either a b
mbToEither Text
"could not determine EPS size" (Maybe ImageSize -> Either Text ImageSize)
-> Maybe ImageSize -> Either Text ImageSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ImageSize
epsSize ByteString
img
       Just ImageType
Pdf  -> Text -> Maybe ImageSize -> Either Text ImageSize
forall {a} {b}. a -> Maybe b -> Either a b
mbToEither Text
"could not determine PDF size" (Maybe ImageSize -> Either Text ImageSize)
-> Maybe ImageSize -> Either Text ImageSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ImageSize
pdfSize ByteString
img
       Just ImageType
Emf  -> Text -> Maybe ImageSize -> Either Text ImageSize
forall {a} {b}. a -> Maybe b -> Either a b
mbToEither Text
"could not determine EMF size" (Maybe ImageSize -> Either Text ImageSize)
-> Maybe ImageSize -> Either Text ImageSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ImageSize
emfSize ByteString
img
       Maybe ImageType
Nothing   -> Text -> Either Text ImageSize
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  = a -> Either a b
forall a b. a -> Either a b
Left a
msg
        mbToEither a
_   (Just b
x) = b -> Either a b
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 Integer -> Integer -> Bool
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 Integer -> Integer -> Bool
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
72 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dpiXf, Double
pxYf Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
72 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dpiYf)
  where
    pxXf :: Double
pxXf  = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ ImageSize -> Integer
pxX ImageSize
s
    pxYf :: Double
pxYf  = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ ImageSize -> Integer
pxY ImageSize
s
    dpiXf :: Double
dpiXf = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ ImageSize -> Integer
dpiX ImageSize
s
    dpiYf :: Double
dpiYf = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> Integer -> Double
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 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
ratio)
    (Maybe Double
Nothing, Just Double
h)  -> (Double
h Double -> Double -> Double
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 = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ImageSize -> Integer
pxX ImageSize
s) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
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
_) -> Maybe Double
forall a. Maybe a
Nothing
                   Just Dimension
dim         -> Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Dimension -> Double
inPoints WriterOptions
opts Dimension
dim
                   Maybe Dimension
Nothing          -> Maybe Double
forall a. Maybe a
Nothing

inPoints :: WriterOptions -> Dimension -> Double
inPoints :: WriterOptions -> Dimension -> Double
inPoints WriterOptions
opts Dimension
dim = Double
72 Double -> Double -> Double
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
64Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
11) Double -> Double -> Double
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)      -> Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WriterOptions -> Int
writerDpi WriterOptions
opts)
    (Centimeter Double
a) -> Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.3937007874
    (Millimeter Double
a) -> Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.03937007874
    (Inch Double
a)       -> Double
a
    (Percent Double
_)    -> Double
0
    (Em Double
a)         -> Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
11Double -> Double -> Double
forall 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) -> Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ Double
dpi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.3937007874 :: Integer
    (Millimeter Double
a) -> Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ Double
dpi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.03937007874 :: Integer
    (Inch Double
a)       -> Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ Double
dpi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a :: Integer
    (Percent Double
_)    -> Integer
0
    (Em Double
a)         -> Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ Double
dpi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
11Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
64) :: Integer
  where
    dpi :: Double
dpi = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
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 = Double -> Text
forall a. RealFloat a => a -> Text
showFl (Double -> Text) -> Double -> Text
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 (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
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
'.'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c)) Text
s
  in (\Double
n -> (Double
n, Text
unit)) (Double -> (Double, Text)) -> Maybe Double -> Maybe (Double, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Double
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 (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
        Centimeter Double
x -> Double -> Dimension
Centimeter (Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Millimeter Double
x -> Double -> Dimension
Millimeter (Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Inch Double
x       -> Double -> Dimension
Inch (Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Percent Double
x    -> Double -> Dimension
Percent (Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)
        Em Double
x         -> Double -> Dimension
Em (Double
factor Double -> Double -> Double
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 = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
key [(Text, Text)]
kvs Maybe Text -> (Text -> Maybe Dimension) -> Maybe Dimension
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 Maybe (Double, Text)
-> ((Double, Text) -> Maybe Dimension) -> Maybe Dimension
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Double -> Text -> Maybe Dimension)
-> (Double, Text) -> Maybe Dimension
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Text -> Maybe Dimension
forall {a}. (Eq a, IsString a) => Double -> a -> Maybe Dimension
toDim
  where
    toDim :: Double -> a -> Maybe Dimension
toDim Double
a a
"cm"   = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Centimeter Double
a
    toDim Double
a a
"mm"   = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Millimeter Double
a
    toDim Double
a a
"in"   = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Inch Double
a
    toDim Double
a a
"inch" = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Inch Double
a
    toDim Double
a a
"%"    = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Percent Double
a
    toDim Double
a a
"px"   = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Integer -> Dimension
Pixel (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
a::Integer)
    toDim Double
a a
""     = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Integer -> Dimension
Pixel (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
a::Integer)
    toDim Double
a a
"pt"   = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Inch (Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
72)
    toDim Double
a a
"pc"   = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Inch (Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
6)
    toDim Double
a a
"em"   = Dimension -> Maybe Dimension
forall a. a -> Maybe a
Just (Dimension -> Maybe Dimension) -> Dimension -> Maybe Dimension
forall a b. (a -> b) -> a -> b
$ Double -> Dimension
Em Double
a
    toDim Double
_ a
_      = Maybe Dimension
forall a. Maybe a
Nothing

epsSize :: ByteString -> Maybe ImageSize
epsSize :: ByteString -> Maybe ImageSize
epsSize ByteString
img = do
  let ls :: [ByteString]
ls = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (ByteString
"%" ByteString -> ByteString -> Bool
`B.isPrefixOf`) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
B.lines ByteString
img
  let ls' :: [ByteString]
ls' = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
"%%BoundingBox:" ByteString -> ByteString -> Bool
`B.isPrefixOf`)) [ByteString]
ls
  case [ByteString]
ls' of
       []    -> Maybe ImageSize
forall a. Maybe a
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' <- Text -> Maybe Integer
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Integer) -> Text -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 ByteString
ux
                        Integer
uy' <- Text -> Maybe Integer
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Integer) -> Text -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 ByteString
uy
                        ImageSize -> Maybe ImageSize
forall a. a -> Maybe a
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]
_ -> Maybe ImageSize
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

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

pPdfSize :: A.Parser ImageSize
pPdfSize :: Parser ImageSize
pPdfSize = do
  (Char -> Bool) -> Parser ()
A.skipWhile (Char -> Char -> Bool
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] <- Int -> Parser ByteString Integer -> Parser ByteString [Integer]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
A.count Int
4 (Parser ByteString Integer -> Parser ByteString [Integer])
-> Parser ByteString Integer -> Parser ByteString [Integer]
forall a b. (a -> b) -> a -> b
$ do
        Parser ()
A.skipSpace
        String
raw <- Parser ByteString Char -> Parser ByteString String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 (Parser ByteString Char -> Parser ByteString String)
-> Parser ByteString Char -> Parser ByteString String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser ByteString Char
A.satisfy (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
        case Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Double) -> Text -> Maybe Double
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
raw of
          Just (Double
r :: Double) -> Integer -> Parser ByteString Integer
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Parser ByteString Integer)
-> Integer -> Parser ByteString Integer
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
r
          Maybe Double
Nothing            -> Parser ByteString Integer
forall a. Parser ByteString a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      Parser ()
A.skipSpace
      Char -> Parser Word8
A.char8 Char
']'
      ImageSize -> Parser ImageSize
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ImageSize -> Parser ImageSize) -> ImageSize -> Parser ImageSize
forall a b. (a -> b) -> a -> b
$ ImageSize{
              pxX :: Integer
pxX  = Integer
x2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
x1
            , pxY :: Integer
pxY  = Integer
y2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
y1
            , dpiX :: Integer
dpiX = Integer
72
            , dpiY :: Integer
dpiY = Integer
72 }
   ) Parser ImageSize -> Parser ImageSize -> Parser ImageSize
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
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 -> Text -> Either Text ImageSize
forall a b. a -> Either a b
Left (String -> Text
T.pack String
e)
    Right (DynamicImage
_, Metadatas
meta) -> do
      Word
pxx <- Either Text Word
-> (Word -> Either Text Word) -> Maybe Word -> Either Text Word
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text Word
forall a b. a -> Either a b
Left Text
"Could not determine width") Word -> Either Text Word
forall a b. b -> Either a b
Right (Maybe Word -> Either Text Word) -> Maybe Word -> Either Text Word
forall a b. (a -> b) -> a -> b
$
                   -- first look for exif image width, then width
                   (Keys ExifData -> Metadatas -> Maybe ExifData
forall a. Keys a -> Metadatas -> Maybe a
Metadata.lookup
                     (ExifTag -> Keys ExifData
Metadata.Exif (Word16 -> ExifTag
Exif.TagUnknown Word16
0xA002)) Metadatas
meta Maybe ExifData -> (ExifData -> Maybe Word) -> Maybe Word
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                       ExifData -> Maybe Word
forall {a}. Num a => ExifData -> Maybe a
exifDataToWord) Maybe Word -> Maybe Word -> Maybe Word
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                   Keys Word -> Metadatas -> Maybe Word
forall a. Keys a -> Metadatas -> Maybe a
Metadata.lookup Keys Word
Metadata.Width Metadatas
meta
      Word
pxy <- Either Text Word
-> (Word -> Either Text Word) -> Maybe Word -> Either Text Word
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text Word
forall a b. a -> Either a b
Left Text
"Could not determine height") Word -> Either Text Word
forall a b. b -> Either a b
Right (Maybe Word -> Either Text Word) -> Maybe Word -> Either Text Word
forall a b. (a -> b) -> a -> b
$
                  -- first look for exif image height, then height
                  (Keys ExifData -> Metadatas -> Maybe ExifData
forall a. Keys a -> Metadatas -> Maybe a
Metadata.lookup
                     (ExifTag -> Keys ExifData
Metadata.Exif (Word16 -> ExifTag
Exif.TagUnknown Word16
0xA003)) Metadatas
meta Maybe ExifData -> (ExifData -> Maybe Word) -> Maybe Word
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                       ExifData -> Maybe Word
forall {a}. Num a => ExifData -> Maybe a
exifDataToWord) Maybe Word -> Maybe Word -> Maybe Word
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                  Keys Word -> Metadatas -> Maybe Word
forall a. Keys a -> Metadatas -> Maybe a
Metadata.lookup Keys Word
Metadata.Height Metadatas
meta
      Word
dpix <- Either Text Word
-> (Word -> Either Text Word) -> Maybe Word -> Either Text Word
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Word -> Either Text Word
forall a b. b -> Either a b
Right Word
72) Word -> Either Text Word
forall a b. b -> Either a b
Right (Maybe Word -> Either Text Word) -> Maybe Word -> Either Text Word
forall a b. (a -> b) -> a -> b
$ Keys Word -> Metadatas -> Maybe Word
forall a. Keys a -> Metadatas -> Maybe a
Metadata.lookup Keys Word
Metadata.DpiX Metadatas
meta
      Word
dpiy <- Either Text Word
-> (Word -> Either Text Word) -> Maybe Word -> Either Text Word
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Word -> Either Text Word
forall a b. b -> Either a b
Right Word
72) Word -> Either Text Word
forall a b. b -> Either a b
Right (Maybe Word -> Either Text Word) -> Maybe Word -> Either Text Word
forall a b. (a -> b) -> a -> b
$ Keys Word -> Metadatas -> Maybe Word
forall a. Keys a -> Metadatas -> Maybe a
Metadata.lookup Keys Word
Metadata.DpiY Metadatas
meta
      ImageSize -> Either Text ImageSize
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (ImageSize -> Either Text ImageSize)
-> ImageSize -> Either Text ImageSize
forall a b. (a -> b) -> a -> b
$ ImageSize
                { pxX :: Integer
pxX = Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
pxx
                , pxY :: Integer
pxY = Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
pxy
                , dpiX :: Integer
dpiX = Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
dpix
                , dpiY :: Integer
dpiY = Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
dpiy }
 where
  exifDataToWord :: ExifData -> Maybe a
exifDataToWord (Exif.ExifLong Word32
x) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Word32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x
  exifDataToWord (Exif.ExifShort Word16
x) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Word16 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x
  exifDataToWord ExifData
_ = Maybe a
forall a. Maybe a
Nothing


svgSize :: WriterOptions -> ByteString -> Maybe ImageSize
svgSize :: WriterOptions -> ByteString -> Maybe ImageSize
svgSize WriterOptions
opts ByteString
img = do
  Element
doc <- (Text -> Maybe Element)
-> (Element -> Maybe Element)
-> Either Text Element
-> Maybe Element
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Element -> Text -> Maybe Element
forall a b. a -> b -> a
const Maybe Element
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero) Element -> Maybe Element
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Element -> Maybe Element)
-> Either Text Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Element
parseXMLElement
                                     (Text -> Either Text Element) -> Text -> Either Text Element
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
UTF8.toText ByteString
img
  let viewboxSize :: Maybe (Integer, Integer)
viewboxSize = do
        Text
vb <- (QName -> Bool) -> Element -> Maybe Text
findAttrBy (QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text -> Maybe Text -> QName
QName Text
"viewBox" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
doc
        [Integer
_,Integer
_,Integer
w,Integer
h] <- (Text -> Maybe Integer) -> [Text] -> Maybe [Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> Maybe Integer
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> [Text]
T.words Text
vb)
        (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
w,Integer
h)
  let dpi :: Integer
dpi = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
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 (QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text -> Maybe Text -> QName
QName Text
dir Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
doc Maybe Text -> (Text -> Maybe Dimension) -> Maybe Dimension
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Dimension
lengthToDim
        Integer -> Maybe Integer
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Dimension -> Integer
inPixel WriterOptions
opts Dimension
dim
  Integer
w <- Text -> Maybe Integer
dirToInt Text
"width" Maybe Integer -> Maybe Integer -> Maybe Integer
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Integer, Integer) -> Integer
forall a b. (a, b) -> a
fst ((Integer, Integer) -> Integer)
-> Maybe (Integer, Integer) -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Integer, Integer)
viewboxSize)
  Integer
h <- Text -> Maybe Integer
dirToInt Text
"height" Maybe Integer -> Maybe Integer -> Maybe Integer
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Integer, Integer) -> Integer
forall a b. (a, b) -> b
snd ((Integer, Integer) -> Integer)
-> Maybe (Integer, Integer) -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Integer, Integer)
viewboxSize)
  ImageSize -> Maybe ImageSize
forall a. a -> Maybe a
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 = Get ImageSize
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, ImageSize)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail (Get ImageSize
 -> ByteString
 -> Either
      (ByteString, ByteOffset, String)
      (ByteString, ByteOffset, ImageSize))
-> Get ImageSize
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, ImageSize)
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 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* (Word32
frameR Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
frameL)) Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`quot` (Word32
mmX Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
100)
        h :: Word32
h = (Word32
deviceY Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* (Word32
frameB Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
frameT)) Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`quot` (Word32
mmY Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
100)
        dpiW :: Word32
dpiW = (Word32
deviceX Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
254) Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`quot` (Word32
mmX Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
10)
        dpiH :: Word32
dpiH = (Word32
deviceY Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
254) Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`quot` (Word32
mmY Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
10)
      ImageSize -> Get ImageSize
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ImageSize -> Get ImageSize) -> ImageSize -> Get ImageSize
forall a b. (a -> b) -> a -> b
$ ImageSize
        { pxX :: Integer
pxX = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w
        , pxY :: Integer
pxY = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
h
        , dpiX :: Integer
dpiX = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
dpiW
        , dpiY :: Integer
dpiY = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
dpiH
        }
  in
    case ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, ImageSize)
parseheader (ByteString
 -> Either
      (ByteString, ByteOffset, String)
      (ByteString, ByteOffset, ImageSize))
-> (ByteString -> ByteString)
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, ImageSize)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (ByteString
 -> Either
      (ByteString, ByteOffset, String)
      (ByteString, ByteOffset, ImageSize))
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, ImageSize)
forall a b. (a -> b) -> a -> b
$ ByteString
img of
      Left (ByteString, ByteOffset, String)
_ -> Maybe ImageSize
forall a. Maybe a
Nothing
      Right (ByteString
_, ByteOffset
_, ImageSize
size) -> ImageSize -> Maybe ImageSize
forall a. a -> Maybe a
Just ImageSize
size