diff --git a/Handler/Commons.hs b/Handler/Commons.hs index ca89a1f..ff1017a 100755 --- a/Handler/Commons.hs +++ b/Handler/Commons.hs @@ -29,11 +29,14 @@ import System.Directory import Text.Markdown import Codec.Picture as P import Codec.Picture.Metadata as PM hiding (insert, delete) +import Codec.Picture.Metadata.Exif as PM import Codec.Picture.ScaleDCT +import Codec.Picture.Extra import Codec.ImageType import Graphics.Svg import Graphics.Rasterific.Svg import Graphics.Text.TrueType +import Graphics.HsExif import Debug.Trace @@ -241,7 +244,6 @@ generateThumbs path uId aId mime = do orig <- case mime of "image/svg+xml" -> do svg <- liftIO $ loadSvgFile path - liftIO $ traceIO "------------------> SVG loaded!" let (swidth, sheight) = documentSize 100 (fromJust svg) scale = let @@ -257,15 +259,40 @@ generateThumbs path uId aId mime = do in Just (nwidth, nheight) (img, _) <- liftIO $ renderSvgDocument emptyFontCache scale 100 $ fromJust svg - liftIO $ traceIO "------------------> SVG rendered!" return img _ -> do eimg <- liftIO $ readImage path case eimg of Left err -> error err - Right img -> -- This branch contains "classical" image formats like bmp or png - return $ convertRGBA8 img + Right img -> do + meta <- liftIO $ parseFileExif path + -- error $ show meta + case meta of + Left _ -> + return $ convertRGBA8 img + Right metamap -> + case getOrientation metamap of + Just Mirror -> + return $ flipHorizontally $ convertRGBA8 img + Just (Rotation rot) -> + case rot of + HundredAndEighty -> + return $ rotate180 $ convertRGBA8 img + MinusNinety -> + return $ rotateRight90 $ convertRGBA8 img + Ninety -> + return $ rotateLeft90 $ convertRGBA8 img + Just (MirrorRotation rot) -> + case rot of + HundredAndEighty -> + return $ flipVertically $ convertRGBA8 img + MinusNinety -> + return $ flipHorizontally $ rotateRight90 $ convertRGBA8 img + Ninety -> + return $ rotate180 $ convertRGBA8 img + _ -> + return $ convertRGBA8 img let thumbName = FP.takeBaseName path ++ "_thumb.png" prevName = FP.takeBaseName path ++ "_preview.png" pathPrefix = "static" FP. "data" FP. T.unpack (extractKey uId) FP. T.unpack (extractKey aId) @@ -281,12 +308,8 @@ generateThumbs path uId aId mime = do pWidth = ceiling (fromIntegral oWidth * pScale) tPix = scaleBilinearAlpha tWidth tHeight orig pPix = scaleBilinearAlpha pWidth pHeight orig - liftIO $ traceIO $ show oWidth - liftIO $ traceIO "------------------> Image scaled!" liftIO $ savePngImage tPath $ ImageRGBA8 tPix - liftIO $ traceIO "------------------> Saved thumbnail!" liftIO $ savePngImage pPath $ ImageRGBA8 pPix - liftIO $ traceIO "------------------> Saved preview!" return $ ThumbsMeta { metaThumbPath = tPath , metaPreviewPath = pPath diff --git a/eidolon.cabal b/eidolon.cabal index df5ae9f..341cf46 100755 --- a/eidolon.cabal +++ b/eidolon.cabal @@ -1,5 +1,5 @@ name: eidolon -version: 0.1.10.0 +version: 0.1.11.0 synopsis: Image gallery in Yesod homepage: https://eidolon.nek0.eu license: AGPL-3 @@ -128,7 +128,9 @@ library , http-types , image-type , JuicyPixels >= 3.2.8 + , JuicyPixels-extra , JuicyPixels-scale-dct + , hsexif , classy-prelude-yesod >= 1.0 -- svg stuff , rasterific-svg >= 0.3.2.1