R/xmaspeace.R

In christmas: Generation of Different Animated Christmas Cards

#' @title Peaceful Christmas tree.
#'
#' @description Christmas card (2025 card) including a tree Christmas tree whose
#'   leaves are created with the word "peace" in 32 languages. This is the first
#'   card in this collection created by interacting with AI (Gemini Flash 2.5).
#'
#' @param year Year to be printed. Default is \code{2026}.
#' @param language Language to be used in the card. One of \code{c("english",
#'  "spanish", "catalan")}. Default is \code{"english"}.
#' @param seed Seed for reproducibility of the card. Default is \code{NULL} (no
#'   seed).
#' @return A Christmas card plot including a tree and wishing a peaceful year.
#' @author Jose Barrera-Gomez.
#' @examples
#' \donttest{
#' xmaspeace()
#' }
#' @export

xmaspeace <- function(year = 2026,
                      language = c("english", "spanish", "catalan"),
                      seed = NULL) {
  # "year":
  if (!inherits(year, c("numeric", "integer")) || length(year) != 1L)
    stop("'year' must be a number")
  # "language":
  language <- match.arg(language)
  # "seed":
  if(!is.null(seed) & (is.na(seed) || !is(seed, "numeric")))
    stop("'seed' must be numeric or NULL")
  if (!is.null(seed))
    set.seed(seed)

  # set font type for the tree R:
  myvfont <- c("serif", "bold")

  # plot limits (increase tree width to fit with asp = 1):
  newwindow()
  xr <- c(-6, 6)
  yr <- c(0, 15)

  # background:
  plot(xr, yr, type = "n", xlim = xr, ylim = yr, asp = 1,
       axes = FALSE, xlab = "", ylab = "")
  h0 <- 5
  polygon(c(xr[1], xr[1], xr[2], xr[2]), c(yr[1], h0, h0, yr[1]),
          border = NA, col = "azure2")
  polygon(c(xr[1], xr[1], xr[2], xr[2]), c(h0, yr[2], yr[2], h0),
          border = NA, col = "darkblue")

  # stars:
  u <- runif(500, xr[1], xr[2])
  v <- runif(500, yr[1] + 1.5 * h0, yr[2])
  points(u, v, pch = 8, lwd = 1, cex = 0.1, col = rainbow(180)[90])
  u <- runif(50, xr[1], xr[2])
  v <- runif(50, yr[1] + 1.1 * h0, yr[1] + 1.5 * h0)
  points(u, v, pch = 8, lwd = 1, cex = 0.1, col = rainbow(180)[90])

  # skyline:
  xaux <- seq(xr[1], xr[2], by = 0.01)
  lines(xaux, rnorm(length(xaux), h0, 0.05), type = "l", lwd = 3, col = "blue4")

  # trunk:
  x <- c(-0.4, 0.4, 0, -0.4) + rnorm(4, 0, 0.015)
  ymaxtrunk <- 9.7
  y <- c(2.5, 2.5, ymaxtrunk, 2.5) + rnorm(4, 0, 0.015)
  polygon(x, y, border = NA, col = "brown")
  x <- runif(9, -0.28, 0.28)
  y <- runif(9, 2.8, 3.2)
  lines(x, y, type = "p", pch = "|", lwd = 2, col = "orangered4")
  # trunk basis:
  xaux <- seq(-0.4, 0.4, by = 0.01)
  lines(xaux, rnorm(length(xaux), 2.5, 0.05), type = "l", lwd = 3, col = "azure2")

  # peace words:
  peace_words <- c("Mir", "Pau", "Pax", "Paz", "Beke", "Fred",
                   "Mier", "Pace", "Paix", "Paqe", "Solh", "Thak",
                   "Bakea", "Baris", "Damai", "Heiwa", "Peace",
                   "Pokoj", "Rauha", "Salam", "Vrede", "Aminci",
                   "Eirini", "Heping", "Shanti", "Shalom",
                   "Alaafia", "Frieden", "Hoa binh", "Pyeonghwa",
                   "Kapayapaan", "Saantipaph")

  # general sampling:
  num_words <- 200 # 250
  Decoration_Words <- sample(peace_words, size = num_words, replace = TRUE)
  word_index <- 1

  # triangle coordinates:
  dh <- 3
  x_inf <- c(-3, 3, 0)
  y_inf <- dh + c(1, 1, 4.5)
  x_med <- c(-2.5, 2.5, 0)
  y_med <- dh + c(4, 4, 7)
  x_sup <- c(-1.5, 1.5, 0)
  y_sup <- dh + c(6.5, 6.5, 8.5)

  triangles <- list(inf = data.frame(x = x_inf, y = y_inf),
                    med = data.frame(x = x_med, y = y_med),
                    sup = data.frame(x = x_sup, y = y_sup))

  # word text size and rotation parameters:
  text_size_fill <- 0.85 # 0.6
  angle_rand_min <- -12 # -10
  angle_rand_max <- 12  # 10

  # distribute words inside the tree:
  total_words_to_fill <- num_words - (word_index - 1)
  total_words_to_fill <- max(0, total_words_to_fill)

  # coordinates and sampled words are random in each execution:
  random_x <- runif(total_words_to_fill * 2, min = -3, max = 3)
  #random_y <- runif(total_words_to_fill * 2, min = 1.5, max = 7)
  random_y <- runif(total_words_to_fill * 2, min = 4, max = 8 + dh)

  random_points <- data.frame(x = random_x, y = random_y)

  plotted_count <- 0

  ### color palette for random selection:
  #tree_greens_fixed <- c("#2F4F4F", "#3CB371", "#6B8E23")
  tree_greens_fixed <- c("darkgreen", "darkolivegreen", "forestgreen")


  ### reference segments for the fill angle:
  segments_data <- data.frame(
    x0 = c(x_inf[1], x_med[1], x_sup[1], x_inf[2], x_med[2], x_sup[2]),
    y0 = c(y_inf[1], y_med[1], y_sup[1], y_inf[2], y_med[2], y_sup[2]),
    x1 = c(x_inf[3], x_med[3], x_sup[3], x_inf[3], x_med[3], x_sup[3]),
    y1 = c(y_inf[3], y_med[3], y_sup[3], y_inf[3], y_med[3], y_sup[3]))


  segments_data$angle_deg <- atan2(segments_data$y1 - segments_data$y0,
                                   segments_data$x1 - segments_data$x0) * 180 / pi

  segments_data$angle_deg[4:6] <- segments_data$angle_deg[4:6] + 180

  n_random_points <- nrow(random_points)
  in_tree_vector <- rep(NA, n_random_points)

  for (i in 1:n_random_points) {
    if (plotted_count >= total_words_to_fill) break

    px <- random_points$x[i]
    py <- random_points$y[i]

    in_tree <- FALSE

    if (point_in_polygon(px, py, triangles$inf$x, triangles$inf$y))
      in_tree <- TRUE

    if (point_in_polygon(px, py, triangles$med$x, triangles$med$y))
      in_tree <- TRUE

    if (point_in_polygon(px, py, triangles$sup$x, triangles$sup$y))
      in_tree <- TRUE

    if (in_tree) {
      # ref_angle <- if (px <= 0) segments_data$angle_deg[3] else segments_data$angle_deg[6]
      ref_angle <- segments_data$angle_deg[6 - 3 * (px <= 0)]

      # random rotation:
      random_rotation <- runif(1, min = angle_rand_min, max = angle_rand_max)
      final_angle <- ref_angle + random_rotation

      # random color:
      current_fill_color <- sample(tree_greens_fixed, 1)

      # print word:
      text(px, py, labels = Decoration_Words[word_index],
           col = current_fill_color, cex = text_size_fill,
           srt = final_angle, adj = 0.5)

      word_index <- word_index + 1
      plotted_count <- plotted_count + 1
    }

    in_tree_vector[i] <- in_tree
  }


  ### snow:
  u <- runif(400, xr[1], xr[2])
  v <- runif(400, yr[1], yr[2])
  points(u, v, pch = 8, cex = c(0.2, 0.3, 0.4), col = "white")

  ### message:
  mess <- switch(language,
                 english = "Peace for",
                 spanish = "Paz para el",
                 catalan = "Pau pel")
  mess <- paste(mess, year)
  textcex <- 2.5
  Sys.sleep(0.4)
  text(x = 0, y = (3.5 + yr[1]) / 2,
       labels = mess, cex = textcex,
       font = 2, vfont = myvfont, col = "forestgreen")

  ### R tree:
  Sys.sleep(0.4)
  text(x = 0, y = 12, labels = "R", srt = 15,
       vfont = myvfont, cex = 3, col = "gold")
}