R/qr.R

In mrjoh3/ggtrack: Build tracking banners using QR codes for addition to plots and reports

#' @title Add QR Code to Tracker
#'
#' @param tracker ggtrack tracker object
#' @param qr_content \code{character} content passed to \link[qrencoder]{qrencode}. A time stamp is automatically added plus the current
#' git commit where available.
#' @param color character color of QR code
#' @param color_bg character background color of QR code
#' @param height_tracker numeric tracker height in cm.
#' @param position data.frame generated by get \link[ggtrack]{get_positions}
#' @param justification numeric between 0 and 1 passed to \link[grid]{rasterGrob}.
#' @param ... additional options passed to \link[grid]{rasterGrob}
#'
#' @import qrencoder
#' @importFrom grid rasterGrob
#'
#' @return tracker
#'
#' @examples
#' \dontrun{
#'   make_tracker() %>% add_qr('Report ID: 2c9075a5-4d7e-47a5-8616-55dd88af3dc5', justification = 1)
#' }
qr <- function(tracker, qr_content, color = 'black', color_bg = 'white', height_tracker, position, justification, ...) {

  # setup QR code
  qr_matrix <- make_qr(qr_content, color, color_bg)

  qr <- grid::rasterGrob(qr_matrix, interpolate = FALSE, x = justification, just = justification, height = unit(height_tracker, 'cm'), name = 'qrcode', ...)

  # define position
  p <- as.list(position[position$order == 'Q', ])

  tracker +
    annotation_custom(qr, xmin = p$xmin, xmax = p$xmax)

}


#' @rdname qr
#' @family add_qr
#' @family gg
#' @family tracker
#' @export
add_qr <- function (tracker, ...) {
  UseMethod("add_qr", tracker)
}


#' @rdname qr
#' @family add_qr
#' @family gg
#' @export
add_qr.gg <- function(tracker, qr_content, color = 'black', color_bg = 'white', height_tracker, position, justification, ...) {
  qr(tracker, qr_content, color, color_bg, height_tracker, position, justification, ...)
}


#' @rdname qr
#'
#' @importFrom glue glue
#' @family add_qr
#' @family tracker
#' @export
add_qr.tracker <- function(tracker, qr_content, color = 'black', color_bg = 'white', justification, ...) {

  height_tracker <- tracker$height
  position <- tracker$pos
  banner <- tracker$track
  git <- tracker$git
  ts <- tracker$ts

  qr_content <- paste(qr_content, git, ts, sep = ' ')

  qr_cm <- qr_size(qr_content)

  if (height_tracker < qr_cm) {
    height_tracker <- tracker$height <- qr_cm
    message(glue('to encode this much text into QR making QR height {qr_cm}cm'))
  }

  tracker$track <- qr(banner, qr_content, color, color_bg, height_tracker, position, justification, ...)

  mtrack <- obj_tracker(tracker, 'qr')

  return(mtrack)

}


#' @title Make QR
#'
#' @param qr_content \code{character} content passed to \link[qrencoder]{qrencode}. A time stamp is automatically added plus the current
#' git commit where available.
#' @param color character color of QR code
#' @param color_bg character background color of QR code
#'
#' @return matrix
#'
make_qr <- function(qr_content, color = 'black', color_bg = 'white') {

  qr_matrix <- qrencoder::qrencode(qr_content)

  qr_matrix[qr_matrix == 1] <- color
  qr_matrix[qr_matrix == 0] <- color_bg

  return(qr_matrix)
}