R/base64.R

Defines functions get_image_uri get_mime_type encode_base64 get_file_ext

# Get a file's extension
get_file_ext <- function(file) {

  pos <- regexpr("\\.([[:alnum:]]+)$", file)
  ifelse(pos > -1L, substring(file, pos + 1L), "")
}

# Encode a raw string to a Base64 string
encode_base64 <- function(raw) {

  b64 <- c(LETTERS, letters, 0:9, "+", "/")
  s <- as.integer(raw)
  n <- length(s)
  res <- rep(NA, (n + 2) / 3 * 4)
  i <- 0L
  j <- 1L

  while (n > 2L) {
    res[i <- i + 1L] <- b64[s[j] %/% 4L + 1L]
    res[i <- i + 1L] <- b64[16 * (s[j] %% 4L) + s[j + 1L] %/% 16 + 1L]
    res[i <- i + 1L] <- b64[4L * (s[j + 1L] %% 16) + s[j + 2L] %/% 64L + 1L]
    res[i <- i + 1L] <- b64[s[j + 2L] %% 64L + 1L]
    j <- j + 3L
    n <- n - 3L
  }

  if (n) {

    res[i <- i + 1L] <- b64[s[j] %/% 4L + 1L]

    if (n > 1L) {
      res[i <- i + 1L] <- b64[16 * (s[j] %% 4L) + s[j + 1L] %/% 16 + 1L]
      res[i <- i + 1L] <- b64[4L * (s[j + 1L] %% 16) + 1L]
      res[i <- i + 1L] <- "="

    } else {

      res[i <- i + 1L] <- b64[16 * (s[j] %% 4L) + 1L]
      res[i <- i + 1L] <- "="
      res[i <- i + 1L] <- "="
    }
  }
  paste(res[!is.na(res)], collapse = "")
}

# Helper to set the MIME type
get_mime_type <- function(file) {

  extension <-
    file %>%
    get_file_ext() %>%
    tolower()

  switch(
    extension,
    svg = "image/svg+xml",
    jpg = "image/jpeg",
    file.path("image", extension, fsep = "/")
    )
}

# Get an image URI from an on-disk graphics file
# as a Base64-encoded image string
get_image_uri <- function(file) {

  image_raw <-
    readBin(
      con = file,
      what = "raw",
      n = file.info(file)$size)

  paste0("data:", get_mime_type(file), ";base64,", encode_base64(image_raw))
}

Try the DiagrammeR package in your browser

Any scripts or data that you put into this service are public.

DiagrammeR documentation built on June 22, 2024, 11:21 a.m.