gist_to_carbon.R

gist_to_carbon <- function(
  gist_id,
  file = "code.png",
  bg = "#4A90E2",
  bg_alpha = 1,
  theme = "shades-of-purple",
  font = "Fira+Code",
  lang = "auto",
  drop_shadow = TRUE,
  width = 680,
  width_auto_adjust = TRUE,
  imgur = TRUE
) {
  fonts <- c("IBM+Plex+Mono", "Hack", "Fira+Code", "Source+Code+Pro")
  langs <- c("python", "r", "yaml", "markdown", "text", "auto")
  themes <- c("cobalt", "nord", "seti", "night-owl", "monokai", "material", "vscode", "verminal", "synthwave-84", "shades-of-purple")

  if (!(nchar(bg) == 7 && grepl("#", bg))) stop("The background must be a 6 unit hex value preceded by #, like #4A90E2", call. = FALSE)
  if (!(lang %in% langs)) stop(paste("Language must be one of", langs), call. = FALSE)
  if (!(theme %in% themes)) stop(paste("Theme must be one of", themes), call. = FALSE)
  if (!(font %in% fonts)) stop(paste("Font must be one of", fonts), call. = FALSE)

  bcol <- col2rgb(bg)
  bg_txt <- glue::glue("rgba%28{bcol[1]}%2C{bcol[2]}%2C{bcol[3]}%2C{bg_alpha}%29")

  drop_shadow <- if (isTRUE(drop_shadow)) {
    "&ds=true&dsyoff=20px&dsblur=68px"
  } else if (identical(drop_shadow, FALSE)) {
    "&ds=false"
  } else if (length(drop_shadow) > 0) {
    ds_values <- c(20, 68)
    for (i in seq_along(drop_shadow)) ds_values[i] <- drop_shadow[i]
    glue::glue("&ds=true&dsyoff={ds_values[1]}px&dsblur={ds_values[2]}px")
  } else {
    "&ds=false"
  }

  width_auto_adjust <- if (isTRUE(width_auto_adjust)) "true" else "false"

  carbon_query <- glue::glue("bg={bg_txt}&t={theme}&fm={font}&lang={lang}{drop_shadow}&width={width}&wa={width_auto_adjust}")
  carbon_url <- glue::glue("https://carbon.now.sh/embed/{gist_id}?{carbon_query}")
  cli::cli_inform("{.url {carbon_url}}")

  b <- chromote::ChromoteSession$new(
    # set the screen size to avoid clipped code
    width = width * 1.5,
    height = width * 10
  )
  on.exit(b$close())

  # Navigate to carbon url
  b$Page$navigate(carbon_url)
  b$Page$loadEventFired()
  # Enable background transparency in the screenshot
  b$Emulation$setDefaultBackgroundColorOverride(color = list(r = 0, g = 0, b = 0, a = 0))
  # Hide the copy button
  b$Runtime$evaluate("document.querySelector('.copy-button').style.display = 'none'")
  # Screenshot time!
  b$screenshot(filename = file, selector = "#export-container", scale = 3)

  if (!imgur) {
    return(file)
  }

  imgur_url <- as.character(knitr::imgur_upload(img))
  list(local = file, imgur = imgur_url)
}

# https://gist.github.com/85f6305b0d6ed1b045ac9e54d0f333f2
# Code image at: ![](https://i.imgur.com/rXkoukl.png)