From c05cbe525ad44273cc1b9b58549af757f549dcb7 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 27 Jan 2020 14:29:47 +0100
Subject: 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
---
 compiler/src/Processors.hs | 101 ++++++++++++++-------------------------------
 1 file changed, 30 insertions(+), 71 deletions(-)

(limited to 'compiler/src/Processors.hs')

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
   ) where
 
 
-import Control.Exception (Exception, throwIO)
+import Control.Exception (Exception)
 import Data.Function ((&))
-import Data.Ratio ((%))
 import Data.Char (toLower)
 
 import System.Directory hiding (copyFile)
 import qualified System.Directory
 import System.FilePath
 
-import Codec.Picture
-import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented)
+import System.Process (callProcess)
 
 import Resource
   ( ItemProcessor, ThumbnailProcessor
@@ -47,10 +45,8 @@ data ProcessingException = ProcessingException FilePath String deriving Show
 instance Exception ProcessingException
 
 
-data PictureFileFormat = Bmp | Jpg | Png | Tiff | Hdr | Gif
-
 -- TODO: handle video, music, text...
-data Format = PictureFormat PictureFileFormat | Unknown
+data Format = PictureFormat | Unknown
 
 formatFromPath :: Path -> Format
 formatFromPath =
@@ -60,14 +56,15 @@ formatFromPath =
   . fileName
   where
     fromExt :: String -> Format
-    fromExt ".bmp" = PictureFormat Bmp
-    fromExt ".jpg" = PictureFormat Jpg
-    fromExt ".jpeg" = PictureFormat Jpg
-    fromExt ".png" = PictureFormat Png
-    fromExt ".tiff" = PictureFormat Tiff
-    fromExt ".hdr" = PictureFormat Hdr
-    fromExt ".gif" = PictureFormat Gif
-    fromExt _ = Unknown
+    fromExt ext = case ext of
+      ".bmp" -> PictureFormat
+      ".jpg" -> PictureFormat
+      ".jpeg" -> PictureFormat
+      ".png" -> PictureFormat
+      ".tiff" -> PictureFormat
+      ".hdr" -> PictureFormat
+      ".gif" -> PictureFormat
+      _ -> Unknown
 
 
 type FileProcessor =
@@ -80,47 +77,16 @@ copyFileProcessor inputPath outputPath =
   (putStrLn $ "Copying:\t" ++ outputPath)
   >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath
 
-
-type LossyExportQuality = Int
-type StaticImageReader = FilePath -> IO (Either String DynamicImage)
-type StaticImageWriter = FilePath -> DynamicImage -> IO ()
-
-resizeStaticImageUpTo :: Resolution -> LossyExportQuality -> PictureFileFormat -> FileProcessor
-resizeStaticImageUpTo maxResolution jpegExportQuality pictureFormat =
-  resizerFor pictureFormat
+resizePictureUpTo :: Resolution -> FileProcessor
+resizePictureUpTo maxResolution inputPath outputPath =
+  (putStrLn $ "Generating:\t" ++ outputPath)
+  >> ensureParentDir (flip resize) outputPath inputPath
   where
-    resizerFor :: PictureFileFormat -> FileProcessor
-    resizerFor Bmp = resizer readBitmap saveBmpImage
-    resizerFor Jpg = resizer readJpeg (saveJpgImage jpegExportQuality)
-    resizerFor Png = resizer readPng savePngImage
-    resizerFor Tiff = resizer readTiff saveTiffImage
-    resizerFor Hdr = resizer readHDR saveRadianceImage
-    resizerFor Gif = resizer readGif saveGifImage'
-      where
-        saveGifImage' :: StaticImageWriter
-        saveGifImage' outputPath image =
-          saveGifImage outputPath image
-          & either (throwIO . ProcessingException outputPath) id
-
-    resizer :: StaticImageReader -> StaticImageWriter -> FileProcessor
-    resizer reader writer inputPath outputPath =
-      (putStrLn $ "Generating:\t" ++ outputPath)
-      >>  reader inputPath
-      >>= either (throwIO . ProcessingException inputPath) return
-      >>= return . (fitDynamicImage maxResolution)
-      >>= ensureParentDir writer outputPath
-
-    fitDynamicImage :: Resolution -> DynamicImage -> DynamicImage
-    fitDynamicImage (Resolution boxWidth boxHeight) image =
-      convertRGBA8 image
-      & scaleBilinear targetWidth targetHeight
-      & ImageRGBA8
-      where
-        picWidth = dynamicMap imageWidth image
-        picHeight = dynamicMap imageHeight image
-        resizeRatio = min (boxWidth % picWidth) (boxHeight % picHeight)
-        targetWidth = floor $ resizeRatio * (picWidth % 1)
-        targetHeight = floor $ resizeRatio * (picHeight % 1)
+    maxSize :: Resolution -> String
+    maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">"
+
+    resize :: FileName -> FileName -> IO ()
+    resize input output = callProcess "magick" [input, "-resize", maxSize maxResolution, output]
 
 
 type Cache = FileProcessor -> FileProcessor
@@ -160,8 +126,8 @@ type ItemFileProcessor =
   -> FileName        -- ^ Output class (subdir)
   -> ItemProcessor
 
-itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor
-itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase resClass inputRes =
+itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor
+itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
   cached processor inPath outPath
   >> resourceAt outPath relOutPath
   >>= return . props
@@ -172,14 +138,9 @@ itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase re
     (processor, props) = processorFor maxResolution $ formatFromPath inputRes
 
     processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps)
