👮.R

library(string2path)
library(ggplot2)
library(dplyr)

# Note: it seems Noto Color Emoji has many variants. Only that of COLRv1 format
# is supported, so this might not work on installed font of Noto Color Emoji.
ttf <- "~/../Downloads/Noto_Color_Emoji/NotoColorEmoji-Regular.ttf"

d <- string2fill("👮", ttf)
d2 <- string2path("👮", ttf)

center1 <- d2 |>
  summarise(x = mean(range(x)), y = mean(range(y)))
center2 <- d2 |>
  filter(path_id == 25) |>
  summarise(x = mean(range(x)), y = mean(range(y)))

colours_orig <- unique(d2$color)
n_colours <- length(colours_orig)
colours <- purrr::flatten_chr(lapply(LETTERS[1:2], \(x) scales::pal_viridis(option = x)(n_colours)))
colours <- c(colours_orig, colours)

xlim <- range(d$x)
xlim <- xlim + diff(xlim) * c(-0.2, 0.2)
ylim <- range(d$y)
ylim <- ylim + diff(ylim) * c(-0.2, 0.2)

rotate_and_enlarge <- function(d, rot, scale, center_x, center_y) {
  d |> 
    # 平行移動
    mutate(
      x = x - center_x,
      y = y - center_y
    ) |> 
    # 回転と拡大
    mutate(
      x_new = scale * (x * cos(rot) - y * sin(rot)),
      y_new = scale * (x * sin(rot) + y * cos(rot)),
    ) |> 
    mutate(
      x = x_new + center_x,
      y = y_new + center_y
    )
}

steps <- 180
cycle <- 2.5
t <- \(x) {
    pmax(x - steps * 0.2, 0)^1.5 / steps^1.5
}

easing_in_out_cubic <- function(x) {
  ifelse(
    x >= 1.0,
    1.0,
    ifelse(x < 0.5,
      2 * x^2,
      1 - (1 -x)^2 * 2
    )
  )
}

png_path <- file.path(tempdir(), "frame%03d.png")
ragg::agg_png(png_path, width = 800, height = 600)
for (i in 0:(steps * cycle)) {
  phase <- t(i)

  if (phase < 1.5) {
    rot <- 1.3 * pi * phase
    scale <- (1.0 + 5.0 * easing_in_out_cubic(phase))^2
    
    ratio <- easing_in_out_cubic(phase)
    center_x <- ratio * center2$x + (1 - ratio) * center1$x
    center_y <- ratio * center2$y + (1 - ratio) * center1$y
    
    d_tmp <- rotate_and_enlarge(d, rot, scale, center_x, center_y)
    d2_tmp <- rotate_and_enlarge(d2, rot, scale, center_x, center_y)
    ratio2 <- easing_in_out_cubic(pmax(phase - 0.3, 0.0)^2)
    offset <- as.integer(n_colours * 2 * phase * 0.6) %% (n_colours * 2)
    palette <- setNames(colorspace::lighten(colours[offset:(offset+n_colours)], ratio2), nm = colours_orig)
    p <- ggplot() +
      geom_polygon(data = d_tmp, aes(x, y, group = triangle_id, fill = color)) +
      geom_path(data = d2_tmp, aes(x, y, group = path_id), colour = alpha("white", 0.7)) +
      coord_equal(xlim = xlim, ylim = ylim) +
      theme_void() +
      scale_fill_manual(values = palette, guide = FALSE)
    
    plot(p)
  } else {
    center_x <- center1$x
    center_y <- center1$y
    scale <- (easing_in_out_cubic(phase - 1.5))
    rot <- 0

    d_tmp <- rotate_and_enlarge(d, rot, scale, center_x, center_y)
    d2_tmp <- rotate_and_enlarge(d2, rot, scale, center_x, center_y)
    p <- ggplot() +
      geom_polygon(data = d_tmp, aes(x, y, group = triangle_id, fill = color)) +
      geom_path(data = d2_tmp, aes(x, y, group = path_id), colour = alpha("white", 0.7)) +
      coord_equal(xlim = xlim, ylim = ylim) +
      theme_void() +
      scale_fill_identity(guide = FALSE)

    plot(p)
  }
}
for (i in 0:(steps * cycle)) {
  phase <- t(i)

  if (phase < 1.5) {
    rot <- 1.3 * pi * phase
    scale <- (1.0 + 5.0 * easing_in_out_cubic(phase))^2
    
    ratio <- easing_in_out_cubic(phase)
    center_x <- ratio * center2$x + (1 - ratio) * center1$x
    center_y <- ratio * center2$y + (1 - ratio) * center1$y
    
    d_tmp <- rotate_and_enlarge(d, rot, scale, center_x, center_y)
    d2_tmp <- rotate_and_enlarge(d2, rot, scale, center_x, center_y)
    ratio2 <- easing_in_out_cubic(pmax(phase - 0.3, 0.0)^2)
    offset <- as.integer(n_colours * 2 * phase * 0.6) %% (n_colours * 2)
    palette <- setNames(colorspace::lighten(colours[offset:(offset+n_colours)], ratio2), nm = colours_orig)
    p <- ggplot() +
      geom_polygon(data = d_tmp, aes(x, y, group = triangle_id, fill = color)) +
      geom_path(data = d2_tmp, aes(x, y, group = path_id), colour = alpha("white", 0.7)) +
      coord_equal(xlim = xlim, ylim = ylim) +
      theme_void() +
      scale_fill_manual(values = palette, guide = FALSE)
    
    plot(p)
  } else {
    center_x <- center1$x
    center_y <- center1$y
    scale <- (easing_in_out_cubic(phase - 1.5))
    rot <- 0

    d_tmp <- rotate_and_enlarge(d, rot, scale, center_x, center_y)
    d2_tmp <- rotate_and_enlarge(d2, rot, scale, center_x, center_y)
    p <- ggplot() +
      geom_polygon(data = d_tmp, aes(x, y, group = triangle_id, fill = color)) +
      geom_path(data = d2_tmp, aes(x, y, group = path_id), colour = alpha("white", 0.7)) +
      coord_equal(xlim = xlim, ylim = ylim) +
      theme_void() +
      scale_fill_identity(guide = FALSE)

    plot(p)
  }
}
dev.off()

png_files <- sprintf(png_path, (0:(steps * cycle) + 1))
av::av_encode_video(png_files, "output.mp4", framerate = 60)