#' Rotate templates and images
#'
#' @param stimuli list of class stimlist
#' @param degrees degrees to rotate
#' @param fill background color
#' @param patch whether to use the patch function to set the background color
#'
#' @return stimlist with rotated tems and/or images
#'
#' @export
#'
#' @examples
#' demo_stim() %>%
#' rotate(45, fill = "dodgerblue") %>%
#' draw_tem() %>%
#' plot()
#'
#' demo_stim() %>%
#' rotate(45, patch = TRUE) %>%
#' plot()
#'
rotate <- function(stimuli, degrees = 0,
fill = "none", patch = FALSE) {
stimuli <- validate_stimlist(stimuli)
degrees <- degrees %>%
rep(length.out = length(stimuli)) %>%
sapply(`%%`, 360)
radians <- degrees * (pi/180)
suppressWarnings({
fill <- rep(fill, length.out = length(stimuli))
#patch <- rep(patch, length.out = length(stimuli))
})
for (i in seq_along(stimuli)) {
w <- stimuli[[i]]$width
h <- stimuli[[i]]$height
# rotate image ----
if (class(stimuli[[i]]$img) == "magick-image") {
info <- magick::image_info(stimuli[[i]]$img)
xm1 <- info$width/2
ym1 <- info$height/2
# set fill from patch
if (isTRUE(patch)) {
fill[i] <- patch(stimuli[[i]]$img)
} else if (!isFALSE(patch)) {
plist <- c(list(img = stimuli[[i]]$img), patch)
fill[i] <- do.call("patch", plist)
}
stimuli[[i]]$img <- stimuli[[i]]$img %>%
magick::image_background(color = fill[i]) %>%
magick::image_rotate(degrees[i]) %>%
magick::image_repage()
info <- magick::image_info(stimuli[[i]]$img)
xm2 <- info$width/2
ym2 <- info$height/2
} else if (!is.null(w) && !is.null(h)) {
rotsize <- rotated_size(w, h, degrees[i])
xm1 <- w/2
ym1 <- h/2
xm2 <- rotsize$width/2
ym2 <- rotsize$height/2
} else if (!is.null(stimuli[[i]]$points)) {
# rotate around the centre of the points
centre <- apply(stimuli[[i]]$points, 1, mean)
xm1 <- centre[[1]]
ym1 <- centre[[2]]
rotsize <- rotated_size(xm1*2, ym1*2, degrees[i])
xm2 = rotsize$width/2
ym2 = rotsize$height/2
}
stimuli[[i]]$width = round(xm2*2)
stimuli[[i]]$height = round(ym2*2)
# rotate points ----
if (!is.null(stimuli[[i]]$points)) {
# Subtract original midpoints, rotate,
# and add the new midpoints in the end again
stimuli[[i]]$points <- apply(stimuli[[i]]$points, 2, function(pt) {
crad <- cos(radians[i])
srad <- sin(radians[i])
x_offset <- pt[[1]] - xm1
y_offset <- pt[[2]] - ym1
xr = x_offset * crad - y_offset * srad + xm2
yr = x_offset * srad + y_offset * crad + ym2
c(xr, yr)
})
}
}
invisible(stimuli)
}
#' Image size after rotation
#'
#' @param width Width of the original image
#' @param height Height of the original image
#' @param degrees Rotation in degreed
#'
#' @return list of rotated width and height
#' @export
#'
#' @examples
#' rotated_size(100, 100, 45)
rotated_size <- function(width, height, degrees) {
degrees <- degrees %% 180
if (degrees < 0) {
degrees <- 180 + degrees
}
if (degrees >= 90) {
tmpw <- width
width <- height
height <- tmpw
degrees <- degrees - 90
}
radians <- degrees * pi / 180;
w <- (width * cos(radians)) + (height * sin(radians))
h <- (width * sin(radians)) + (height * cos(radians))
list(
width = w,
height = h
)
}
#' Make eyes horizontal
#'
#' @param stimuli list of class stimlist
#' @param left_eye The first point to align (defaults to 0)
#' @param right_eye The second point to align (defaults to 1)
#' @param fill background color to pass to rotate
#' @param patch whether to use the patch function to set the background color
#'
#' @return stimlist with rotated tems and/or images
#' @export
#'
#' @examples
#' demo_stim("lisa") %>% horiz_eyes() %>% plot()
#'
horiz_eyes <- function(stimuli, left_eye = 0, right_eye = 1, fill = webmorph_options("fill"), patch = FALSE) {
stimuli <- validate_stimlist(stimuli, TRUE)
degrees <- lapply(stimuli, `[[`, "points") %>%
lapply(function(pt) {
x1 = pt[[1, left_eye+1]]
y1 = pt[[2, left_eye+1]]
x2 = pt[[1, right_eye+1]]
y2 = pt[[2, right_eye+1]]
rad <- atan2(y1 - y2, x1 - x2) %% (2*pi)
180 - (rad / (pi/180))
})
stimuli %>%
rotate(degrees = degrees, fill = fill, patch = patch) %>%
resize(width = width(stimuli), height = height(stimuli)) %>%
invisible()
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.