library(shiny)
library(colourpicker)
share <- list(
title = "{colourpicker} package",
url = "https://daattali.com/shiny/colourInput/",
image = "https://daattali.com/shiny/img/colourinput.png",
description = "An input control that allows users to select colours in Shiny apps",
twitter_user = "daattali"
)
shinyApp(
ui = fluidPage(
tags$head(
includeCSS(file.path("www", "app.css")),
# Favicon
tags$link(rel = "shortcut icon", type="image/x-icon", href="http://daattali.com/shiny/img/favicon.ico"),
# Facebook OpenGraph tags
tags$meta(property = "og:title", content = share$title),
tags$meta(property = "og:type", content = "website"),
tags$meta(property = "og:url", content = share$url),
tags$meta(property = "og:image", content = share$image),
tags$meta(property = "og:description", content = share$description),
# Twitter summary cards
tags$meta(name = "twitter:card", content = "summary_large_image"),
tags$meta(name = "twitter:site", content = paste0("@", share$twitter_user)),
tags$meta(name = "twitter:creator", content = paste0("@", share$twitter_user)),
tags$meta(name = "twitter:title", content = share$title),
tags$meta(name = "twitter:description", content = share$description),
tags$meta(name = "twitter:image", content = share$image)
),
shinydisconnect::disconnectMessage2(),
div(id = "header",
div(id = "title",
"{colourpicker} package"
),
div(id = "subtitle",
"An input control that allows users to select colours in Shiny apps"),
div(id = "subsubtitle",
"By",
tags$a(href = "http://deanattali.com/", "Dean Attali"),
HTML("•"),
"Code",
tags$a(href = "https://github.com/daattali/colourpicker", "on GitHub"),
HTML("•"),
tags$a(href = "https://github.com/sponsors/daattali", "Support my work"), "❤"
)
),
div(
id = "sections-container",
`data-columns` = NA,
div(
class = "section",
div(class = "title", "Simple"),
div(class = "output", "Selected colour:",
textOutput("valueSimple", inline = TRUE)),
colourInput("colSimple", NULL, "blue"),
tags$pre('colourInput("col", NULL, "blue")')
),
div(
class = "section",
div(class = "title", "Limited colour palette"),
div(class = "output", "Selected colour:",
textOutput("valueLimited", inline = TRUE)),
colourInput("colLimited", NULL, "yellow", palette = "limited"),
tags$pre(HTML(paste0(
'colourInput(<br>',
' "col", NULL, "yellow",<br>',
' palette = "limited")'
)))
),
div(
class = "section",
div(class = "title", "Allow Transparent"),
div(class = "output", "Selected colour:",
textOutput("valueTransparent", inline = TRUE)),
colourInput("colTransparent", NULL, "#00FF0080", allowTransparent = TRUE,
closeOnClick = TRUE),
tags$pre(HTML(paste0(
'colourInput(<br>',
' "col", NULL, "#00FF0080",<br>',
' allowTransparent = TRUE,<br>',
' closeOnClick = TRUE)'
)))
),
div(
class = "section",
div(class = "title", "Return colour name"),
div(class = "output", "Selected colour:",
textOutput("valueName", inline = TRUE)),
colourInput("colName", NULL, "green", returnName = TRUE,
palette = "limited", closeOnClick = TRUE),
tags$pre(HTML(paste0(
'colourInput(<br>',
' "col", NULL, "green",<br>',
' returnName = TRUE, <br>',
' palette = "limited",<br>',
' closeOnClick = TRUE)'
)))
),
div(
class = "section",
div(class = "title", "Background only"),
div(class = "output", "Selected colour:",
textOutput("valueBg", inline = TRUE)),
colourInput("colBg", NULL, "red", showColour = "background"),
tags$pre(HTML(paste0(
'colourInput(<br>',
' "col", NULL, "red",<br>',
' showColour = "background")'
)))
),
div(
class = "section",
div(class = "title", "Custom colour list"),
div(class = "output", "Selected colour:",
textOutput("valueCustom", inline = TRUE)),
colourInput("colCustom", NULL, palette = "limited",
allowedCols = c("white", "black", "red", "#DDD",
"blue", "#0000FFA0", "#0000FF30", "rgb(255, 255, 0)")),
tags$pre(HTML(paste0(
'colourInput(<br>',
' "col", NULL,<br>',
' palette = "limited",<br>',
' allowedCols = c(<br>',
' "white", "black", "red",<br>',
' "#DDD", "blue",<br>',
' "#0000FFA0", "#0000FF30",<br>',
' "rgb(255, 255, 0)"))'
)))
),
div(
class = "section",
div(class = "title", "Update input control"),
div(class = "output", "Selected colour:",
textOutput("valueUpdate", inline = TRUE)),
colourInput("colUpdate", NULL, "brown"),
tags$hr(),
textInput("text", "New colour: (colour name or HEX value)", "brown"),
selectInput("showColour", "Show colour",
c("both", "text", "background")),
shiny::selectInput("palette", "Colour palette",
c("square", "limited")),
checkboxInput("allowTransparent", "Allow transparent", FALSE),
checkboxInput("returnName", "Return R colour name", FALSE),
checkboxInput("closeOnClick", "Close on click", FALSE),
actionButton("update", "Update")
),
div(
class = "section",
div(class = "title", "Use output in a plot"),
colourInput("colPlotFill", "Points colour", "purple", allowTransparent = TRUE),
colourInput("colPlotOutline", "Points outline", "black", allowTransparent = TRUE),
plotOutput("plot")
)
),
includeScript(file.path("www", "salvattore.min.js"))
),
server = function(input, output, session) {
# show the selected colours
output$valueSimple <- renderText(input$colSimple)
output$valueBg <- renderText(input$colBg)
output$valueTransparent <- renderText(input$colTransparent)
output$valueUpdate <- renderText(input$colUpdate)
output$valueLimited <- renderText(input$colLimited)
output$valueName <- renderText(input$colName)
output$valueCustom <- renderText(input$colCustom)
# allow user to update an input control
observeEvent(input$update, {
updateColourInput(session, "colUpdate",
value = input$text, showColour = input$showColour,
palette = input$palette,
allowTransparent = input$allowTransparent,
returnName = input$returnName,
closeOnClick = input$closeOnClick)
})
# show plot based on colours selected
output$plot <- renderPlot({
par('bg' = '#EEEEEE');
plot(cars, pch = 22, cex = 1.5,
col = input$colPlotOutline,
bg = input$colPlotFill)
})
}
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.