File: colourWidget.R

package info (click to toggle)
r-cran-colourpicker 1.3.0%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,744 kB
  • sloc: javascript: 1,490; makefile: 13; sh: 3
file content (69 lines) | stat: -rw-r--r-- 2,232 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
#' Create a colour picker htmlwidget
#'
#' Create a colour picker htmlwidget. This is not terribly useful right now
#' since you can use the more powerful \code{\link[colourpicker]{colourInput}}
#' in Shiny apps and Rmarkdown documents, but this gives you an htmlwidget
#' version of that colour picker.
#'
#' @inheritParams colourInput
#' @param width Custom width for the input field.
#' @param height Custom height for the input field.
#' @param elementId Use an explicit element ID for the widget (rather than an
#' automatically generated one).
#' @import htmlwidgets
#' @examples
#' colourWidget()
#' colourWidget("red", palette = "limited", allowedCols = c("yellow", "red", "#123ABC"))
#'
#' @export
colourWidget <- function(value = "white",
                         showColour = c("both", "text", "background"),
                         palette = c("square", "limited"), allowedCols = NULL,
                         allowTransparent = FALSE, returnName = FALSE,
                         closeOnClick = FALSE,
                         width = "300px", height = "35px", elementId = NULL) {
  # sanitize the arguments
  showColour <- match.arg(showColour)
  palette <- match.arg(palette)

  # forward options using x
  x <- list(
    value = value,
    showColour = showColour,
    palette = palette,
    returnName = returnName,
    allowAlpha = allowTransparent,
    closeOnClick = closeOnClick
  )

  if (!is.null(allowedCols)) {
    allowedCols <- jsonlite::toJSON(allowedCols)
    x[['allowedCols']] <- allowedCols
  }

  deps <- list(
    rmarkdown::html_dependency_bootstrap("default")
  )

  # create widget
  htmlwidgets::prependContent(
    htmlwidgets::createWidget(
      name = 'colourWidget',
      x,
      width = width,
      height = height,
      dependencies = deps,
      package = 'colourpicker',
      elementId = elementId
    ),
    htmltools::tags$style(
      ".colourpicker-input-container{ display:inline-block; }"
    )
  )
}

colourWidget_html <- function(id, class, style, ...) {
  class <- paste0(class, " form-control")
  htmltools::tags$input(id = id, class = class, style = style,
                        type = "text")
}