R/annotator.R

In annotator: Image Annotation and Polygon Outlining using Free Drawing

#' Create an annotation widget
#'
#' This function creates an annotation using [htmlwidgets].
#' The widget can be rendered on HTML pages generated from Shiny or
#' other applications.
#'
#' @param im the input image. If missing, a transparent 800x600 png is used.
#' @param resultId the id of the `div` in the `UI` where the annotation (the drawn polygon) is stored.
#' Only relevant when the widget is used in shiny. Defaults to "annot_id".
#' @param brushWidth default to 3 pixels.
#' @param brushColor Any valid CSS color. For example "red", "rgba(255,93,0,1)", or "#1c4564". 
#' @param opacity  default to 0.5.
#' @param fill default to 'gray' 
#' @return An object generated by [htmlwidgets::createWidget()].
#' @md
#' @export
#' @examples
#' if (interactive()) {
#'   require(annotator)
#'   im = system.file("sample_images", "aves", "5.png", package = "annotator")
#'   annotate(im)
#' }
#'
annotate <- function(im,resultId = "annot_id", brushWidth = 4, brushColor = "red", opacity = 0.5, fill = "grey") {
  if (missing(im)) {
    im64 <- empty_png()
  } else {
    # TODO: check if image is supported by the browser.
    im64 <- xfun::base64_uri(im)
  }

  x <- list(
    im = im64,
    resultId = resultId,
    brushWidth = brushWidth,
    brushColor = brushColor, 
    opacity = opacity, 
    fill = fill
  )



  createWidget(
    name = "annotator_fabric",
    x,
    package = "annotator"
  )
}


#' Widget output function for use in Shiny
#'
#' @param outputId The name of the input.
#' @param width   in CSS units, default to "auto".
#' @param height  in CSS units, default to "auto".
#' @param ...  further arguments to pass to [htmlwidgets::shinyWidgetOutput()] e.g. `inline`.
#' @return An object generated by [htmlwidgets::shinyWidgetOutput()].
#' @seealso [annotator::runExample()]
#' @examples
#' # Print the directory containing the code for all examples to see this function in use.
#' system.file("examples", package = "annotator")
#' @md
#' @export



annotatorOutput <- function(outputId, width = "auto", height = "auto", ...) {
  shinyWidgetOutput(outputId, "annotator_fabric", width, height, package = "annotator", ...)
}

#' Widget render function for use in Shiny
#' @param expr An annotator expression.
#' @param env A environment. Default to `parent.frame()`.
#' @param quoted  A boolean value.
#' @return An object generated by [htmlwidgets::shinyRenderWidget()].
#' @examples
#' # Print the directory containing the code for all examples to see this function in use.
#' system.file("examples", package = "annotator")
#' @seealso [annotator::runExample()]
#' @md
#' @export
renderAnnotator <- function(expr, env = parent.frame(), quoted = FALSE) {
  if (!quoted) {
    expr <- substitute(expr)
  }
  shinyRenderWidget(expr, annotatorOutput, env, quoted = TRUE)
}