R/idsThemeR.R

idsBaseFontFamily <- "Fira Sans Condensed"

ids_font_available <- function(font_family) {
  if (!requireNamespace("systemfonts", quietly = TRUE)) {
    return(FALSE)
  }
  info <- tryCatch(systemfonts::font_info(font_family), error = function(e) NULL)
  !is.null(info) && nrow(info) > 0
}

ids_resolve_font_family <- function(preferred = idsBaseFontFamily, fallback = "sans") {
  candidates <- unique(stats::na.omit(c(preferred, idsBaseFontFamily, fallback)))
  available <- vapply(candidates, ids_font_available, logical(1))
  if (any(available)) {
    return(candidates[which(available)[1]])
  }

  if (requireNamespace("sysfonts", quietly = TRUE)) {
    try(sysfonts::font_add_google("Fira Sans Condensed", "Fira Sans Condensed"), silent = TRUE)
    if (requireNamespace("showtext", quietly = TRUE)) {
      try(showtext::showtext_auto(enable = TRUE), silent = TRUE)
    }
    candidates_after <- unique(c("Fira Sans Condensed", candidates))
    available_after <- vapply(candidates_after, ids_font_available, logical(1))
    if (any(available_after)) {
      return(candidates_after[which(available_after)[1]])
    }
  }

  fallback
}


#' Title
#'
#' @return
#' @export
#'
#' @examples
idsPaletteIDS <- function() {
  c(
    "#F18700",
    "#1E2662",
    "#6A7702",
    "#C10A25",
    "#009EE3",
    "#FAF3DE",
    "#A7C2D2",
    "#E2E8A4",
    "#CFBCBD",
    "#BCE3FA",
    "#5C401C",
    "#000000",
    "#354C32",
    "#5C131C",
    "#273582",
    "#FFE3BF",
    "#8994E1",
    "#A3B29E",
    "#DF9599",
    "#79B8DB"
  )
}

#' Title
#'
#' @return
#' @export
#'
#' @examples
idsPaletteD3 <- function() {
  c(
    "#EB7C31",
    "#1F77B4",
    "#2CA02C",
    "#D62728",
    "#9467BD",
    "#8C564B",
    "#E377C2",
    "#7F7F7F",
    "#BCBD22",
    "#17BECF",
    "#AEC7E8",
    "#FFBB78",
    "#98DF8A",
    "#FF9896",
    "#C5B0D5",
    "#C49C94",
    "#F7B6D2",
    "#C7C7C7",
    "#DBDB8D",
    "#9EDAE5"
  )
}

#' Title
#'
#' @return
#' @export
#'
#' @examples
idsPalettePoly20 <- function() {
  c(
    "#EF8700", "#1642FF", "#00D20D", "#FF00CB", "#162E35", "#00C8FC", "#FF004B", "#BBB96A", "#DFA2ED", "#881640", "#22D0AD", "#CF0DF7",
    "#2E0D95", "#AFB9BD", "#FC4792", "#EBA392", "#1C7C00", "#939CFF", "#AB00A4", "#AF1C00"
  )
}

#' Title
#'
#' @return
#' @export
#'
#' @examples
idsPaletteGreyscale <- function() {
  c(
    "#000000", "#B2B0AD", "#737373", "#D8D7D6", "#B2B0AD", "#8C8984"
  )
}

#' Title
#'
#' @return
#' @export
#'
#' @examples
idsPalette <- function() {
  idsPaletteD3()
}

backgroundColorDark <- "#2a2a2a"
textColorDark <- "#E0E0E3"
lowContrastColorDark <- "#707073"
highContrastColorDark <- "#F0F0F3"
mediumContrastColorDark <- "#808083"

backgroundColor <- "#ffffff"
textColor <- "#383838"
highContrastColor <- "#101013"
lowContrastColor <- "#E0E0E3"
mediumContrastColor <- "#404043"
tooltipBackgroundColor <- "#ffffffe0"
boxplotFillColor <- "#505053"
candlestickColor <- "black"
errorbarColor <- "black"

#' IDS color palette
#'
#' @param palette \code{c("d3", "grey", "ids", "poly20")} - default: (adapted) d3 palette
#'
#' @importFrom scales manual_pal
#' @export
#'
#' @references
#'
#' \url{https://github.com/d3/d3}
#'
ids_pal <- function(palette = "default") {
  values <- switch(tolower(palette),
    ids = idsPaletteIDS(),
    gray = idsPaletteGreyscale(),
    grey = idsPaletteGreyscale(),
    poly20 = idsPalettePoly20(),
    idsPaletteD3()
  )
  f <- scales::manual_pal(values)
  attr(f, "max_n") <- length(values)
  f
}