feat: apply_lut1d

Author: paithiov909

DESCRIPTION

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

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(adpthres)
+export(apply_lut1d)
 export(as_recordedplot)
 export(aznyan_num_threads)
 export(bilateral_filter)
@@ -60,9 +61,9 @@ export(mean_shift)
 export(median_blur)
 export(morphology)
 export(oilpaint)
+export(pack_color)
 export(pencil_sketch)
 export(posterize)
-export(premul)
 export(preserve_edge)
 export(read_still)
 export(resample)
@@ -79,6 +80,7 @@ export(stylize)
 export(swap_channels)
 export(thres)
 export(tile_matrix)
+export(unpack_color)
 export(unpremul)
 export(write_animation)
 export(write_still)

R/aznyan-package.R

@@ -57,20 +57,6 @@ cast_nr <- function(nr, nm = "nr") {
   as.integer(nr)
 }
 
-#' Cast native raster into 4*(w*h)-dimensional integer matrix
-#'
-#' @param nr A `nativeRaster` object.
-#' @param nm Name of `nr`
-#' @returns integer matrix
-#' @noRd
-nr_to_rgba <- function(nr, nm) {
-  if (missing(nm)) {
-    nm <- deparse1(substitute(nr))
-  }
-  cast_nr(nr, nm) |>
-    azny_unpack_integers()
-}
-
 #' Check if two nativeRaster objects have the same dimensions
 #'
 #' @noRd
@@ -119,24 +105,3 @@ int_match <- function(x, arg, values) {
 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
-}

R/color-filters.R

@@ -1,14 +1,3 @@
-#' Create color codes while premultiplying alpha
-#'
-#' @param r,g,b,a Numeric vectors.
-#' @param max An integer scalar. The maximum value of the color code.
-#' @returns Color codes.
-#' @export
-premul <- function(r, g, b, a, max = 255L) {
-  alpha <- a / max
-  grDevices::rgb(r * alpha, g * alpha, b * alpha, a, maxColorValue = max)
-}
-
 #' Apply predefined color filter
 #'
 #' Applies one of the predefined color filters
@@ -103,5 +92,5 @@ color_filter <- function(
     )
   ) -
     1L
-  as_nr(azny_color_filter(nr, nrow(nr), ncol(nr), filter_id))
+  as_nr(azny_color_filter(cast_nr(nr), nrow(nr), ncol(nr), filter_id))
 }

R/color-manip.R

@@ -1,34 +1,7 @@
-#' Conversion between RGB and HLS color spaces
-#'
-#' @param x An integer matrix with 3 rows.
-#' @returns An integer matrix of the same size as `x`
-#' @rdname rgb-hls
-#' @name rgb-hls
-NULL
-
-#' @rdname rgb-hls
-#' @export
-rgb2hls <- function(x) azny_rgb_to_hls(floor(x))
-
-#' @rdname rgb-hls
-#' @export
-hls2rgb <- function(x) azny_hls_to_rgb(floor(x))
-
-#' Create a native raster filled with a color
-#'
-#' @param color Color name or hex code.
-#' @param width,height A positive integer scalar.
-#' @returns A `nativeRaster` object.
-#' @export
-fill_with <- function(color, width, height) {
-  packed_int <- colorfast::col_to_int(color[1])
-  out <- matrix(packed_int, nrow = height, ncol = width)
-  as_nr(out)
-}
-
 #' Color manipulation
 #'
 #' @param nr A `nativeRaster` object.
+#' @param lut A 256x3 double matrix in range `[0, 255]`.
 #' @param intensity A numeric scalar.
 #' @param depth,shades A positive integer scalar.
 #' @param gamma A numeric scalar. The gamma exponent.
