Respect Exif orientation in LaTeX, Docx, ODT output

src/Text/Pandoc/ImageSize.hs

@@ -14,14 +14,20 @@ Functions for determining the size of a PNG, JPEG, or GIF image.
 -}
 module Text.Pandoc.ImageSize ( ImageType(..)
                              , ImageSize(..)
+                             , ImageTransform(..)
                              , imageType
                              , imageSize
+                             , imageTransform
                              , sizeInPixels
                              , sizeInPoints
                              , desiredSizeInPoints
+                             , rotatedDesiredSizeInPoints
                              , Dimension(..)
                              , Direction(..)
+                             , Flip(..)
+                             , Rotate(..)
                              , dimension
+                             , rotateDirection
                              , lengthToDim
                              , scaleDimension
                              , inInch
@@ -41,6 +47,7 @@ import Data.Bits ((.&.), shiftR, shiftL)
 import Data.Word (bitReverse32)
 import Data.Maybe (isJust, fromJust)
 import Data.Char (isDigit)
+import Data.Maybe (fromMaybe)
 import Control.Monad
 import Text.Pandoc.Shared (safeRead)
 import Data.Default (Default)
@@ -56,6 +63,7 @@ import Control.Applicative
 import qualified Data.Attoparsec.ByteString as AW
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Codec.Picture.Metadata as Metadata
+import Codec.Picture.Metadata.Exif (ExifTag(TagOrientation), ExifData(..))
 import Codec.Picture (decodeImageWithMetadata)
 
 -- quick and dirty functions to get image sizes
@@ -84,6 +92,26 @@ instance Show Dimension where
   show (Percent a)    = show a              ++ "%"
   show (Em a)         = T.unpack (showFl a) ++ "em"
 
+data Flip = NoFlip | FlipH | FlipV deriving Show
+
+data Rotate = R0 | R90 | R180 | R270 deriving Show
+
+-- There's a case to be made that this API is wrong and other code should deal
+-- somewhat more directly with the 8 EXIF orientations that actually occur,
+-- because as-is we could model transformations that don't occur in nature,
+-- like FlipV + R270. But since mirroring and rotating are distinct operations
+-- everywhere we happen to deal with it, I don't think anything is gained in
+-- practice by making ImageTransform a sum type with 8 fixed cases instead of a
+-- product type that theoretically allows for 4 cases we won't encounter.
+data ImageTransform = ImageTransform
+  { tFlip :: Flip,
+    tRotate :: Rotate
+  }
+  deriving (Show)
+
+instance Default ImageTransform where
+  def = ImageTransform NoFlip R0
+
 data ImageSize = ImageSize{
                      pxX   :: Integer
                    , pxY   :: Integer
@@ -176,13 +204,29 @@ sizeInPoints s = (pxXf * 72 / dpiXf, pxYf * 72 / dpiYf)
 -- are specified in the attribute (or only dimensions in percentages).
 desiredSizeInPoints :: WriterOptions -> Attr -> ImageSize -> (Double, Double)
 desiredSizeInPoints opts attr s =
+  desiredSizeInPoints' opts attr s ratio
+  where
+    ratio = fromIntegral (pxX s) / fromIntegral (pxY s)
+
+-- | As desiredSizeInPoints, but swapping the width and height dimensions if
+-- the indicated rotation is a quarter-turn or three-quarter-turn.
+rotatedDesiredSizeInPoints :: WriterOptions -> Attr -> ImageSize -> Rotate -> (Double, Double)
+rotatedDesiredSizeInPoints opts attr s r =
+  desiredSizeInPoints' opts attr s (ratio r)
+  where
+    ratio R0 = fromIntegral (pxX s) / fromIntegral (pxY s)
+    ratio R180 = fromIntegral (pxX s) / fromIntegral (pxY s)
+    ratio R90 = fromIntegral (pxY s) / fromIntegral (pxX s)
+    ratio R270 = fromIntegral (pxY s) / fromIntegral (pxX s)
+
+desiredSizeInPoints' :: WriterOptions -> Attr -> ImageSize -> Double -> (Double, Double)
+desiredSizeInPoints' opts attr s ratio =
   case (getDim Width, getDim Height) of
     (Just w, Just h)   -> (w, h)
     (Just w, Nothing)  -> (w, w / ratio)
-    (Nothing, Just h)  -> (h * ratio, h)
+    (Nothing, Just h)  -> (h * ratio , h)
     (Nothing, Nothing) -> sizeInPoints s
   where
-    ratio = fromIntegral (pxX s) / fromIntegral (pxY s)
     getDim dir = case dimension dir attr of
                    Just (Percent _) -> Nothing
                    Just dim         -> Just $ inPoints opts dim
@@ -451,3 +495,32 @@ webpSize opts img =
   case AW.parseOnly pWebpSize img of
     Left _   -> Nothing
     Right sz -> Just sz { dpiX = fromIntegral $ writerDpi opts, dpiY = fromIntegral $ writerDpi opts}
+
+imageTransform :: ByteString -> ImageTransform
+imageTransform img =
+  case decodeImageWithMetadata img of
+    Left _ -> def
+    Right (_, meta) ->
+      let orient = fromMaybe ExifNone $ Metadata.lookup (Metadata.Exif TagOrientation) meta
+       in exifToTransform (word orient)
+  where
+    word ExifNone = 1
+    word (ExifShort w) = w
+    word _ = 1
+    exifToTransform 1 = def
+    exifToTransform 2 = def{tFlip = FlipH}
+    exifToTransform 3 = def{tRotate = R180}
+    exifToTransform 4 = def{tFlip = FlipV}
+    exifToTransform 5 = def{tFlip = FlipH, tRotate = R270}
+    exifToTransform 6 = def{tRotate = R90}
+    exifToTransform 7 = def{tFlip = FlipH, tRotate = R90}
+    exifToTransform 8 = def{tRotate = R270}
+    exifToTransform _ = def
+
+rotateDirection :: Rotate -> Direction -> Direction
+rotateDirection R0 x = x
+rotateDirection R90 Width = Height
+rotateDirection R90 Height = Width
+rotateDirection R180 x = x
+rotateDirection R270 Width = Height
+rotateDirection R270 Height = Width

src/Text/Pandoc/Writers/Docx/OpenXML.hs

@@ -941,13 +941,24 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
                     [extLst])
           _ -> return ([("r:embed", T.pack ident)], [])
       let
-        (xpt,ypt) = desiredSizeInPoints opts attr
-               (either (const def) id (imageSize opts img))
+        transform = imageTransform img
+        (xpt,ypt) = rotatedDesiredSizeInPoints opts attr
+               (either (const def) id (imageSize opts img)) (tRotate transform)
         -- 12700 emu = 1 pt
         pageWidthPt = case dimension Width attr of
                         Just (Percent a) -> pageWidth * floor (a * 127)
                         _                -> pageWidth * 12700
         (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700) pageWidthPt
+        height = case tRotate transform of
+                   R0 -> tshow xemu
+                   R90 -> tshow yemu
+                   R180 -> tshow xemu
+                   R270 -> tshow yemu
+        width = case tRotate transform of
+                   R0 -> tshow yemu
+                   R90 -> tshow xemu
+                   R180 -> tshow yemu
+                   R270 -> tshow xemu
         cNvPicPr = mknode "pic:cNvPicPr" [] $
                          mknode "a:picLocks" [("noChangeArrowheads","1")
                                              ,("noChangeAspect","1")] ()
@@ -962,10 +973,19 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
           , mknode "a:stretch" [] $
               mknode "a:fillRect" [] ()
           ]
