refactor: refactor 'fill_with'

Author: paithiov909

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: aznyan
 Title: Image Filters with 'OpenCV'
-Version: 26.02.05
+Version: 26.02.09
 Authors@R: c(
     person("Akiru", "Kato", , "paithiov909@gmail.com", role = c("aut", "cre")),
     person("Jeroen", "Ooms", role = "cph")
@@ -16,6 +16,7 @@ Depends:
     R (>= 4.2)
 Imports:
     cli,
+    colorfast,
     grDevices,
     grid,
     rlang

R/aznyan-package.R

@@ -77,7 +77,7 @@ check_nr_dim <- function(src, dst) {
 #' @param x Object to be set class.
 #' @noRd
 as_nr <- function(x) {
-  class(x) <- c("nativeRaster", class(x))
+  class(x) <- "nativeRaster"
   x
 }
 

R/color-filters.R

@@ -108,7 +108,7 @@ apply_1977 <- function(nr) {
     contrast(nr, .1) |>
     brighten(.1) |>
     saturate(.3)
-  fg <- fill_with(ncol(nr), nrow(nr), premul(243, 106, 188, 76))
+  fg <- fill_with(premul(243, 106, 188, 76), ncol(nr), nrow(nr))
   blend_screen(bg, fg) # bg, fg
 }
 
@@ -125,7 +125,7 @@ apply_aden <- function(nr) {
 apply_brannan <- function(nr) {
   bg <- sepia(nr, .2) |>
     contrast(.2)
-  fg <- fill_with(ncol(nr), nrow(nr), premul(161, 44, 199, 59))
+  fg <- fill_with(premul(161, 44, 199, 59), ncol(nr), nrow(nr))
   blend_lighten(fg, bg)
 }
 
@@ -134,23 +134,23 @@ apply_brooklyn <- function(nr) {
   bg <- contrast(nr, -.1) |>
     brighten(.1) |>
     reset_alpha()
-  fg <- fill_with(ncol(nr), nrow(nr), premul(168, 223, 193, 150))
+  fg <- fill_with(premul(168, 223, 193, 150), ncol(nr), nrow(nr))
   blend_overlay(fg, bg)
 }
 
 #' @noRd
 apply_clarendon <- function(nr) {
   bg <- contrast(nr, .2) |>
     saturate(.35)
-  fg <- fill_with(ncol(nr), nrow(nr), premul(127, 187, 227, 101))
+  fg <- fill_with(premul(127, 187, 227, 101), ncol(nr), nrow(nr))
   blend_overlay(fg, bg)
 }
 
 #' @noRd
 apply_earlybird <- function(nr) {
   bg <- contrast(nr, -.1) |>
     sepia(.05)
-  fg <- fill_with(ncol(nr), nrow(nr), premul(208, 186, 142, 150))
+  fg <- fill_with(premul(208, 186, 142, 150), ncol(nr), nrow(nr))
   out <- blend_overlay(bg, fg) # bg, fg
   reset_alpha(out)
 }
@@ -159,7 +159,7 @@ apply_earlybird <- function(nr) {
 apply_gingham <- function(nr) {
   bg <- brighten(nr, .05) |>
     hue_rotate(-.1745329) # -10 deg
-  fg <- fill_with(ncol(nr), nrow(nr), premul(230, 230, 230, 255))
+  fg <- fill_with(premul(230, 230, 230, 255), ncol(nr), nrow(nr))
   blend_softlight(fg, bg)
 }
 
@@ -168,7 +168,7 @@ apply_hudson <- function(nr) {
   bg <- brighten(nr, .5) |>
     contrast(-.1) |>
     saturate(.1)
-  fg <- fill_with(ncol(nr), nrow(nr), premul(166, 177, 255, 208))
+  fg <- fill_with(premul(166, 177, 255, 208), ncol(nr), nrow(nr))
   out <- blend_multiply(fg, bg)
   reset_alpha(out)
 }
@@ -186,19 +186,19 @@ apply_kelvin <- function(nr) {
   bg <-
     blend_colordodge(
       nr,
-      fill_with(ncol(nr), nrow(nr), premul(56, 44, 52, 255))
+      fill_with(premul(56, 44, 52, 255), ncol(nr), nrow(nr))
     )
-  fg <- fill_with(ncol(nr), nrow(nr), premul(183, 125, 33, 255))
+  fg <- fill_with(premul(183, 125, 33, 255), ncol(nr), nrow(nr))
   blend_overlay(fg, bg)
 }
 
 #' @noRd
 apply_lark <- function(nr) {
   bg <- contrast(nr, -.1) |>
     blend_colordodge(
-      fill_with(ncol(nr), nrow(nr), premul(34, 37, 63, 255))
+      fill_with(premul(34, 37, 63, 255), ncol(nr), nrow(nr))
     )
-  fg <- fill_with(ncol(nr), nrow(nr), premul(242, 242, 242, 204))
+  fg <- fill_with(premul(242, 242, 242, 204), ncol(nr), nrow(nr))
   blend_darken(fg, bg)
 }
 
@@ -222,7 +222,7 @@ apply_maven <- function(nr) {
 apply_mayfair <- function(nr) {
   bg <- contrast(nr, .1) |>
     saturate(.1)
-  fg <- fill_with(ncol(nr), nrow(nr), premul(255, 200, 200, 153))
+  fg <- fill_with(premul(255, 200, 200, 153), ncol(nr), nrow(nr))
   blend_overlay(fg, bg)
 }
 
@@ -231,10 +231,10 @@ apply_moon <- function(nr) {
   bg <- contrast(nr, .1) |>
     brighten(.1) |>
     blend_softlight(
-      fill_with(ncol(nr), nrow(nr), premul(160, 160, 160, 255)),
+      fill_with(premul(160, 160, 160, 255), ncol(nr), nrow(nr)),
       dst = _
     )
-  fg <- fill_with(ncol(nr), nrow(nr), premul(56, 56, 56, 255))
+  fg <- fill_with(premul(56, 56, 56, 255), ncol(nr), nrow(nr))
   out <- blend_lighten(fg, bg)
   grayscale(out)
 }
@@ -246,10 +246,10 @@ apply_nashville <- function(nr) {
     brighten(.05) |>
     saturate(.2) |>
     blend_darken(
-      fill_with(ncol(nr), nrow(nr), premul(247, 176, 153, 243)),
+      fill_with(premul(247, 176, 153, 243), ncol(nr), nrow(nr)),
       dst = _
     )
-  fg <- fill_with(ncol(nr), nrow(nr), premul(0, 70, 150, 230))
+  fg <- fill_with(premul(0, 70, 150, 230), ncol(nr), nrow(nr))
   blend_lighten(fg, bg)
 }
 
@@ -259,7 +259,7 @@ apply_reyes <- function(nr) {
     brighten(.1) |>
     contrast(-.15) |>
     saturate(-.25)
-  fg <- fill_with(ncol(nr), nrow(nr), premul(239, 205, 173, 10))
+  fg <- fill_with(premul(239, 205, 173, 10), ncol(nr), nrow(nr))
   blend_over(fg, bg)
 }
 
@@ -269,9 +269,9 @@ apply_rise <- function(nr) {
     sepia(.05) |>
     contrast(-.1) |>
     saturate(-.1)
-  fg <- fill_with(ncol(nr), nrow(nr), premul(236, 205, 169, 240))
+  fg <- fill_with(premul(236, 205, 169, 240), ncol(nr), nrow(nr))
   bg <- blend_multiply(fg, bg)
-  fg <- fill_with(ncol(nr), nrow(nr), premul(232, 197, 152, 10))
+  fg <- fill_with(premul(232, 197, 152, 10), ncol(nr), nrow(nr))
   fg <- blend_overlay(fg, bg)
   blend_over(fg, nr)
 }
@@ -280,9 +280,9 @@ apply_rise <- function(nr) {
 apply_slumber <- function(nr) {
   bg <- saturate(nr, -.34) |>
     brighten(-.05)
-  fg <- fill_with(ncol(nr), nrow(nr), premul(69, 41, 12, 102))
+  fg <- fill_with(premul(69, 41, 12, 102), ncol(nr), nrow(nr))
   bg <- blend_lighten(fg, bg)
-  fg <- fill_with(ncol(nr), nrow(nr), premul(125, 105, 24, 128))
+  fg <- fill_with(premul(125, 105, 24, 128), ncol(nr), nrow(nr))
   blend_softlight(fg, bg)
 }
 
@@ -291,15 +291,15 @@ apply_stinson <- function(nr) {
   bg <- contrast(nr, -.25) |>
     saturate(-.15) |>
     brighten(.15)
-  fg <- fill_with(ncol(nr), nrow(nr), premul(240, 149, 128, 51))
+  fg <- fill_with(premul(240, 149, 128, 51), ncol(nr), nrow(nr))
   blend_softlight(fg, bg)
 }
 
 #' @noRd
 apply_toaster <- function(nr) {
   bg <- contrast(nr, .2) |>
     brighten(-.1)
-  fg <- fill_with(ncol(nr), nrow(nr), premul(128, 78, 15, 140))
+  fg <- fill_with(premul(128, 78, 15, 140), ncol(nr), nrow(nr))
   blend_screen(fg, bg)
 }
 
@@ -308,7 +308,7 @@ apply_valencia <- function(nr) {
   bg <- contrast(nr, .08) |>
     brighten(.08) |>
     sepia(.08)
-  fg <- fill_with(ncol(nr), nrow(nr), premul(58, 3, 57, 128))
+  fg <- fill_with(premul(58, 3, 57, 128), ncol(nr), nrow(nr))
   blend_exclusion(fg, bg)
 }
 
@@ -318,6 +318,6 @@ apply_walden <- function(nr) {
     hue_rotate(-.1745329) |> # -10 deg
     saturate(.6) |>
     sepia(.05)
-  fg <- fill_with(ncol(nr), nrow(nr), premul(0, 88, 244, 77))
+  fg <- fill_with(premul(0, 88, 244, 77), ncol(nr), nrow(nr))
   blend_screen(fg, bg)
 }

R/color-manip.R

@@ -16,21 +16,13 @@ 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.
+#' @param width,height A positive integer scalar.
 #' @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)
+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)
 }
 
@@ -72,8 +64,8 @@ contrast <- function(nr, intensity) {
 #' @export
 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")
+  color_a <- fill_with(color_a, sz[1], sz[2]) |> nr_to_rgba("color_a")
+  color_b <- fill_with(color_b, sz[1], sz[2]) |> nr_to_rgba("color_b")
   ret <- nr_to_rgba(nr, "nr")
   luminance <- clamp(gray(ret[1:3, ])^(1 / gamma), 0, 1)
   rgb <- mix(color_a[1:3, ], color_b[1:3, ], luminance)
@@ -132,8 +124,8 @@ invert <- function(nr) {
 #' @export
 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")
+  ink <- fill_with(ink, sz[1], sz[2]) |> nr_to_rgba("ink")
+  paper <- fill_with(paper, sz[1], sz[2]) |> nr_to_rgba("paper")
   ret <- nr_to_rgba(nr, "nr")
   luminance <- step(gray(ret[1:3, ]), threshold)
   rgb <- mix(paper[1:3, ], ink[1:3, ], luminance)
@@ -189,8 +181,7 @@ sepia <- function(nr, intensity, depth = 20) {
 #' @rdname color-manip
 #' @export
 set_matte <- function(nr, color = "green") {
-  rgb_int <-
-    grDevices::col2rgb(color[1], alpha = FALSE)
+  rgb_int <- colorfast::col_to_rgb(color[1])
   sz <- dim(nr)
   ret <- nr_to_rgba(nr, "nr")
   ret[1, ][ret[4, ] != 255] <- rgb_int[1, ] * 1