@@ -42,16 +15,25 @@ fill_with <- function(color, width, height) {
 #' @name color-manip
 NULL
 
+#' @rdname color-manip
+#' @export
+apply_lut1d <- function(nr, lut) {
+  if (!all(is.finite(lut)) || !all(lut >= 0) || !all(lut <= 255)) {
+    cli::cli_abort("`lut` must be a double matrix in range [0, 255].")
+  }
+  as_nr(azny_lut1d(cast_nr(nr), nrow(nr), ncol(nr), lut))
+}
+
 #' @rdname color-manip
 #' @export
 brighten <- function(nr, intensity) {
-  as_nr(azny_brighten(nr, nrow(nr), ncol(nr), intensity))
+  as_nr(azny_brighten(cast_nr(nr), nrow(nr), ncol(nr), intensity))
 }
 
 #' @rdname color-manip
 #' @export
 contrast <- function(nr, intensity) {
-  as_nr(azny_contrast(nr, nrow(nr), ncol(nr), intensity))
+  as_nr(azny_contrast(cast_nr(nr), nrow(nr), ncol(nr), intensity))
 }
 
 #' @rdname color-manip
@@ -61,7 +43,7 @@ duotone <- function(nr, color_a = "yellow", color_b = "navy", gamma = 2.2) {
   color_b <- colorfast::col_to_rgb(color_b[1])
   as_nr(
     azny_duotone(
-      nr,
+      cast_nr(nr),
       nrow(nr),
       ncol(nr),
       as.integer(color_a[, 1]),
@@ -74,19 +56,19 @@ duotone <- function(nr, color_a = "yellow", color_b = "navy", gamma = 2.2) {
 #' @rdname color-manip
 #' @export
 grayscale <- function(nr) {
-  as_nr(azny_grayscale(nr, nrow(nr), ncol(nr)))
+  as_nr(azny_grayscale(cast_nr(nr), nrow(nr), ncol(nr)))
 }
 
 #' @rdname color-manip
 #' @export
 hue_rotate <- function(nr, rad) {
-  as_nr(azny_hue_rotate(nr, nrow(nr), ncol(nr), rad))
+  as_nr(azny_hue_rotate(cast_nr(nr), nrow(nr), ncol(nr), rad))
 }
 
 #' @rdname color-manip
 #' @export
 invert <- function(nr) {
-  as_nr(azny_invert(nr, nrow(nr), ncol(nr)))
+  as_nr(azny_invert(cast_nr(nr), nrow(nr), ncol(nr)))
 }
 
 #' @rdname color-manip
@@ -96,7 +78,7 @@ linocut <- function(nr, ink = "navy", paper = "snow", threshold = 0.4) {
   paper <- colorfast::col_to_rgb(paper[1])
   as_nr(
     azny_linocut(
-      nr,
+      cast_nr(nr),
       nrow(nr),
       ncol(nr),
       as.integer(ink[, 1]),
@@ -109,25 +91,25 @@ linocut <- function(nr, ink = "navy", paper = "snow", threshold = 0.4) {
 #' @rdname color-manip
 #' @export
 posterize <- function(nr, shades = 4) {
-  as_nr(azny_posterize(nr, nrow(nr), ncol(nr), shades))
+  as_nr(azny_posterize(cast_nr(nr), nrow(nr), ncol(nr), shades))
 }
 
 #' @rdname color-manip
 #' @export
 reset_alpha <- function(nr, alpha = 1) {
-  as_nr(azny_reset_alpha(nr, nrow(nr), ncol(nr), alpha))
+  as_nr(azny_reset_alpha(cast_nr(nr), nrow(nr), ncol(nr), alpha))
 }
 
 #' @rdname color-manip
 #' @export
 saturate <- function(nr, intensity) {
-  as_nr(azny_saturate(nr, nrow(nr), ncol(nr), intensity))
+  as_nr(azny_saturate(cast_nr(nr), nrow(nr), ncol(nr), intensity))
 }
 
 #' @rdname color-manip
 #' @export
 sepia <- function(nr, intensity, depth = 20) {
-  as_nr(azny_sepia(nr, nrow(nr), ncol(nr), intensity, depth))
+  as_nr(azny_sepia(cast_nr(nr), nrow(nr), ncol(nr), intensity, depth))
 }
 
 #' @rdname color-manip
@@ -136,7 +118,7 @@ set_matte <- function(nr, color = "green") {
   rgb_int <- colorfast::col_to_rgb(color[1])
   as_nr(
     azny_set_matte(
-      nr,
+      cast_nr(nr),
       nrow(nr),
       ncol(nr),
       as.integer(rgb_int[, 1])
@@ -147,11 +129,11 @@ set_matte <- function(nr, color = "green") {
 #' @rdname color-manip
 #' @export
 solarize <- function(nr, threshold = 0.5) {
-  as_nr(azny_solarize(nr, nrow(nr), ncol(nr), threshold))
+  as_nr(azny_solarize(cast_nr(nr), nrow(nr), ncol(nr), threshold))
 }
 
 #' @rdname color-manip
 #' @export
 unpremul <- function(nr, max = 255L) {
-  as_nr(azny_unpremul(nr, nrow(nr), ncol(nr), max))
+  as_nr(azny_unpremul(cast_nr(nr), nrow(nr), ncol(nr), max))
 }

R/cpp11.R

@@ -124,6 +124,10 @@ azny_brighten <- function(nr, height, width, intensity) {
   .Call(`_aznyan_azny_brighten`, nr, height, width, intensity)
 }
 
+azny_color_map <- function(nr, height, width, mode, hsvmode, invmode) {
+  .Call(`_aznyan_azny_color_map`, nr, height, width, mode, hsvmode, invmode)
+}
+
 azny_contrast <- function(nr, height, width, intensity) {
   .Call(`_aznyan_azny_contrast`, nr, height, width, intensity)
 }
@@ -148,6 +152,10 @@ azny_linocut <- function(nr, height, width, ink, paper, threshold) {
   .Call(`_aznyan_azny_linocut`, nr, height, width, ink, paper, threshold)
 }
 
+azny_lut1d <- function(nr, height, width, lut_mat) {
+  .Call(`_aznyan_azny_lut1d`, nr, height, width, lut_mat)
+}
+
 azny_posterize <- function(nr, height, width, shades) {
   .Call(`_aznyan_azny_posterize`, nr, height, width, shades)
 }
@@ -176,30 +184,6 @@ azny_unpremul <- function(nr, height, width, max) {
   .Call(`_aznyan_azny_unpremul`, nr, height, width, max)
 }
 
-azny_saturate_value <- function(in_vec, val) {
-  .Call(`_aznyan_azny_saturate_value`, in_vec, val)
-}
-
-azny_pack_integers <- function(rgb, a, height, width) {
-  .Call(`_aznyan_azny_pack_integers`, rgb, a, height, width)
-}
-
-azny_unpack_integers <- function(nr) {
-  .Call(`_aznyan_azny_unpack_integers`, nr)
-}
-
-azny_rgb_to_hls <- function(rgb) {
-  .Call(`_aznyan_azny_rgb_to_hls`, rgb)
-}
-
-azny_hls_to_rgb <- function(hls) {
-  .Call(`_aznyan_azny_hls_to_rgb`, hls)
-}
-
-azny_color_map <- function(nr, height, width, mode, hsvmode, invmode) {
-  .Call(`_aznyan_azny_color_map`, nr, height, width, mode, hsvmode, invmode)
-}
-
 azny_diffusion <- function(nr, height, width, iter, decay_factor, decay_offset, gamma, sigma) {
   .Call(`_aznyan_azny_diffusion`, nr, height, width, iter, decay_factor, decay_offset, gamma, sigma)
 }
@@ -244,6 +228,22 @@ azny_lineweave <- function(nr, height, width, omega, phase, dist1, dist2, dist3,
   .Call(`_aznyan_azny_lineweave`, nr, height, width, omega, phase, dist1, dist2, dist3, invert, direction, fg, bg)
 }
 
+azny_pack_integers <- function(rgb, a, height, width) {
+  .Call(`_aznyan_azny_pack_integers`, rgb, a, height, width)
+}
+
+azny_unpack_integers <- function(nr) {
+  .Call(`_aznyan_azny_unpack_integers`, nr)
+}
+
+azny_rgb_to_hls <- function(rgb) {
+  .Call(`_aznyan_azny_rgb_to_hls`, rgb)
+}
+
+azny_hls_to_rgb <- function(hls) {
+  .Call(`_aznyan_azny_hls_to_rgb`, hls)
+}
+
 azny_swap_channels <- function(nr, height, width, mapping) {
   .Call(`_aznyan_azny_swap_channels`, nr, height, width, mapping)
 }

R/fade.R

@@ -1,3 +1,17 @@
+#' Cast native raster into 4*(w*h)-dimensional integer matrix
+#'
+#' @param nr A `nativeRaster` object.
+#' @param nm Name of `nr`.
+#' @returns An integer matrix.
+#' @noRd
+nr_to_rgba <- function(nr, nm) {
+  if (missing(nm)) {
+    nm <- deparse1(substitute(nr))
+  }
+  cast_nr(nr, nm) |>
+    azny_unpack_integers()
+}
+
 #' Fade pixels based on a mask image
 #'
 #' @description