-        xfrm =    mknode "a:xfrm" []
+        xfrmFlip NoFlip = []
+        xfrmFlip FlipH = [("flipH", "1")]
+        xfrmFlip FlipV = [("flipV", "1")]
+        -- 60,000ths of a degree
+        xfrmRot R0 = []
+        xfrmRot R90 = [("rot", "5400000")]
+        xfrmRot R180 = [("rot", "10800000")]
+        xfrmRot R270 = [("rot", "16200000")]
+
+        xfrm =    mknode "a:xfrm" ((xfrmFlip (tFlip transform)) <> (xfrmRot (tRotate transform)))
                         [ mknode "a:off" [("x","0"),("y","0")] ()
-                        , mknode "a:ext" [("cx",tshow xemu)
-                                         ,("cy",tshow yemu)] () ]
+                        , mknode "a:ext" [("cx",height)
+                                         ,("cy",width)] () ]
         prstGeom = mknode "a:prstGeom" [("prst","rect")] $
                          mknode "a:avLst" [] ()
         ln =      mknode "a:ln" [("w","9525")]
@@ -986,7 +1006,7 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
         imgElt = mknode "w:r" [] $
           mknode "w:drawing" [] $
             mknode "wp:inline" []
-              [ mknode "wp:extent" [("cx",tshow xemu),("cy",tshow yemu)] ()
+              [ mknode "wp:extent" [("cx",height),("cy",width)] ()
               , mknode "wp:effectExtent"
                 [("b","0"),("l","0"),("r","0"),("t","0")] ()
               , mknode "wp:docPr"

src/Text/Pandoc/Writers/LaTeX.hs

@@ -30,6 +30,7 @@ import Control.Monad
       liftM,
       when,
       unless )
+import Control.Monad.Except (catchError)
 import Data.Containers.ListUtils (nubOrd)
 import Data.Char (isDigit)
 import Data.List (intersperse, (\\))
@@ -41,7 +42,7 @@ import qualified Data.Text as T
 import Network.URI (unEscapeString)
 import Text.DocTemplates (FromContext(lookupContext), renderTemplate)
 import Text.Collate.Lang (renderLang, Lang(langLanguage))
-import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang)
+import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang, fetchItem)
 import Text.Pandoc.Definition
 import Text.Pandoc.Highlighting (formatLaTeXBlock, formatLaTeXInline, highlight,
                                  styleToLaTeX)
