R/glass_tab_theme.R

In glasstabs: Animated Glass-Style Tabs and Select Inputs for 'Shiny'

#' Create a custom color theme for glassTabsUI
#'
#' All arguments accept any valid CSS color string (hex, `rgb()`, `rgba()`,
#' named colors). Pass only the fields you want to override - unset fields
#' fall back to the dark-mode defaults.
#'
#' @note **Light mode color accessibility:** When building a light-mode theme,
#'   ensure `tab_text` is dark enough to read on a white background (e.g. at
#'   least `"#374151"`) and `tab_active_text` provides strong contrast (e.g.
#'   `"#1d4ed8"` or darker). Light-grey or near-white values that look fine on
#'   dark backgrounds become invisible on light ones.
#'
#' @param tab_text   Inactive tab text color.
#' @param tab_active_text Active tab text color (and headings inside cards).
#' @param halo_bg    Background fill of the animated glass halo.
#' @param halo_border Border color of the glass halo.
#' @param focus_ring Keyboard focus indicator color. Choose a color with at
#'   least 3:1 contrast against the tab surface.
#' @param content_bg  Tab content area background.
#' @param content_border Tab content area border.
#' @param card_bg    Inner `.gt-card` background.
#' @param card_text  Inner `.gt-card` text color.
#'
#' @return A named list of class `"glass_tab_theme"` for passing to
#'   the `theme` argument of [glassTabsUI()].
#'
#' @examples
#' # Amber / warm accent on a dark base
#' amber <- glass_tab_theme(
#'   halo_bg         = "rgba(251, 191, 36, 0.15)",
#'   halo_border     = "rgba(251, 191, 36, 0.40)",
#'   tab_active_text = "#fef3c7"
#' )
#'
#' if (interactive()) {
#'   library(shiny)
#'   ui <- fluidPage(
#'     useGlassTabs(),
#'     glassTabsUI(
#'       "demo",
#'       glassTabPanel("a", "Alpha", selected = TRUE, p("Alpha content")),
#'       glassTabPanel("b", "Beta",  p("Beta content")),
#'       theme = amber
#'     )
#'   )
#'   server <- function(input, output, session) {}
#'   shinyApp(ui, server)
#' }
#'
#' @export
glass_tab_theme <- function(
    tab_text = NULL,
    tab_active_text = NULL,
    halo_bg = NULL,
    halo_border = NULL,
    focus_ring = NULL,
    content_bg = NULL,
    content_border = NULL,
    card_bg = NULL,
    card_text = NULL
) {
  structure(
    list(
      tab_text = tab_text,
      tab_active_text = tab_active_text,
      halo_bg = halo_bg,
      halo_border = halo_border,
      focus_ring = focus_ring,
      content_bg = content_bg,
      content_border = content_border,
      card_bg = card_bg,
      card_text = card_text
    ),
    class = "glass_tab_theme"
  )
}

.tab_resolve_theme <- function(theme = NULL) {
  dark_defaults <- list(
    tab_text        = "rgba(207,230,255,0.78)",
    tab_active_text = "#ffffff",
    halo_bg         = "rgba(126,195,247,0.16)",
    halo_border     = "rgba(126,195,247,0.38)",
    focus_ring      = "#7ec3f7",
    halo_shadow     = "inset 0 1px 0 rgba(255,255,255,.22),inset 0 -1px 0 rgba(255,255,255,.06),0 6px 20px rgba(0,0,0,.38),0 0 0 1px rgba(255,255,255,.03)",
    content_bg      = "transparent",
    content_border  = "transparent",
    card_bg         = "transparent",
    card_text       = "#cfe6ff"
  )

  light_defaults <- list(
    tab_text        = "#374151",
    tab_active_text = "#1d4ed8",
    halo_bg         = "rgba(37,99,235,0.12)",
    halo_border     = "rgba(37,99,235,0.60)",
    focus_ring      = "#1d4ed8",
    halo_shadow     = "inset 0 1px 0 rgba(255,255,255,.80),0 4px 16px rgba(37,99,235,.20),0 0 0 1px rgba(37,99,235,.12)",
    content_bg      = "transparent",
    content_border  = "transparent",
    card_bg         = "transparent",
    card_text       = "#1e293b"
  )

  if (is.null(theme)) {
    return(dark_defaults)
  }

  if (is.character(theme) && length(theme) == 1) {
    if (!theme %in% c("dark", "light")) {
      .gt_abort(
        sprintf(
          paste0(
            "glassTabsUI(): `theme = \"%s\"` is not a valid preset.\n",
            "Use theme = \"dark\", \"light\", \"auto\", or a glass_tab_theme() object."
          ),
          theme
        ),
        class = "glasstabs_error_bad_theme",
        argument = "theme",
        value = theme,
        expected = c("dark", "light", "auto", "glass_tab_theme")
      )
    }
    return(if (theme == "light") light_defaults else dark_defaults)
  }

  if (inherits(theme, "glass_tab_theme")) {
    overrides <- Filter(Negate(is.null), unclass(theme))
    return(utils::modifyList(dark_defaults, overrides))
  }

  .gt_abort(
    sprintf(
      paste0(
        "glassTabsUI(): `theme` must be \"dark\", \"light\", or a glass_tab_theme() object,\n",
        "got %s. See ?glass_tab_theme for custom theming."
      ),
      class(theme)[1]
    ),
    class = "glasstabs_error_bad_theme",
    argument = "theme",
    value = theme,
    expected = c("dark", "light", "auto", "glass_tab_theme")
  )
}