pride flag and fixes

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: webmorphR
 Title: Reproducible Stimuli
-Date: 2022-05-30
-Version: 0.1.0
+Date: 2022-06-01
+Version: 0.1.1
 Authors@R: 
     c(person(
         given = "Lisa", 

NEWS.md

@@ -1,4 +1,9 @@
-# webmorphR 0.1.0.0
+# webmorphR 0.1.1
+
+* Fixed a bug when cropping `blank()` images with no names
+* Fixed a bug when using `image_func()` with func = "composite" and the length of the stimuli and composite image are the same.
+
+# webmorphR 0.1.0
 
 * R version requirements decreased from 4.2.0 to 4.1.0
 * `quick_delin()` function changed to `delin()` and upgraded to be able to update full templates

R/image_func.R

@@ -65,7 +65,7 @@ image_func <- function(stimuli, func, ...) {
   # match argument to stimuli, otherwise pass to the function unaltered
   n <- length(stimuli)
   dots <- lapply(list(...), function(x) {
-    if (length(x) == n) {
+    if (length(x) == n & is.vector(x)) {
       rep_len(x, n)
     } else {
       rep_len(list(x), n)

R/stimlist.R

@@ -35,7 +35,6 @@ new_stimlist <- function(..., .names = NULL) {
 #' @export
 #' @keywords internal
 #' @family stim
-#'
 new_stim <- function(img, path = "", ...) {
   info <- magick::image_info(img)
   stim_i <- list(

R/unique_names.R

@@ -22,6 +22,9 @@ unique_names <- function(full_names,
   if (remove_ext) {
     fnames <-  gsub("\\..{1,4}$", "", full_names)
   }
+
+  # handle blanks
+  fnames[fnames == ""] <- "stim"
 
   # handle NULL breaks ----
   if (is.null(breaks)) {

paper/index.Rmd

@@ -202,12 +202,12 @@ The averaging and caricaturing methods were later complemented by a transforming
 neutral <- load_stim_london() |> 
   add_info(london_info) |>
   subset(face_gender == "female") |>
-  auto_delin("dlib70", replace = TRUE)
+  webmorphR.dlib::auto_delin("dlib70", replace = TRUE)
 
 smiling <- load_stim_smiling() |> 
   add_info(london_info) |>
   subset(face_gender == "female") |>
-  auto_delin("dlib70", replace = TRUE)
+  webmorphR.dlib::auto_delin("dlib70", replace = TRUE)
 
 neutral_avg <- avg(neutral, texture = FALSE)
 smiling_avg <- avg(smiling, texture = FALSE)

stuff/pride.R

@@ -0,0 +1,36 @@
+library(webmorphR)
+wm_opts(fill = "none")
+
+pride <- c(
+  red = '#E50000',
+  orange = '#FF8D00',
+  yellow = '#FFEE00',
+  green = '#028121',
+  blue = '#004CFF',
+  purple = '#760088',
+  black = '#000000',
+  brown = '#613915',
+  aqua = '#73D7EE',
+  pink = '#FFAFC7',
+  white = '#FFFFFF'
+)
+
+stripes <- blank(6, width = 500, height = 50, color = pride[1:6])
+
+flag <- plot(stripes, nrow = 6, padding = 0)
+
+corner <- blank(1, 200, 200, color = pride["white"]) |>
+  pad(50, fill = pride["pink"]) |>
+  pad(50, fill = pride["aqua"]) |>
+  pad(50, fill = pride["brown"]) |>
+  pad(50, fill = pride["black"]) |>
+  rotate(degrees = 45, 
+       keep_size = FALSE) |>
+  crop(width = 0.5, height = 2/3, 
+       x_off = 0.5, y_off = 1/6) |>
+  resize(height = height(flag))
+
+prog_pride <- image_func(flag, "composite", corner$img$img)
+
+write_stim(prog_pride, names = "prog_pride.png")
+