feat: duotone, linocut, posterize, solarize

Author: paithiov909

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: aznyan
 Title: Image Filters with 'OpenCV'
-Version: 26.01.07
+Version: 26.02.05
 Authors@R: c(
     person("Akiru", "Kato", , "paithiov909@gmail.com", role = c("aut", "cre")),
     person("Jeroen", "Ooms", role = "cph")

NAMESPACE

@@ -36,25 +36,29 @@ export(contrast)
 export(convolve)
 export(detail_enchance)
 export(diffusion_filter)
+export(duotone)
 export(fade_with)
 export(fill_with)
 export(gaussian_blur)
 export(grayscale)
 export(hist_eq)
 export(hls2rgb)
 export(hue_rotate)
+export(invert)
 export(kernel_cone)
 export(kernel_disc)
 export(kernel_emboss)
 export(kernel_motion)
 export(kernel_ring)
 export(kuwahara_filter)
 export(laplacian_filter)
+export(linocut)
 export(mean_shift)
 export(median_blur)
 export(morphology)
 export(oilpaint)
 export(pencil_sketch)
+export(posterize)
 export(premul)
 export(preserve_edge)
 export(read_still)
@@ -66,6 +70,7 @@ export(saturate)
 export(sepia)
 export(set_matte)
 export(sobel_filter)
+export(solarize)
 export(stylize)
 export(swap_channels)
 export(thres)

R/blend.R

@@ -18,6 +18,27 @@ clamp <- function(x, min, max) {
   pmin(pmax(x, min), max)
 }
 
+#' Lerp
+#'
+#' @param x,y numerics
+#' @param mask numeric scalar
+#' @returns numerics
+#' @noRd
+mix <- function(x, y, mask) {
+  mask <- clamp(mask, 0, 1)
+  x * mask + y * (1 - mask)
+}
+
+#' Step
+#'
+#' @param x,y numerics
+#' @param mask numeric scalar
+#' @returns numerics
+#' @noRd
+step <- function(x, mask) {
+  (x > mask) * 1
+}
+
 #' Alpha blending
 #'
 #' @param x1,x2 Alpha values.

R/color-manip.R

@@ -8,21 +8,42 @@ NULL
 
 #' @rdname rgb-hls
 #' @export
-rgb2hls <- function(x) azny_rgb_to_hls(x)
+rgb2hls <- function(x) azny_rgb_to_hls(floor(x))
 
 #' @rdname rgb-hls
 #' @export
-hls2rgb <- function(x) azny_hls_to_rgb(x)
+hls2rgb <- function(x) azny_hls_to_rgb(floor(x))
+
+#' Create a native raster filled with a color
+#'
+#' @param width,height A positive integer scalar.
+#' @param color Color name or hex code.
+#' @returns A `nativeRaster` object.
+#' @export
+fill_with <- function(width, height, color) {
+  packed_int <-
+    grDevices::col2rgb(color[1], alpha = TRUE) |>
+    rlang::as_function(
+      ~ {
+        x <- as.double(.)
+        azny_pack_integers(x[1:3], x[4], 1, 1)
+      }
+    )()
+  out <- rep_len(packed_int, width * height)
+  dim(out) <- c(height, width)
+  as_nr(out)
+}
 
 #' Color manipulation
 #'
 #' @param nr A `nativeRaster` object.
 #' @param intensity A numeric scalar.
-#' @param depth An integer scalar.
-#' @param color A character string; the color to be set.
-#' @param alpha A numeric scalar in range `[0, 1]`.
-#'  The alpha value to be reset for transparency.
+#' @param depth,shades A positive integer scalar.
+#' @param gamma A numeric scalar. The gamma exponent.
 #' @param rad A numeric scalar. The rotation angle in radians.
+#' @param color,color_a,color_b,ink,paper A character string;
+#'  color name or hex code.
+#' @param alpha,threshold A numeric scalar in range `[0, 1]`.
 #' @param max An integer scalar. The maximum value of the color code.
 #' @returns A `nativeRaster` object.
 #' @rdname color-manip
@@ -31,33 +52,41 @@ NULL
 
 #' @rdname color-manip
 #' @export
-unpremul <- function(nr, max = 255L) {
+brighten <- function(nr, intensity) {
   sz <- dim(nr)
   ret <- nr_to_rgba(nr, "nr")
-  rgb <- ret[1:3, ] / (ret[4, ] / max)
+  rgb <- clamp(ret[1:3, ] * (1 + intensity), 0, 255)
   as_nr(azny_pack_integers(rgb, ret[4, ] * 1, sz[1], sz[2]))
 }
 
 #' @rdname color-manip
 #' @export
-set_matte <- function(nr, color = "green") {
-  rgb_int <-
-    grDevices::col2rgb(color[1], alpha = FALSE)
+contrast <- function(nr, intensity) {
   sz <- dim(nr)
   ret <- nr_to_rgba(nr, "nr")
-  ret[1, ][ret[4, ] != 255] <- rgb_int[1, ] * 1
-  ret[2, ][ret[4, ] != 255] <- rgb_int[2, ] * 1
-  ret[3, ][ret[4, ] != 255] <- rgb_int[3, ] * 1
-  as_nr(azny_pack_integers(ret[1:3, ], ret[4, ], sz[1], sz[2]))
+  rgb <- clamp((ret[1:3, ] / 255 - 0.5) * (1 + intensity) + 0.5, 0, 1) * 255
+  as_nr(azny_pack_integers(rgb, ret[4, ] * 1, sz[1], sz[2]))
 }
 
 #' @rdname color-manip
 #' @export
-reset_alpha <- function(nr, alpha = 1) {
+duotone <- function(nr, color_a = "yellow", color_b = "navy", gamma = 2.2) {
   sz <- dim(nr)
+  color_a <- fill_with(sz[1], sz[2], color_a) |> nr_to_rgba("color_a")
+  color_b <- fill_with(sz[1], sz[2], color_b) |> nr_to_rgba("color_b")
   ret <- nr_to_rgba(nr, "nr")
-  ret[4, ] <- clamp(alpha * 255, 0, 255)
-  as_nr(azny_pack_integers(ret[1:3, ], ret[4, ], sz[1], sz[2]))
+  luminance <- clamp(gray(ret[1:3, ])^(1 / gamma), 0, 1)
+  rgb <- mix(color_a[1:3, ], color_b[1:3, ], luminance)
+  as_nr(azny_pack_integers(rgb, ret[4, ] * 1, sz[1], sz[2]))
+}
+
+#' @rdname color-manip
+#' @export
+grayscale <- function(nr) {
+  sz <- dim(nr)
+  ret <- nr_to_rgba(nr, "nr")
+  rgb <- t(colSums(ret[1:3, ]) / 3) %x% c(1, 1, 1)
+  as_nr(azny_pack_integers(rgb, ret[4, ] * 1, sz[1], sz[2]))
 }
 
 #' @rdname color-manip
@@ -92,22 +121,43 @@ hue_rotate <- function(nr, rad) {
 
 #' @rdname color-manip
 #' @export
-contrast <- function(nr, intensity) {
+invert <- function(nr) {
   sz <- dim(nr)
   ret <- nr_to_rgba(nr, "nr")
-  rgb <- clamp((ret[1:3, ] / 255 - 0.5) * (1 + intensity) + 0.5, 0, 1) * 255
+  rgb <- 255 - ret[1:3, ]
   as_nr(azny_pack_integers(rgb, ret[4, ] * 1, sz[1], sz[2]))
 }
 
 #' @rdname color-manip
 #' @export
-brighten <- function(nr, intensity) {
+linocut <- function(nr, ink = "navy", paper = "snow", threshold = 0.4) {
   sz <- dim(nr)
+  ink <- fill_with(sz[1], sz[2], ink) |> nr_to_rgba("ink")
+  paper <- fill_with(sz[1], sz[2], paper) |> nr_to_rgba("paper")
   ret <- nr_to_rgba(nr, "nr")
-  rgb <- clamp(ret[1:3, ] * (1 + intensity), 0, 255)
+  luminance <- step(gray(ret[1:3, ]), threshold)
+  rgb <- mix(paper[1:3, ], ink[1:3, ], luminance)
   as_nr(azny_pack_integers(rgb, ret[4, ] * 1, sz[1], sz[2]))
 }
 
+#' @rdname color-manip
+#' @export
+posterize <- function(nr, shades = 4) {
+  sz <- dim(nr)
+  ret <- nr_to_rgba(nr, "nr")
+  rgb <- floor(ret[1:3, ] / 255 * shades) / as.integer(shades - 1)
+  as_nr(azny_pack_integers(rgb * 255, ret[4, ] * 1, sz[1], sz[2]))
+}
+
+#' @rdname color-manip
+#' @export
+reset_alpha <- function(nr, alpha = 1) {
+  sz <- dim(nr)
+  ret <- nr_to_rgba(nr, "nr")
+  ret[4, ] <- clamp(alpha * 255, 0, 255)
+  as_nr(azny_pack_integers(ret[1:3, ], ret[4, ], sz[1], sz[2]))
+}
+
 #' @rdname color-manip
 #' @export
 saturate <- function(nr, intensity) {
@@ -123,16 +173,7 @@ saturate <- function(nr, intensity) {
 
 #' @rdname color-manip
 #' @export
-grayscale <- function(nr) {
-  sz <- dim(nr)
-  ret <- nr_to_rgba(nr, "nr")
-  rgb <- t(colSums(ret[1:3, ]) / 3) %x% c(1, 1, 1)
-  as_nr(azny_pack_integers(rgb, ret[4, ] * 1, sz[1], sz[2]))
-}
-
-#' @rdname color-manip
-#' @export
-sepia <- function(nr, intensity = 1, depth = 20) {
+sepia <- function(nr, intensity, depth = 20) {
   sz <- dim(nr)
   ret <- nr_to_rgba(nr, "nr")
   rgb <- rbind(
@@ -145,22 +186,34 @@ sepia <- function(nr, intensity = 1, depth = 20) {
   as_nr(azny_pack_integers(rgb, ret[4, ] * 1, sz[1], sz[2]))
 }
 
-#' Create a native raster filled with a color
-#'
-#' @param width,height A positive integer scalar.
-#' @param color Color name or hex code.
-#' @returns A `nativeRaster` object.
+#' @rdname color-manip
 #' @export
-fill_with <- function(width, height, color) {
-  packed_int <-
-    grDevices::col2rgb(color[1], alpha = TRUE) |>
-    rlang::as_function(
-      ~ {
-        x <- as.double(.)
-        azny_pack_integers(x[1:3], x[4], 1, 1)
-      }
-    )()
-  out <- rep(packed_int, width * height)
-  dim(out) <- c(height, width)
-  as_nr(out)
+set_matte <- function(nr, color = "green") {
+  rgb_int <-
+    grDevices::col2rgb(color[1], alpha = FALSE)
+  sz <- dim(nr)
+  ret <- nr_to_rgba(nr, "nr")
+  ret[1, ][ret[4, ] != 255] <- rgb_int[1, ] * 1
+  ret[2, ][ret[4, ] != 255] <- rgb_int[2, ] * 1
+  ret[3, ][ret[4, ] != 255] <- rgb_int[3, ] * 1
+  as_nr(azny_pack_integers(ret[1:3, ], ret[4, ], sz[1], sz[2]))
+}
+
+#' @rdname color-manip
+#' @export
+solarize <- function(nr, threshold = 0.5) {
+  sz <- dim(nr)
+  ret <- nr_to_rgba(nr, "nr")
+  intensity <- colSums(ret[1:3, ] / 255) / 3
+  rgb <- ifelse(intensity > threshold, 255 - ret[1:3, ], ret[1:3, ])
+  as_nr(azny_pack_integers(rgb, ret[4, ] * 1, sz[1], sz[2]))
+}
+
+#' @rdname color-manip
+#' @export
+unpremul <- function(nr, max = 255L) {
+  sz <- dim(nr)
+  ret <- nr_to_rgba(nr, "nr")
+  rgb <- ret[1:3, ] / (ret[4, ] / max)
+  as_nr(azny_pack_integers(rgb, ret[4, ] * 1, sz[1], sz[2]))
 }

README.md

@@ -22,9 +22,9 @@ their first argument and return a `nativeRaster` after applying the
 effect. All these functions return a new `nativeRaster` and do not
 modify the input object in place.
 
-A `nativeRaster` is a built-in datatype in R that stores image data as an
-integer matrix. There are several common ways to obtain a `nativeRaster`
-object:
+A `nativeRaster` is a built-in datatype in R that stores image data as
+an integer matrix. There are several common ways to obtain a
+`nativeRaster` object:
 
 - Generate or manipulate a `nativeRaster` using
   [nara](https://github.com/coolbutuseless/nara)