handle exif data

This commit is contained in:
nek0 2017-08-13 23:04:22 +02:00
parent cbd441860e
commit 06c0047a1b
2 changed files with 34 additions and 9 deletions

View File

@ -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

View File

@ -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