diff options
author | pacien | 2020-01-27 14:29:47 +0100 |
---|---|---|
committer | pacien | 2020-01-29 22:08:43 +0100 |
commit | c05cbe525ad44273cc1b9b58549af757f549dcb7 (patch) | |
tree | a1b697539fa11574dee8e84e7774a17d1961501e /compiler | |
parent | e91065602eeeebef236dae29e67d8e3334ab4029 (diff) | |
download | ldgallery-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
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/package.yaml | 3 | ||||
-rw-r--r-- | compiler/src/Compiler.hs | 4 | ||||
-rw-r--r-- | compiler/src/Config.hs | 2 | ||||
-rw-r--r-- | compiler/src/Processors.hs | 101 |
4 files changed, 33 insertions, 77 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 | ||
33 | default-extensions: | 32 | default-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 | ||
47 | instance FromJSON CompilerConfig where | 46 | instance 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 | ||
60 | data GalleryConfig = GalleryConfig | 58 | data 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 | ||
27 | import Control.Exception (Exception, throwIO) | 27 | import Control.Exception (Exception) |
28 | import Data.Function ((&)) | 28 | import Data.Function ((&)) |
29 | import Data.Ratio ((%)) | ||
30 | import Data.Char (toLower) | 29 | import Data.Char (toLower) |
31 | 30 | ||
32 | import System.Directory hiding (copyFile) | 31 | import System.Directory hiding (copyFile) |
33 | import qualified System.Directory | 32 | import qualified System.Directory |
34 | import System.FilePath | 33 | import System.FilePath |
35 | 34 | ||
36 | import Codec.Picture | 35 | import System.Process (callProcess) |
37 | import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented) | ||
38 | 36 | ||
39 | import Resource | 37 | import Resource |
40 | ( ItemProcessor, ThumbnailProcessor | 38 | ( ItemProcessor, ThumbnailProcessor |
@@ -47,10 +45,8 @@ data ProcessingException = ProcessingException FilePath String deriving Show | |||
47 | instance Exception ProcessingException | 45 | instance Exception ProcessingException |
48 | 46 | ||
49 | 47 | ||
50 | data PictureFileFormat = Bmp | Jpg | Png | Tiff | Hdr | Gif | ||
51 | |||
52 | -- TODO: handle video, music, text... | 48 | -- TODO: handle video, music, text... |
53 | data Format = PictureFormat PictureFileFormat | Unknown | 49 | data Format = PictureFormat | Unknown |
54 | 50 | ||
55 | formatFromPath :: Path -> Format | 51 | formatFromPath :: Path -> Format |
56 | formatFromPath = | 52 | formatFromPath = |
@@ -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 | ||
73 | type FileProcessor = | 70 | type 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 | 80 | resizePictureUpTo :: Resolution -> FileProcessor | |
84 | type LossyExportQuality = Int | 81 | resizePictureUpTo maxResolution inputPath outputPath = |
85 | type StaticImageReader = FilePath -> IO (Either String DynamicImage) | 82 | (putStrLn $ "Generating:\t" ++ outputPath) |
86 | type StaticImageWriter = FilePath -> DynamicImage -> IO () | 83 | >> ensureParentDir (flip resize) outputPath inputPath |
87 | |||
88 | resizeStaticImageUpTo :: Resolution -> LossyExportQuality -> PictureFileFormat -> FileProcessor | ||
89 | resizeStaticImageUpTo 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 | ||
126 | type Cache = FileProcessor -> FileProcessor | 92 | type 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 | ||
163 | itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor | 129 | itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor |
164 | itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase resClass inputRes = | 130 | itemFileProcessor 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 | ||
185 | type ThumbnailFileProcessor = | 146 | type ThumbnailFileProcessor = |
@@ -188,8 +149,8 @@ type ThumbnailFileProcessor = | |||
188 | -> FileName -- ^ Output class (subdir) | 149 | -> FileName -- ^ Output class (subdir) |
189 | -> ThumbnailProcessor | 150 | -> ThumbnailProcessor |
190 | 151 | ||
191 | thumbnailFileProcessor :: Resolution -> LossyExportQuality -> Cache -> ThumbnailFileProcessor | 152 | thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor |
192 | thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resClass inputRes = | 153 | thumbnailFileProcessor 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 |