aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpacien2020-01-27 14:29:47 +0100
committerpacien2020-01-29 22:08:43 +0100
commitc05cbe525ad44273cc1b9b58549af757f549dcb7 (patch)
treea1b697539fa11574dee8e84e7774a17d1961501e
parente91065602eeeebef236dae29e67d8e3334ab4029 (diff)
downloadldgallery-c05cbe525ad44273cc1b9b58549af757f549dcb7.tar.gz
compiler: switch to imagemagick
Use ImageMagick to resize images instead of JuicyPixels, using the superior Lanczos resampling and cutting memory usage. This requires ImageMagick to be installed on the host system and the `magick` executable to be present in the PATH. GitHub: closes #49
-rw-r--r--compiler/package.yaml3
-rw-r--r--compiler/src/Compiler.hs4
-rw-r--r--compiler/src/Config.hs2
-rw-r--r--compiler/src/Processors.hs101
-rw-r--r--ldgallery.1.md3
5 files changed, 33 insertions, 80 deletions
diff --git a/compiler/package.yaml b/compiler/package.yaml
index 043985d..9b96d17 100644
--- a/compiler/package.yaml
+++ b/compiler/package.yaml
@@ -23,12 +23,11 @@ dependencies:
23- aeson 23- aeson
24- yaml 24- yaml
25- cmdargs 25- cmdargs
26- JuicyPixels
27- JuicyPixels-extra
28- parallel-io 26- parallel-io
29- Glob 27- Glob
30- safe 28- safe
31- time 29- time
30- process
32 31
33default-extensions: 32default-extensions:
34- DuplicateRecordFields 33- DuplicateRecordFields
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index aca96bc..27598b7 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -130,9 +130,9 @@ compileGallery inputDirPath outputDirPath rebuildAll =
130 130
131 itemProcessor config cache = 131 itemProcessor config cache =
132 itemFileProcessor 132 itemFileProcessor
133 (pictureMaxResolution config) (jpegExportQuality config) cache 133 (pictureMaxResolution config) cache
134 inputDirPath outputDirPath itemsDir 134 inputDirPath outputDirPath itemsDir
135 thumbnailProcessor config cache = 135 thumbnailProcessor config cache =
136 thumbnailFileProcessor 136 thumbnailFileProcessor
137 (thumbnailMaxResolution config) (jpegExportQuality config) cache 137 (thumbnailMaxResolution config) cache
138 inputDirPath outputDirPath thumbnailsDir 138 inputDirPath outputDirPath thumbnailsDir
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index 4446c14..d670aae 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -41,7 +41,6 @@ data CompilerConfig = CompilerConfig
41 , tagsFromDirectories :: Int 41 , tagsFromDirectories :: Int
42 , thumbnailMaxResolution :: Resolution 42 , thumbnailMaxResolution :: Resolution
43 , pictureMaxResolution :: Maybe Resolution 43 , pictureMaxResolution :: Maybe Resolution
44 , jpegExportQuality :: Int
45 } deriving (Generic, Show) 44 } deriving (Generic, Show)
46 45
47instance FromJSON CompilerConfig where 46instance FromJSON CompilerConfig where
@@ -54,7 +53,6 @@ instance FromJSON CompilerConfig where
54 <*> v .:? "tagsFromDirectories" .!= 0 53 <*> v .:? "tagsFromDirectories" .!= 0
55 <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 400) 54 <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 400)
56 <*> v .:? "pictureMaxResolution" 55 <*> v .:? "pictureMaxResolution"
57 <*> v .:? "jpegExportQuality" .!= 80
58 56
59 57
60data GalleryConfig = GalleryConfig 58data GalleryConfig = GalleryConfig
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 2abdec5..4e7c5a7 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -24,17 +24,15 @@ module Processors
24 ) where 24 ) where
25 25
26 26
27import Control.Exception (Exception, throwIO) 27import Control.Exception (Exception)
28import Data.Function ((&)) 28import Data.Function ((&))
29import Data.Ratio ((%))
30import Data.Char (toLower) 29import Data.Char (toLower)
31 30
32import System.Directory hiding (copyFile) 31import System.Directory hiding (copyFile)
33import qualified System.Directory 32import qualified System.Directory
34import System.FilePath 33import System.FilePath
35 34
36import Codec.Picture 35import System.Process (callProcess)
37import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented)
38 36
39import Resource 37import Resource
40 ( ItemProcessor, ThumbnailProcessor 38 ( ItemProcessor, ThumbnailProcessor
@@ -47,10 +45,8 @@ data ProcessingException = ProcessingException FilePath String deriving Show
47instance Exception ProcessingException 45instance Exception ProcessingException
48 46
49 47
50data PictureFileFormat = Bmp | Jpg | Png | Tiff | Hdr | Gif
51
52-- TODO: handle video, music, text... 48-- TODO: handle video, music, text...
53data Format = PictureFormat PictureFileFormat | Unknown 49data Format = PictureFormat | Unknown
54 50
55formatFromPath :: Path -> Format 51formatFromPath :: Path -> Format
56formatFromPath = 52formatFromPath =
@@ -60,14 +56,15 @@ formatFromPath =
60 . fileName 56 . fileName
61 where 57 where
62 fromExt :: String -> Format 58 fromExt :: String -> Format
63 fromExt ".bmp" = PictureFormat Bmp 59 fromExt ext = case ext of
64 fromExt ".jpg" = PictureFormat Jpg 60 ".bmp" -> PictureFormat
65 fromExt ".jpeg" = PictureFormat Jpg 61 ".jpg" -> PictureFormat
66 fromExt ".png" = PictureFormat Png 62 ".jpeg" -> PictureFormat
67 fromExt ".tiff" = PictureFormat Tiff 63 ".png" -> PictureFormat
68 fromExt ".hdr" = PictureFormat Hdr 64 ".tiff" -> PictureFormat
69 fromExt ".gif" = PictureFormat Gif 65 ".hdr" -> PictureFormat
70 fromExt _ = Unknown 66 ".gif" -> PictureFormat
67 _ -> Unknown
71 68
72 69
73type FileProcessor = 70type FileProcessor =
@@ -80,47 +77,16 @@ copyFileProcessor inputPath outputPath =
80 (putStrLn $ "Copying:\t" ++ outputPath) 77 (putStrLn $ "Copying:\t" ++ outputPath)
81 >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath 78 >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath
82 79
83 80resizePictureUpTo :: Resolution -> FileProcessor
84type LossyExportQuality = Int 81resizePictureUpTo maxResolution inputPath outputPath =
85type StaticImageReader = FilePath -> IO (Either String DynamicImage) 82 (putStrLn $ "Generating:\t" ++ outputPath)
86type StaticImageWriter = FilePath -> DynamicImage -> IO () 83 >> ensureParentDir (flip resize) outputPath inputPath
87
88resizeStaticImageUpTo :: Resolution -> LossyExportQuality -> PictureFileFormat -> FileProcessor
89resizeStaticImageUpTo maxResolution jpegExportQuality pictureFormat =
90 resizerFor pictureFormat
91 where 84 where
92 resizerFor :: PictureFileFormat -> FileProcessor 85 maxSize :: Resolution -> String
93 resizerFor Bmp = resizer readBitmap saveBmpImage 86 maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">"
94 resizerFor Jpg = resizer readJpeg (saveJpgImage jpegExportQuality) 87
95 resizerFor Png = resizer readPng savePngImage 88 resize :: FileName -> FileName -> IO ()
96 resizerFor Tiff = resizer readTiff saveTiffImage 89 resize input output = callProcess "magick" [input, "-resize", maxSize maxResolution, output]
97 resizerFor Hdr = resizer readHDR saveRadianceImage
98 resizerFor Gif = resizer readGif saveGifImage'
99 where
100 saveGifImage' :: StaticImageWriter
101 saveGifImage' outputPath image =
102 saveGifImage outputPath image
103 & either (throwIO . ProcessingException outputPath) id
104
105 resizer :: StaticImageReader -> StaticImageWriter -> FileProcessor
106 resizer reader writer inputPath outputPath =
107 (putStrLn $ "Generating:\t" ++ outputPath)
108 >> reader inputPath
109 >>= either (throwIO . ProcessingException inputPath) return
110 >>= return . (fitDynamicImage maxResolution)
111 >>= ensureParentDir writer outputPath
112
113 fitDynamicImage :: Resolution -> DynamicImage -> DynamicImage
114 fitDynamicImage (Resolution boxWidth boxHeight) image =
115 convertRGBA8 image
116 & scaleBilinear targetWidth targetHeight
117 & ImageRGBA8
118 where
119 picWidth = dynamicMap imageWidth image
120 picHeight = dynamicMap imageHeight image
121 resizeRatio = min (boxWidth % picWidth) (boxHeight % picHeight)
122 targetWidth = floor $ resizeRatio * (picWidth % 1)
123 targetHeight = floor $ resizeRatio * (picHeight % 1)
124 90
125 91
126type Cache = FileProcessor -> FileProcessor 92type Cache = FileProcessor -> FileProcessor
@@ -160,8 +126,8 @@ type ItemFileProcessor =
160 -> FileName -- ^ Output class (subdir) 126 -> FileName -- ^ Output class (subdir)
161 -> ItemProcessor 127 -> ItemProcessor
162 128
163itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor 129itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor
164itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase resClass inputRes = 130itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
165 cached processor inPath outPath 131 cached processor inPath outPath
166 >> resourceAt outPath relOutPath 132 >> resourceAt outPath relOutPath
167 >>= return . props 133 >>= return . props
@@ -172,14 +138,9 @@ itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase re
172 (processor, props) = processorFor maxResolution $ formatFromPath inputRes 138 (processor, props) = processorFor maxResolution $ formatFromPath inputRes
173 139
174 processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps) 140 processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps)
175 processorFor Nothing _ = 141 processorFor Nothing _ = (copyFileProcessor, Other)
176 (copyFileProcessor, Other) 142 processorFor (Just maxRes) PictureFormat = (resizePictureUpTo maxRes, Picture)
177 processorFor _ (PictureFormat Gif) = 143 processorFor _ Unknown = (copyFileProcessor, Other) -- TODO: handle video reencoding and others?
178 (copyFileProcessor, Picture) -- TODO: handle animated gif resizing
179 processorFor (Just maxRes) (PictureFormat picFormat) =
180 (resizeStaticImageUpTo maxRes jpegExportQuality picFormat, Picture)
181 processorFor _ Unknown =
182 (copyFileProcessor, Other) -- TODO: handle video reencoding and others?
183 144
184 145
185type ThumbnailFileProcessor = 146type ThumbnailFileProcessor =
@@ -188,8 +149,8 @@ type ThumbnailFileProcessor =
188 -> FileName -- ^ Output class (subdir) 149 -> FileName -- ^ Output class (subdir)
189 -> ThumbnailProcessor 150 -> ThumbnailProcessor
190 151
191thumbnailFileProcessor :: Resolution -> LossyExportQuality -> Cache -> ThumbnailFileProcessor 152thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor
192thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resClass inputRes = 153thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
193 cached <$> processorFor (formatFromPath inputRes) 154 cached <$> processorFor (formatFromPath inputRes)
194 & process 155 & process
195 where 156 where
@@ -205,7 +166,5 @@ thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resC
205 >>= return . Just 166 >>= return . Just
206 167
207 processorFor :: Format -> Maybe FileProcessor 168 processorFor :: Format -> Maybe FileProcessor
208 processorFor (PictureFormat picFormat) =