-    processorFor Nothing _ =
-      (copyFileProcessor, Other)
-    processorFor _ (PictureFormat Gif) =
-      (copyFileProcessor, Picture) -- TODO: handle animated gif resizing
-    processorFor (Just maxRes) (PictureFormat picFormat) =
-      (resizeStaticImageUpTo maxRes jpegExportQuality picFormat, Picture)
-    processorFor _ Unknown =
-      (copyFileProcessor, Other) -- TODO: handle video reencoding and others?
+    processorFor Nothing _ = (copyFileProcessor, Other)
+    processorFor (Just maxRes) PictureFormat = (resizePictureUpTo maxRes, Picture)
+    processorFor _ Unknown = (copyFileProcessor, Other) -- TODO: handle video reencoding and others?
 
 
 type ThumbnailFileProcessor =
@@ -188,8 +149,8 @@ type ThumbnailFileProcessor =
   -> FileName        -- ^ Output class (subdir)
   -> ThumbnailProcessor
 
-thumbnailFileProcessor :: Resolution -> LossyExportQuality -> Cache -> ThumbnailFileProcessor
-thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resClass inputRes =
+thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor
+thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
   cached <$> processorFor (formatFromPath inputRes)
   & process
   where
@@ -205,7 +166,5 @@ thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resC
       >>= return . Just
 
     processorFor :: Format -> Maybe FileProcessor
-    processorFor (PictureFormat picFormat) =
-      Just $ resizeStaticImageUpTo maxRes jpegExportQuality picFormat
-    processorFor _ =
-      Nothing
+    processorFor PictureFormat = Just $ resizePictureUpTo maxRes
+    processorFor _ = Nothing
-- 
cgit v1.2.3


From c8692be41903791764de314c099ead7f078eed20 Mon Sep 17 00:00:00 2001
From: pacien
Date: Wed, 29 Jan 2020 22:17:13 +0100
Subject: compiler: fix picture item type without resize

GitHub: closes #52
---
 compiler/src/Processors.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'compiler/src/Processors.hs')

diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 4e7c5a7..f2ade63 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -138,8 +138,8 @@ itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
     (processor, props) = processorFor maxResolution $ formatFromPath inputRes
 
     processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps)
-    processorFor Nothing _ = (copyFileProcessor, Other)
     processorFor (Just maxRes) PictureFormat = (resizePictureUpTo maxRes, Picture)
+    processorFor Nothing PictureFormat = (copyFileProcessor, Picture)
     processorFor _ Unknown = (copyFileProcessor, Other) -- TODO: handle video reencoding and others?
 
 
-- 
cgit v1.2.3