close rstudio/blogdown#614: add a function shrink_images() to shrink …

…(and optionally compress) images under a directory

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: xfun
 Type: Package
 Title: Supporting Functions for Packages Maintained by 'Yihui Xie'
-Version: 0.31.4
+Version: 0.31.5
 Authors@R: c(
   person("Yihui", "Xie", role = c("aut", "cre", "cph"), email = "xie@yihui.name", comment = c(ORCID = "0000-0003-0645-5666")),
   person("Wush", "Wu", role = "ctb"),
@@ -29,6 +29,7 @@ Suggests:
     renv,
     curl,
     jsonlite,
+    magick,
     rmarkdown
 License: MIT + file LICENSE
 URL: https://github.com/yihui/xfun

NAMESPACE

@@ -100,6 +100,7 @@ export(same_path)
 export(sans_ext)
 export(session_info)
 export(set_envvar)
+export(shrink_images)
 export(sort_file)
 export(split_lines)
 export(split_source)
@@ -109,6 +110,7 @@ export(strings_please)
 export(submit_cran)
 export(system3)
 export(tinify)
+export(tinify_dir)
 export(tojson)
 export(tree)
 export(try_error)

NEWS.md

@@ -1,5 +1,9 @@
 # CHANGES IN xfun VERSION 0.32
 
+- Added a function `shrink_images()` to shrink images to a maximum width using the **magick** package (thanks, @apreshill, rstudio/blogdown#614).
+
+- Added a function `tinify_dir()` as a wrapper of `tinify()` to compress images under a directory.
+
 - `file_ext()` supports more file extensions now, such as `.c++`, `.FB2K-COMPONENT`, and so on (thanks, @tentacles-from-outer-space, #68).
 
 - Fixed the issue that `xfun::base_pkgs()` could hang R (thanks, @mmaechler, #66).

R/image.R

@@ -13,8 +13,9 @@ add_border = function(input, pixels = 1, color = 'black', output) {
 #' Use the Tinify API to compress PNG and JPEG images
 #'
 #' Compress PNG/JPEG images with \samp{api.tinify.com}, and download the
-#' compressed images. This function requires R packages \pkg{curl} and
-#' \pkg{jsonlite}.
+#' compressed images. These functions require R packages \pkg{curl} and
+#' \pkg{jsonlite}. \code{tinify_dir()} is a wrapper function of \code{tinify()}
+#' to compress images under a directory.
 #'
 #' You are recommended to set the API key in \file{.Rprofile} or
 #' \file{.Renviron}. After that, the only required argument of this function is
@@ -52,7 +53,7 @@ add_border = function(input, pixels = 1, color = 'black', output) {
 #'   \code{xfun::tinify()} has only implemented the feature of shrinking images.
 #' @export
 #' @examplesIf interactive()
-#' f = file.path(R.home('doc'), 'html', 'logo.jpg')
+#' f = xfun:::R_logo('jpg$')
 #' xfun::tinify(f)  # remember to set the API key before trying this
 tinify = function(
   input, output, quiet = FALSE, force = FALSE,
@@ -62,6 +63,7 @@ tinify = function(
   if (!(is.character(key) && length(key) == 1 && key != '')) stop(
     "The value of the 'key' argument must be a single non-empty character string."
   )
+  if (length(input) == 0) return(invisible(input))
   if (any(i <- !file_exists(input))) stop(
     'Input file(s) not found: ', paste(input[i], collapse = ', ')
   )
@@ -73,7 +75,8 @@ tinify = function(
 
   # avoid optimizing the input image if its md5 checksum exists in history
   save_history = function(file) {
-    if (!is.character(history)) return()
+    if (!is.character(history) || history == '') return()
+    dir_create(dirname(history))
     cat(paste0(tools::md5sum(file), '\n'), file = history, append = TRUE)
   }
   test_history = function(file) {
@@ -116,3 +119,44 @@ tinify = function(
 
   invisible(output)
 }
+
+#' @param dir A directory under which all \file{.png} and \file{.jpeg} files are
+#'   to be compressed.
+#' @param ... Arguments passed to \code{\link{tinify}()}.
+#' @rdname tinify
+#' @export
+tinify_dir = function(dir = '.', ...) {
+  tinify(all_files('[.](png|jpe?g)$', dir), ...)
+}
+
+#' Shrink images to a maximum width
+#'
+#' Use \code{\link[magick:image_resize]{magick::image_resize}()} to shrink an
+#' image if its width is larger than the value specified by the argument
+#' \code{width}, and optionally call \code{\link{tinify}()} to compress it.
+#' @param width The desired maximum width of images.
+#' @param dir The directory of images.
+#' @param files A vector of image file paths. By default, this is all \file{png}
+#'   and \file{jpeg} images under \code{dir}.
+#' @param tinify Whether to compress images using \code{\link{tinify}()}.
+#' @export
+#' @examples
+#' f = xfun:::R_logo(all = TRUE)
+#' file.copy(f, tempdir())
+#' f = file.path(tempdir(), basename(f))
+#' magick::image_info(magick::image_read(f))  # width: 724 (svg) and 100 (jpg)
+#' xfun::shrink_images(300, files = f)
+#' magick::image_info(magick::image_read(f))  # width: 300 and 100
+#' file.remove(f)
+shrink_images = function(
+  width = 800, dir = '.', files = all_files('[.](png|jpe?g)$', dir),
+  tinify = FALSE
+) {
+  for (f in files) {
+    x = magick::image_read(f)
+    if (magick::image_info(x)$width <= width) next
+    x = magick::image_resize(x, sprintf('%dx', width))
+    magick::image_write(x, f)
+  }
+  if (tinify) tinify(files, identity)
+}