@@ -1075,23 +1076,25 @@ inlineToLaTeX (Image attr@(_,_,kvs) _ (source, _)) = do
   modify $ \s -> s{ stGraphics = True
                   , stSVG = stSVG s || isSVG }
   opts <- gets stOptions
-  let showDim dir = let d = text (show dir) <> "="
-                    in case dimension dir attr of
+  (ImageTransform flp rot) <- catchError ((imageTransform . fst) <$> fetchItem source) (\_ -> return def)
+  let redir = rotateDirection rot
+      showDim dir = let d = text (show dir) <> "="
+                    in case dimension (redir dir) attr of
                          Just (Pixel a)   ->
                            [d <> literal (showInInch opts (Pixel a)) <> "in"]
                          Just (Percent a) ->
                            [d <> literal (showFl (a / 100)) <>
-                             case dir of
+                             case (redir dir) of
                                 Width  -> "\\linewidth"
                                 Height -> "\\textheight"
                            ]
                          Just dim         ->
                            [d <> text (show dim)]
                          Nothing          ->
                            case dir of
-                                Width | isJust (dimension Height attr) ->
+                                Width | isJust (dimension (redir Height) attr) ->
                                   [d <> "\\linewidth"]
-                                Height | isJust (dimension Width attr) ->
+                                Height | isJust (dimension (redir Width) attr) ->
                                   [d <> "\\textheight"]
                                 _ -> []
       optList = showDim Width <> showDim Height <>
@@ -1107,14 +1110,30 @@ inlineToLaTeX (Image attr@(_,_,kvs) _ (source, _)) = do
       source' = if isURI source
                    then source
                    else T.pack $ unEscapeString $ T.unpack source
+      -- For images in vertically-mirrored exif orientation, \scalebox{1}[-1]
+      -- will reflect them to below the baseline. It seems like to get the
+      -- final image to be aligned with the baseline again, we have to rotate
+      -- it 180 degrees from the default (baseline) origin and then rotate
+      -- it again about the center so it's facing right side up. In real life
+      -- where there's only 8 possible EXIF orientations, there's never any
+      -- other rotation required for a vertical flip, but I think it would
+      -- still interact correctly if it somehow came up.
+      flipbox NoFlip x = x
+      flipbox FlipH x = "\\scalebox{-1}[1]" <> braces x
+      flipbox FlipV x = "\\rotatebox[origin=c]{180}{\\rotatebox{180}{{\\scalebox{1}[-1]" <> braces x <> "}}}"
+      rotatebox R0 x = x
+      rotatebox R90 x = "\\rotatebox[origin=br]{-90}" <> braces x
+      rotatebox R180 x = "\\rotatebox[origin=c]{180}" <> braces x
+      rotatebox R270 x = "\\rotatebox[origin=bl]{-270}" <> braces x
   source'' <- stringToLaTeX URLString source'
   inHeading <- gets stInHeading
   return $
     (if inHeading then "\\protect" else "") <>
     (case dimension Width attr `mplus` dimension Height attr of
        Just _ -> id
        Nothing -> ("\\pandocbounded" <>) . braces)
-      ((if isSVG then "\\includesvg" else "\\includegraphics") <>
+      ((rotatebox rot . flipbox flp) $
+       (if isSVG then "\\includesvg" else "\\includegraphics") <>
         options <> braces (literal source''))
 inlineToLaTeX (Note contents) = do
   setEmptyLine False

src/Text/Pandoc/Writers/ODT.hs

@@ -257,11 +257,19 @@ transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = catchError
                        Left msg -> do
                          report $ CouldNotDetermineImageSize src msg
                          return (100, 100)
+       let (ImageTransform flp rot) = imageTransform img
+       let xflip NoFlip = ("mirror", "none")
+           xflip FlipH = ("mirror", "horizontal")
+           xflip FlipV = ("mirror", "vertical")
+       let xrotate R0 = ("rotate", "rotate(0)")
+           xrotate R90 = ("rotate", "rotate(" <> showFl (3*(pi :: Double)/2) <> ")")
+           xrotate R180 = ("rotate", "rotate(" <> showFl (pi :: Double) <> ")")
+           xrotate R270 = ("rotate", "rotate(" <> showFl ((pi :: Double) /2) <> ")")
        let dims =
              case (getDim Width, getDim Height) of
                (Just w, Just h)              -> [("width", tshow w), ("height", tshow h)]
                (Just w@(Percent _), Nothing) -> [("rel-width", tshow w),("rel-height", "scale"),("width", tshow ptX <> "pt"),("height", tshow ptY <> "pt")]
-               (Nothing, Just h@(Percent _)) -> [("rel-width", "scale"),("rel-height", tshow h),("width", tshow ptX <> "pt"),("height", tshow ptY <> "pt")]
+               (Nothing, Just h@(Percent _)) -> [("rel-width", "scale"),("rel-height", tshow h),("width", tshow ptY <> "pt"),("height", tshow ptY <> "pt")]
                (Just w@(Inch i), Nothing)    -> [("width", tshow w), ("height", tshow (i / ratio) <> "in")]
                (Nothing, Just h@(Inch i))    -> [("width", tshow (i * ratio) <> "in"), ("height", tshow h)]
                _                             -> [("width", tshow ptX <> "pt"), ("height", tshow ptY <> "pt")]
@@ -271,7 +279,7 @@ transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = catchError
                               Just (Percent i) -> Just $ Percent i
                               Just dim         -> Just $ Inch $ inInch opts dim
                               Nothing          -> Nothing
-       let  newattr = (id', cls, dims)
+       let  newattr = (id', cls, (xflip flp):(xrotate rot):dims)
        src' <- if writerLinkImages opts
                   then
                     case T.unpack src of

src/Text/Pandoc/Writers/OpenDocument.hs

@@ -198,6 +198,15 @@ formulaStyle mt = inTags False "style:style"
                                                   ,("style:horizontal-rel", "paragraph-content")
                                                   ,("style:wrap",           "none")]
 
+imageStyles :: [Doc Text]
+imageStyles = [mirror "horizontal", mirror "vertical"]
+  where
+    mirror hv = inTags False "style:style"
+      [("style:name", "mirror-" <> hv)
+      ,("style:family", "graphic")
+      ,("style:parent-style-name", "Graphics")]
+      $ selfClosingTag "style:graphic-properties" [("style:mirror", hv)]
+
 inBookmarkTags :: Text -> Doc Text -> Doc Text
 inBookmarkTags ident d =
   selfClosingTag "text:bookmark-start" [ ("text:name", ident) ]
@@ -260,7 +269,7 @@ writeOpenDocument opts (Pandoc meta blocks) = do
                   meta'
            b <- blocksToOpenDocument opts blocks
            return (b, m)
-  let styles   = stTableStyles s ++ stParaStyles s ++ formulaStyles ++
+  let styles   = stTableStyles s ++ stParaStyles s ++ formulaStyles ++ imageStyles ++
                      map snd (sortBy (flip (comparing fst)) (
                         Map.elems (stTextStyles s)))
       listStyle (n,l) = inTags True "text:list-style"
@@ -659,6 +668,9 @@ inlineToOpenDocument o ils
                id' <- gets stImageId
                modify (\st -> st{ stImageId = id' + 1 })
                let getDims [] = []
+                   getDims (("mirror", "none") :xs) = getDims xs
+                   getDims (("mirror", t) :xs) = ("draw:style-name", "mirror-" <> t) : getDims xs
+                   getDims (("rotate", t) :xs) = ("draw:transform", t)  : getDims xs
                    getDims (("width", w) :xs) = ("svg:width", w)  : getDims xs
                    getDims (("rel-width", w):xs) = ("style:rel-width", w) : getDims xs
                    getDims (("height", h):xs) = ("svg:height", h) : getDims xs

test/command/6792.md

@@ -22,6 +22,8 @@
     <style:font-face style:name="Courier New" style:font-family-generic="modern" style:font-pitch="fixed" svg:font-family="'Courier New'" />
   </office:font-face-decls>
   <office:automatic-styles>
+    <style:style style:name="mirror-vertical" style:family="graphic" style:parent-style-name="Graphics"><style:graphic-properties style:mirror="vertical" /></style:style>
+    <style:style style:name="mirror-horizontal" style:family="graphic" style:parent-style-name="Graphics"><style:graphic-properties style:mirror="horizontal" /></style:style>
     <style:style style:name="fr2" style:family="graphic" style:parent-style-name="Formula"><style:graphic-properties style:vertical-pos="middle" style:vertical-rel="text" style:horizontal-pos="center" style:horizontal-rel="paragraph-content" style:wrap="none" /></style:style>
     <style:style style:name="fr1" style:family="graphic" style:parent-style-name="Formula"><style:graphic-properties style:vertical-pos="middle" style:vertical-rel="text" /></style:style>
     <style:style style:name="P1" style:family="paragraph" style:parent-style-name="Table_20_Contents">

test/command/8256.md

@@ -17,6 +17,8 @@ Testing.
   </office:font-face-decls>
   <office:automatic-styles>
     <style:style style:name="T1" style:family="text"><style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic" /></style:style>
+    <style:style style:name="mirror-vertical" style:family="graphic" style:parent-style-name="Graphics"><style:graphic-properties style:mirror="vertical" /></style:style>
+    <style:style style:name="mirror-horizontal" style:family="graphic" style:parent-style-name="Graphics"><style:graphic-properties style:mirror="horizontal" /></style:style>
     <style:style style:name="fr2" style:family="graphic" style:parent-style-name="Formula"><style:graphic-properties style:vertical-pos="middle" style:vertical-rel="text" style:horizontal-pos="center" style:horizontal-rel="paragraph-content" style:wrap="none" /></style:style>
     <style:style style:name="fr1" style:family="graphic" style:parent-style-name="Formula"><style:graphic-properties style:vertical-pos="middle" style:vertical-rel="text" /></style:style>
   </office:automatic-styles>