Nothing
R/themeConfigurationsAddin.R
In periscope2: Enterprise Streamlined 'shiny' Application Framework Using 'bs4Dash'
Defines functions
themeBuilder_addin_server
themeBuilder_addin_UI
themeConfigurationsAddin
Documented in
themeConfigurationsAddin
#' Build application theme configuration YAML file
#'
#' Call this as an addin to build valid yaml file that is needed for creating application
#' periscope_style.yaml file. The generated file can be used in periscope2 app by putting it inside generated app www folder.
#'
#' The method can be called directly via `R` console or via RStudio addins menu
#'
#' @return launch gadget window
#'
#' @examples
#' if (interactive()) {
#' periscope2:::themeConfigurationsAddin()
#' }
#'
#' @seealso \link[periscope2:create_application]{periscope2:create_application()}
#'
#' @export
themeConfigurationsAddin <- function() {
if (!requireNamespace(c("miniUI", "colourpicker"), quietly = TRUE)) {
stop("You must have packages 'miniUI' and 'colourpicker' installed to use this add-in",
call. = FALSE)
}
shiny::runGadget(app = themeBuilder_addin_UI(),
server = function(input, output, session){
themeBuilder_addin_server()
},
viewer = shiny::browserViewer())
}
themeBuilder_addin_UI <- function() {
shiny::addResourcePath(prefix = "img",
directoryPath = system.file("fw_templ/www", package = "periscope2"))
miniUI::miniPage(
miniUI::gadgetTitleBar("Theme Configuration YAML File Builder"),
miniUI::miniTabstripPanel(
miniUI::miniTabPanel(
"Status Colors",
miniUI::miniContentPanel(
shiny::p("Specify the colors to used when the corresponding status argument in shiny UI elements such as infoBox, valueBox, cards are set."),
stableColumnLayout(
colourpicker::colourInput(inputId = "primary",
label = "Primary",
showColour = "both",
value = "#B221DD",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "secondary",
label = "Secondary",
showColour = "both",
value = "#6c757d",
allowTransparent = TRUE)),
stableColumnLayout(
colourpicker::colourInput(inputId = "success",
label = "Success",
showColour = "both",
value = "#2ED610",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "info",
label = "Info",
showColour = "both",
value = "#7BDFF2",
allowTransparent = TRUE)),
stableColumnLayout(
colourpicker::colourInput(inputId = "warning",
label = "Warning",
showColour = "both",
value = "#FFF200",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "danger",
label = "Danger",
showColour = "both",
value = "#CE0900",
allowTransparent = TRUE)),
stableColumnLayout(
colourpicker::colourInput(inputId = "light",
label = "Light",
showColour = "both",
value = "#f8f9fa",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "dark",
label = "Dark",
showColour = "both",
value = "#343a40",
allowTransparent = TRUE))
)
),
miniUI::miniTabPanel(
"Sidebar Colors",
miniUI::miniContentPanel(
shiny::p("Sidebar colors variables allow you to change sidebars (left and right) related colors"),
shiny::tags$i("Use value \"#00000000\" to reset back to original theme default color"),
stableColumnLayout(colourpicker::colourInput(inputId = "bg",
label = "Background Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "hover_bg",
label = "Hover Background Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "color",
label = "Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "hover_color",
label = "Hover Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "active_color",
label = "Active Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "submenu_bg",
label = "Submenu Background Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "submenu_color",
label = "Submenu Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "submenu_hover_color",
label = "Submenu Hover Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "submenu_hover_bg",
label = "Submenu Hover Background Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "submenu_active_color",
label = "Submenu Active Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "submenu_active_bg",
label = "Submenu Active Background Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "header_color",
label = "Header Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE))
)
),
miniUI::miniTabPanel(
"Sidebar Layout",
miniUI::miniContentPanel(
shiny::p("Sidebar layout variables allow you to change sidebars (left and right) width, padding, ...",
shiny::tags$br(),
shiny::tags$i("All units are in pixels")),
stableColumnLayout(shiny::numericInput(inputId = "sidebar_width",
label = "Left Sidebar Width",
value = NA),
shiny::numericInput(inputId = "control_sidebar_width",
label = "Right Sidebar Width",
value = NA)),
stableColumnLayout(shiny::numericInput(inputId = "sidebar_padding_x",
label = "Sidebar Horizontal Padding",
value = NA),
shiny::numericInput(inputId = "sidebar_padding_y",
label = "Sidebar Vertical Padding",
value = NA)),
stableColumnLayout(shiny::numericInput(inputId = "sidebar_mini_width",
label = periscope2::ui_tooltip(id = "textTip",
label = "Width for mini sidebar",
text = paste("Left sidebar can be minimized to show menu icons (and not to be fully collapsed).",
"That property controls the width of the minimized sidebar.",
sep = "<br/><br/>"),
placement = "bottom"),
value = NA))
)
),
miniUI::miniTabPanel(
"Main Colors",
miniUI::miniContentPanel(
shiny::p("Specify the specific hex codes for the following color words that can be referenced in the app."),
stableColumnLayout(colourpicker::colourInput(inputId = "blue",
label = "Blue",
showColour = "both",
value = "#007bff",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "lightblue",
label = "Light Blue",
showColour = "both",
value = "#3c8dbc",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "navy",
label = "Navy",
showColour = "both",
value = "#001f3f",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "cyan",
label = "Cyan",
showColour = "both",
value = "#17a2b8",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "teal",
label = "Teal",
showColour = "both",
value = "#39cccc",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "olive",
label = "Olive",
showColour = "both",
value = "#3d9970",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "green",
label = "Green",
showColour = "both",
value = "#28a745",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "lime",
label = "Lime",
showColour = "both",
value = "#01ff70",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "orange",
label = "Orange",
showColour = "both",
value = "#ff851b",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "yellow",
label = "Yellow",
showColour = "both",
value = "#ffc107",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "fuchsia",
label = "Fuchsia",
showColour = "both",
value = "#f012be",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "purple",
label = "Purple",
showColour = "both",
value = "#605ca8",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "maroon",
label = "Maroon",
showColour = "both",
value = "#d81b60",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "red",
label = "Red",
showColour = "both",
value = "#dc3545",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "black",
label = "Black",
showColour = "both",
value = "#111",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "gray_x_light",
label = "Gray X Light",
showColour = "both",
value = "#d2d6de",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "gray_600",
label = "Gray 600",
showColour = "both",
value = "#6c757d",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "white",
label = "White",
showColour = "both",
value = "#ffffff",
allowTransparent = TRUE)),
)
),
miniUI::miniTabPanel(
"Color Contrast",
miniUI::miniContentPanel(
miniUI::miniContentPanel(
shiny::p("These variables allow to customize color",
" used if contrast between a color and its background is",
" under threshold. For example, it's used to choose text color ",
" written in bs4ValueBox with background defined by a status."),
stableColumnLayout(
shiny::numericInput(inputId = "contrasted_threshold",
label = periscope2::ui_tooltip(id = "contrasted_thresholdTip",
label = "Contrasted Threshold",
text = paste0("The yiq lightness value",
" that determines when the",
" lightness of color changes",
" from \"dark\" to \"light\"",
" Acceptable values are between 0 and
255.")),
value = NA,
min = 0,
max = 255),
colourpicker::colourInput(inputId = "text_dark",
label = periscope2::ui_tooltip(id = "text_darkTip",
label = "Text Dark",
text = "Dark text color"),
showColour = "both",
value = "#00000000",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "text_light",
label = periscope2::ui_tooltip(id = "light_darkTip",
label = "Text Light",
text = "Light text color"),
showColour = "both",
value = "#00000000",
allowTransparent = TRUE)
)
)
)
),
miniUI::miniTabPanel(
"Other Variables",
miniUI::miniContentPanel(
shiny::p("This is an advanced method to add or customize any more AdminLTE",
" or Bootstrap 4 variable in periscope2 generated application theme."),
shiny::tags$i("Please refer to ",
shiny::tags$a(href = "https://adminlte.io/docs/3.2/",
target = "_blank",
"AdminLTE"),
" or ",
shiny::tags$a(href = "https://getbootstrap.com/docs/4.0/getting-started/theming/",
target = "_blank",
"Bootstrap"),
" documentation for variables details info",
shiny::tags$br(),
shiny::tags$br()),
stableColumnLayout(shiny::tags$div(style = "margin-bottom: 30px;",
shiny::actionButton(inputId = "addVariable",
label = "Add Variable"))),
stableColumnLayout(shiny::tags$div(id = "variablesPlaceholder"))
)
)
),
stableColumnLayout(
miniUI::miniButtonBlock(
shiny::downloadButton(outputId = "downloadConfig",
label = periscope2::ui_tooltip(id = "downloadTip",
label = "Download periscope2 theme",
text = "Download theme configuration file and replace the file in the generated periscope app shiny_app/www folder")))
)
)
}
themeBuilder_addin_server <- function(id = NULL) {
shiny::moduleServer(
id,
function(input, output, session) {
variables <- fresh::search_vars_bs4dash()
added_variables <- shiny::reactiveVal(c())
ids <- shiny::reactiveVal(c(sample(NROW(variables))))
shiny::observeEvent(input$addVariable, {
variable_id <- ids()[1]
variable_row_id <- paste0(variable_id,"-variableRow")
variable_name_id <- paste0(variable_id,"-variableName")
variable_val_id <- paste0(variable_id,"-variableValue")
remove_btn_id <- paste0(variable_id,"-removeVariableBtn")
shiny::insertUI(
selector = "#variablesPlaceholder",
ui = shiny::tags$div(id = variable_row_id,
stableColumnLayout(
shiny::selectizeInput(inputId = variable_name_id,
label = "Select Variable",
choices = unique(variables$variable)),
shiny::textInput(inputId = variable_val_id,
label = "Value"),
shiny::actionButton(inputId = remove_btn_id,
label = NULL,
icon = shiny::icon("xmark"),
style = "margin-top: 25px;")))
)
ids(ids()[-which(ids() == variable_id)])
added_variables(c(added_variables(), variable_id))
shiny::observeEvent(input[[remove_btn_id]], {
variable_row_id <- paste0("#", variable_row_id)
shiny::removeUI(selector = variable_row_id, immediate = TRUE)
})
})
output$downloadConfig <- shiny::downloadHandler(
filename = function() {
"periscope_style.yaml"
},
content = function(theme_file) {
lines <- c()
status <- c()
sidebar_colors <- c()
sidebar_layout <- c()
main_colors <- c()
colors_contrast <- c()
other_variables <- c()
### Status colors
if (input$primary != "#00000000") {
status <- c(status, paste0("primary: \"", input$primary, "\""))
}
if (input$secondary != "#00000000") {
status <- c(status, paste0("secondary: \"", input$secondary, "\""))
}
if (input$success != "#00000000") {
status <- c(status, paste0("success: \"", input$success, "\""))
}
if (input$info != "#00000000") {
status <- c(status, paste0("info: \"", input$info, "\""))
}
if (input$warning != "#00000000") {
status <- c(status, paste0("warning: \"", input$warning, "\""))
}
if (input$danger != "#00000000") {
status <- c(status, paste0("danger: \"", input$danger, "\""))
}
if (input$light != "#00000000") {
status <- c(status, paste0("light: \"", input$light, "\""))
}
if (input$dark != "#00000000") {
status <- c(status, paste0("dark: \"", input$dark, "\""))
}
if (length(status) > 0) {
status <- c("# Status Colors",
"## Sets the status colors that affects the color of the header, valueBox, infoBox and box.",
"## Valid values are names of the color or hex-decimal value of the color (i.e,: \"blue\", \"#086A87\").",
"## Blank/empty values will use the default values",
status)
lines <- c(lines, status)
}
###### Sidebar colors
if (input$bg != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Background color"))
sidebar_colors <- c(sidebar_colors, paste0("bg: \"", input$bg, "\""))
}
if (input$hover_bg != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Hover background color"))
sidebar_colors <- c(sidebar_colors, paste0("hover_bg: \"", input$hover_bg, "\""))
}
if (input$color != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Color"))
sidebar_colors <- c(sidebar_colors, paste0("color: \"", input$color, "\""))
}
if (input$hover_color != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Hover color"))
sidebar_colors <- c(sidebar_colors, paste0("hover_color: \"", input$hover_color, "\""))
}
if (input$active_color != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Active color"))
sidebar_colors <- c(sidebar_colors, paste0("active_color: \"", input$active_color, "\""))
}
if (input$submenu_bg != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Submenu background color"))
sidebar_colors <- c(sidebar_colors, paste0("submenu_bg: \"", input$submenu_bg, "\""))
}
if (input$submenu_color != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Submenu color"))
sidebar_colors <- c(sidebar_colors, paste0("submenu_color: \"", input$submenu_color, "\""))
}
if (input$submenu_hover_color != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Submenu hover color"))
sidebar_colors <- c(sidebar_colors, paste0("submenu_hover_color: \"", input$submenu_hover_color, "\""))
}
if (input$submenu_hover_bg != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Submenu hover background color"))
sidebar_colors <- c(sidebar_colors, paste0("submenu_hover_bg: \"", input$submenu_hover_bg, "\""))
}
if (input$submenu_active_color != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Submenu active color"))
sidebar_colors <- c(sidebar_colors, paste0("submenu_active_color: \"", input$submenu_active_color, "\""))
}
if (input$submenu_active_bg != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Submenu active background color"))
sidebar_colors <- c(sidebar_colors, paste0("submenu_active_bg: \"", input$submenu_active_bg, "\""))
}
if (input$header_color != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Header color"))
sidebar_colors <- c(sidebar_colors, paste0("header_color: \"", input$header_color, "\""))
}
if (length(sidebar_colors) > 0) {
if (length(lines) > 0) {
lines <- c(lines, "\n")
}
sidebar_colors <- c("# Sidebar Colors",
"## Sidebar colors variables allow you to change sidebars (left and right) related colors",
"## Blank/empty values will use the default values",
sidebar_colors)
lines <- c(lines, sidebar_colors)
}
###### Sidebar Layout
if (!is.na(input$sidebar_width) && (input$sidebar_width != "")) {
sidebar_layout <- c(sidebar_layout, paste0("### Left Sidebar width"))
sidebar_layout <- c(sidebar_layout, paste0("sidebar_width: \"", input$sidebar_width, "\""))
}
if (!is.na(input$control_sidebar_width) && (input$control_sidebar_width != "")) {
sidebar_layout <- c(sidebar_layout, paste0("### Right Sidebar width"))
sidebar_layout <- c(sidebar_layout, paste0("control_sidebar_width: \"", input$control_sidebar_width, "\""))
}
if (!is.na(input$sidebar_padding_x) && (input$sidebar_padding_x != "")) {
sidebar_layout <- c(sidebar_layout, paste0("### Sidebar horizontal padding"))
sidebar_layout <- c(sidebar_layout, paste0("sidebar_padding_x: \"", input$sidebar_padding_x, "\""))
}
if (!is.na(input$sidebar_padding_y) && (input$sidebar_padding_y != "")) {
sidebar_layout <- c(sidebar_layout, paste0("### Sidebar vertical padding"))
sidebar_layout <- c(sidebar_layout, paste0("sidebar_padding_y: \"", input$sidebar_padding_y, "\""))
}
if (!is.na(input$sidebar_mini_width) && (input$sidebar_mini_width != "")) {
sidebar_layout <- c(sidebar_layout, paste0("### Width for mini sidebar"))
sidebar_layout <- c(sidebar_layout, paste0("sidebar_mini_width: \"", input$sidebar_mini_width, "\""))
}
if (length(sidebar_layout) > 0) {
if (length(lines) > 0) {
lines <- c(lines, "\n")
}
sidebar_layout <- c("# Sidebar Layout",
"## Sidebar colors variables allow you to change sidebars (left and right) related colors",
"## Blank/empty values will use the default values",
sidebar_layout)
lines <- c(lines, sidebar_layout)
}
###### Main colors
if (input$blue != "#00000000") {
main_colors <- c(main_colors, paste0("blue: \"", input$blue, "\""))
}
if (input$lightblue != "#00000000") {
main_colors <- c(main_colors, paste0("lightblue: \"", input$lightblue, "\""))
}
if (input$navy != "#00000000") {
main_colors <- c(main_colors, paste0("navy: \"", input$navy, "\""))
}
if (input$cyan != "#00000000") {
main_colors <- c(main_colors, paste0("cyan: \"", input$cyan, "\""))
}
if (input$teal != "#00000000") {
main_colors <- c(main_colors, paste0("teal: \"", input$teal, "\""))
}
if (input$olive != "#00000000") {
main_colors <- c(main_colors, paste0("olive: \"", input$olive, "\""))
}
if (input$green != "#00000000") {
main_colors <- c(main_colors, paste0("green: \"", input$green, "\""))
}
if (input$lime != "#00000000") {
main_colors <- c(main_colors, paste0("lime: \"", input$lime, "\""))
}
if (input$orange != "#00000000") {
main_colors <- c(main_colors, paste0("orange: \"", input$orange, "\""))
}
if (input$yellow != "#00000000") {
main_colors <- c(main_colors, paste0("yellow: \"", input$yellow, "\""))
}
if (input$fuchsia != "#00000000") {
main_colors <- c(main_colors, paste0("fuchsia: \"", input$fuchsia, "\""))
}
if (input$purple != "#00000000") {
main_colors <- c(main_colors, paste0("purple: \"", input$purple, "\""))
}
if (input$maroon != "#00000000") {
main_colors <- c(main_colors, paste0("maroon: \"", input$maroon, "\""))
}
if (input$red != "#00000000") {
main_colors <- c(main_colors, paste0("red: \"", input$red, "\""))
}
if (input$black != "#00000000") {
main_colors <- c(main_colors, paste0("black: \"", input$black, "\""))
}
if (input$gray_x_light != "#00000000") {
main_colors <- c(main_colors, paste0("gray_x_light: \"", input$gray_x_light, "\""))
}
if (input$gray_600 != "#00000000") {
main_colors <- c(main_colors, paste0("gray_600: \"", input$gray_600, "\""))
}
if (input$white != "#00000000") {
main_colors <- c(main_colors, paste0("white: \"", input$white, "\""))
}
if (length(main_colors) > 0) {
if (length(lines) > 0) {
lines <- c(lines, "\n")
}
main_colors <- c("# Main Colors",
"## Specify the specific hex codes for the following color words that can be referenced in the app.", main_colors)
lines <- c(lines, main_colors)
}
# colors contrast
if (!is.na(input$contrasted_threshold) && (input$contrasted_threshold != "")) {
colors_contrast <- c(colors_contrast, paste0("### The yiq lightness value that determines when the",
"### lightness of color changes from \"dark\" to \"light\".",
"Acceptable values are between 0 and 255"))
colors_contrast <- c(colors_contrast, paste0("contrasted_threshold: \"", input$contrasted_threshold, "\""))
}
if (input$text_dark != "#00000000") {
colors_contrast <- c(colors_contrast, paste0("### Dark text color"))
colors_contrast <- c(colors_contrast, paste0("text_dark: \"", input$text_dark, "\""))
}
if (input$text_light != "#00000000") {
colors_contrast <- c(colors_contrast, paste0("### Light text color"))
colors_contrast <- c(colors_contrast, paste0("text_light: \"", input$text_light, "\""))
}
if (length(colors_contrast) > 0) {
if (length(lines) > 0) {
lines <- c(lines, "\n")
}
colors_contrast <- c("# Colors Contrast",
"## These variables allow to customize color used if contrast between a color",
"## and its background is under threshold. For example, it's used to choose",
"## text color written in bs4ValueBox with background defined by a status.",
colors_contrast)
lines <- c(lines, colors_contrast)
}
# Other variables
if (length(added_variables()) > 0) {
for (var in added_variables()) {
name <- input[[paste0(var, "-variableName")]]
value <- input[[paste0(var, "-variableValue")]]
if (!is.na(name) && (name != "") &&
!is.na(value) && (value != "")) {
other_variables <- c(other_variables,
paste0("\"", name, "\": ", "\"", value, "\""))
}
}
}
if (length(other_variables) > 0) {
if (length(lines) > 0) {
lines <- c(lines, "\n")
}
other_variables <- c("# Other Variables",
"## Use any AdminLTE or Bootstrap variables to customize app theme",
other_variables)
lines <- c(lines, other_variables)
}
writeLines(lines, theme_file)
}
)
shiny::observeEvent(input$done, {
shiny::removeResourcePath(prefix = "img")
invisible(shiny::stopApp())
})
shiny::observeEvent(input$cancel, {
shiny::removeResourcePath(prefix = "img")
invisible(shiny::stopApp())
})
}
)
}
Try the periscope2 package in your browser
Any scripts or data that you put into this service are public.
periscope2 documentation built on April 15, 2025, 1:24 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions themeBuilder_addin_server themeBuilder_addin_UI themeConfigurationsAddin
Documented in themeConfigurationsAddin
#' Build application theme configuration YAML file
#'
#' Call this as an addin to build valid yaml file that is needed for creating application
#' periscope_style.yaml file. The generated file can be used in periscope2 app by putting it inside generated app www folder.
#'
#' The method can be called directly via `R` console or via RStudio addins menu
#'
#' @return launch gadget window
#'
#' @examples
#' if (interactive()) {
#' periscope2:::themeConfigurationsAddin()
#' }
#'
#' @seealso \link[periscope2:create_application]{periscope2:create_application()}
#'
#' @export
themeConfigurationsAddin <- function() {
if (!requireNamespace(c("miniUI", "colourpicker"), quietly = TRUE)) {
stop("You must have packages 'miniUI' and 'colourpicker' installed to use this add-in",
call. = FALSE)
}
shiny::runGadget(app = themeBuilder_addin_UI(),
server = function(input, output, session){
themeBuilder_addin_server()
},
viewer = shiny::browserViewer())
}
themeBuilder_addin_UI <- function() {
shiny::addResourcePath(prefix = "img",
directoryPath = system.file("fw_templ/www", package = "periscope2"))
miniUI::miniPage(
miniUI::gadgetTitleBar("Theme Configuration YAML File Builder"),
miniUI::miniTabstripPanel(
miniUI::miniTabPanel(
"Status Colors",
miniUI::miniContentPanel(
shiny::p("Specify the colors to used when the corresponding status argument in shiny UI elements such as infoBox, valueBox, cards are set."),
stableColumnLayout(
colourpicker::colourInput(inputId = "primary",
label = "Primary",
showColour = "both",
value = "#B221DD",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "secondary",
label = "Secondary",
showColour = "both",
value = "#6c757d",
allowTransparent = TRUE)),
stableColumnLayout(
colourpicker::colourInput(inputId = "success",
label = "Success",
showColour = "both",
value = "#2ED610",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "info",
label = "Info",
showColour = "both",
value = "#7BDFF2",
allowTransparent = TRUE)),
stableColumnLayout(
colourpicker::colourInput(inputId = "warning",
label = "Warning",
showColour = "both",
value = "#FFF200",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "danger",
label = "Danger",
showColour = "both",
value = "#CE0900",
allowTransparent = TRUE)),
stableColumnLayout(
colourpicker::colourInput(inputId = "light",
label = "Light",
showColour = "both",
value = "#f8f9fa",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "dark",
label = "Dark",
showColour = "both",
value = "#343a40",
allowTransparent = TRUE))
)
),
miniUI::miniTabPanel(
"Sidebar Colors",
miniUI::miniContentPanel(
shiny::p("Sidebar colors variables allow you to change sidebars (left and right) related colors"),
shiny::tags$i("Use value \"#00000000\" to reset back to original theme default color"),
stableColumnLayout(colourpicker::colourInput(inputId = "bg",
label = "Background Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "hover_bg",
label = "Hover Background Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "color",
label = "Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "hover_color",
label = "Hover Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "active_color",
label = "Active Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "submenu_bg",
label = "Submenu Background Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "submenu_color",
label = "Submenu Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "submenu_hover_color",
label = "Submenu Hover Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "submenu_hover_bg",
label = "Submenu Hover Background Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "submenu_active_color",
label = "Submenu Active Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "submenu_active_bg",
label = "Submenu Active Background Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "header_color",
label = "Header Color",
showColour = "both",
value = "#00000000",
allowTransparent = TRUE))
)
),
miniUI::miniTabPanel(
"Sidebar Layout",
miniUI::miniContentPanel(
shiny::p("Sidebar layout variables allow you to change sidebars (left and right) width, padding, ...",
shiny::tags$br(),
shiny::tags$i("All units are in pixels")),
stableColumnLayout(shiny::numericInput(inputId = "sidebar_width",
label = "Left Sidebar Width",
value = NA),
shiny::numericInput(inputId = "control_sidebar_width",
label = "Right Sidebar Width",
value = NA)),
stableColumnLayout(shiny::numericInput(inputId = "sidebar_padding_x",
label = "Sidebar Horizontal Padding",
value = NA),
shiny::numericInput(inputId = "sidebar_padding_y",
label = "Sidebar Vertical Padding",
value = NA)),
stableColumnLayout(shiny::numericInput(inputId = "sidebar_mini_width",
label = periscope2::ui_tooltip(id = "textTip",
label = "Width for mini sidebar",
text = paste("Left sidebar can be minimized to show menu icons (and not to be fully collapsed).",
"That property controls the width of the minimized sidebar.",
sep = "<br/><br/>"),
placement = "bottom"),
value = NA))
)
),
miniUI::miniTabPanel(
"Main Colors",
miniUI::miniContentPanel(
shiny::p("Specify the specific hex codes for the following color words that can be referenced in the app."),
stableColumnLayout(colourpicker::colourInput(inputId = "blue",
label = "Blue",
showColour = "both",
value = "#007bff",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "lightblue",
label = "Light Blue",
showColour = "both",
value = "#3c8dbc",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "navy",
label = "Navy",
showColour = "both",
value = "#001f3f",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "cyan",
label = "Cyan",
showColour = "both",
value = "#17a2b8",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "teal",
label = "Teal",
showColour = "both",
value = "#39cccc",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "olive",
label = "Olive",
showColour = "both",
value = "#3d9970",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "green",
label = "Green",
showColour = "both",
value = "#28a745",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "lime",
label = "Lime",
showColour = "both",
value = "#01ff70",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "orange",
label = "Orange",
showColour = "both",
value = "#ff851b",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "yellow",
label = "Yellow",
showColour = "both",
value = "#ffc107",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "fuchsia",
label = "Fuchsia",
showColour = "both",
value = "#f012be",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "purple",
label = "Purple",
showColour = "both",
value = "#605ca8",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "maroon",
label = "Maroon",
showColour = "both",
value = "#d81b60",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "red",
label = "Red",
showColour = "both",
value = "#dc3545",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "black",
label = "Black",
showColour = "both",
value = "#111",
allowTransparent = TRUE)),
stableColumnLayout(colourpicker::colourInput(inputId = "gray_x_light",
label = "Gray X Light",
showColour = "both",
value = "#d2d6de",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "gray_600",
label = "Gray 600",
showColour = "both",
value = "#6c757d",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "white",
label = "White",
showColour = "both",
value = "#ffffff",
allowTransparent = TRUE)),
)
),
miniUI::miniTabPanel(
"Color Contrast",
miniUI::miniContentPanel(
miniUI::miniContentPanel(
shiny::p("These variables allow to customize color",
" used if contrast between a color and its background is",
" under threshold. For example, it's used to choose text color ",
" written in bs4ValueBox with background defined by a status."),
stableColumnLayout(
shiny::numericInput(inputId = "contrasted_threshold",
label = periscope2::ui_tooltip(id = "contrasted_thresholdTip",
label = "Contrasted Threshold",
text = paste0("The yiq lightness value",
" that determines when the",
" lightness of color changes",
" from \"dark\" to \"light\"",
" Acceptable values are between 0 and
255.")),
value = NA,
min = 0,
max = 255),
colourpicker::colourInput(inputId = "text_dark",
label = periscope2::ui_tooltip(id = "text_darkTip",
label = "Text Dark",
text = "Dark text color"),
showColour = "both",
value = "#00000000",
allowTransparent = TRUE),
colourpicker::colourInput(inputId = "text_light",
label = periscope2::ui_tooltip(id = "light_darkTip",
label = "Text Light",
text = "Light text color"),
showColour = "both",
value = "#00000000",
allowTransparent = TRUE)
)
)
)
),
miniUI::miniTabPanel(
"Other Variables",
miniUI::miniContentPanel(
shiny::p("This is an advanced method to add or customize any more AdminLTE",
" or Bootstrap 4 variable in periscope2 generated application theme."),
shiny::tags$i("Please refer to ",
shiny::tags$a(href = "https://adminlte.io/docs/3.2/",
target = "_blank",
"AdminLTE"),
" or ",
shiny::tags$a(href = "https://getbootstrap.com/docs/4.0/getting-started/theming/",
target = "_blank",
"Bootstrap"),
" documentation for variables details info",
shiny::tags$br(),
shiny::tags$br()),
stableColumnLayout(shiny::tags$div(style = "margin-bottom: 30px;",
shiny::actionButton(inputId = "addVariable",
label = "Add Variable"))),
stableColumnLayout(shiny::tags$div(id = "variablesPlaceholder"))
)
)
),
stableColumnLayout(
miniUI::miniButtonBlock(
shiny::downloadButton(outputId = "downloadConfig",
label = periscope2::ui_tooltip(id = "downloadTip",
label = "Download periscope2 theme",
text = "Download theme configuration file and replace the file in the generated periscope app shiny_app/www folder")))
)
)
}
themeBuilder_addin_server <- function(id = NULL) {
shiny::moduleServer(
id,
function(input, output, session) {
variables <- fresh::search_vars_bs4dash()
added_variables <- shiny::reactiveVal(c())
ids <- shiny::reactiveVal(c(sample(NROW(variables))))
shiny::observeEvent(input$addVariable, {
variable_id <- ids()[1]
variable_row_id <- paste0(variable_id,"-variableRow")
variable_name_id <- paste0(variable_id,"-variableName")
variable_val_id <- paste0(variable_id,"-variableValue")
remove_btn_id <- paste0(variable_id,"-removeVariableBtn")
shiny::insertUI(
selector = "#variablesPlaceholder",
ui = shiny::tags$div(id = variable_row_id,
stableColumnLayout(
shiny::selectizeInput(inputId = variable_name_id,
label = "Select Variable",
choices = unique(variables$variable)),
shiny::textInput(inputId = variable_val_id,
label = "Value"),
shiny::actionButton(inputId = remove_btn_id,
label = NULL,
icon = shiny::icon("xmark"),
style = "margin-top: 25px;")))
)
ids(ids()[-which(ids() == variable_id)])
added_variables(c(added_variables(), variable_id))
shiny::observeEvent(input[[remove_btn_id]], {
variable_row_id <- paste0("#", variable_row_id)
shiny::removeUI(selector = variable_row_id, immediate = TRUE)
})
})
output$downloadConfig <- shiny::downloadHandler(
filename = function() {
"periscope_style.yaml"
},
content = function(theme_file) {
lines <- c()
status <- c()
sidebar_colors <- c()
sidebar_layout <- c()
main_colors <- c()
colors_contrast <- c()
other_variables <- c()
### Status colors
if (input$primary != "#00000000") {
status <- c(status, paste0("primary: \"", input$primary, "\""))
}
if (input$secondary != "#00000000") {
status <- c(status, paste0("secondary: \"", input$secondary, "\""))
}
if (input$success != "#00000000") {
status <- c(status, paste0("success: \"", input$success, "\""))
}
if (input$info != "#00000000") {
status <- c(status, paste0("info: \"", input$info, "\""))
}
if (input$warning != "#00000000") {
status <- c(status, paste0("warning: \"", input$warning, "\""))
}
if (input$danger != "#00000000") {
status <- c(status, paste0("danger: \"", input$danger, "\""))
}
if (input$light != "#00000000") {
status <- c(status, paste0("light: \"", input$light, "\""))
}
if (input$dark != "#00000000") {
status <- c(status, paste0("dark: \"", input$dark, "\""))
}
if (length(status) > 0) {
status <- c("# Status Colors",
"## Sets the status colors that affects the color of the header, valueBox, infoBox and box.",
"## Valid values are names of the color or hex-decimal value of the color (i.e,: \"blue\", \"#086A87\").",
"## Blank/empty values will use the default values",
status)
lines <- c(lines, status)
}
###### Sidebar colors
if (input$bg != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Background color"))
sidebar_colors <- c(sidebar_colors, paste0("bg: \"", input$bg, "\""))
}
if (input$hover_bg != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Hover background color"))
sidebar_colors <- c(sidebar_colors, paste0("hover_bg: \"", input$hover_bg, "\""))
}
if (input$color != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Color"))
sidebar_colors <- c(sidebar_colors, paste0("color: \"", input$color, "\""))
}
if (input$hover_color != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Hover color"))
sidebar_colors <- c(sidebar_colors, paste0("hover_color: \"", input$hover_color, "\""))
}
if (input$active_color != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Active color"))
sidebar_colors <- c(sidebar_colors, paste0("active_color: \"", input$active_color, "\""))
}
if (input$submenu_bg != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Submenu background color"))
sidebar_colors <- c(sidebar_colors, paste0("submenu_bg: \"", input$submenu_bg, "\""))
}
if (input$submenu_color != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Submenu color"))
sidebar_colors <- c(sidebar_colors, paste0("submenu_color: \"", input$submenu_color, "\""))
}
if (input$submenu_hover_color != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Submenu hover color"))
sidebar_colors <- c(sidebar_colors, paste0("submenu_hover_color: \"", input$submenu_hover_color, "\""))
}
if (input$submenu_hover_bg != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Submenu hover background color"))
sidebar_colors <- c(sidebar_colors, paste0("submenu_hover_bg: \"", input$submenu_hover_bg, "\""))
}
if (input$submenu_active_color != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Submenu active color"))
sidebar_colors <- c(sidebar_colors, paste0("submenu_active_color: \"", input$submenu_active_color, "\""))
}
if (input$submenu_active_bg != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Submenu active background color"))
sidebar_colors <- c(sidebar_colors, paste0("submenu_active_bg: \"", input$submenu_active_bg, "\""))
}
if (input$header_color != "#00000000") {
sidebar_colors <- c(sidebar_colors, paste0("### Header color"))
sidebar_colors <- c(sidebar_colors, paste0("header_color: \"", input$header_color, "\""))
}
if (length(sidebar_colors) > 0) {
if (length(lines) > 0) {
lines <- c(lines, "\n")
}
sidebar_colors <- c("# Sidebar Colors",
"## Sidebar colors variables allow you to change sidebars (left and right) related colors",
"## Blank/empty values will use the default values",
sidebar_colors)
lines <- c(lines, sidebar_colors)
}
###### Sidebar Layout
if (!is.na(input$sidebar_width) && (input$sidebar_width != "")) {
sidebar_layout <- c(sidebar_layout, paste0("### Left Sidebar width"))
sidebar_layout <- c(sidebar_layout, paste0("sidebar_width: \"", input$sidebar_width, "\""))
}
if (!is.na(input$control_sidebar_width) && (input$control_sidebar_width != "")) {
sidebar_layout <- c(sidebar_layout, paste0("### Right Sidebar width"))
sidebar_layout <- c(sidebar_layout, paste0("control_sidebar_width: \"", input$control_sidebar_width, "\""))
}
if (!is.na(input$sidebar_padding_x) && (input$sidebar_padding_x != "")) {
sidebar_layout <- c(sidebar_layout, paste0("### Sidebar horizontal padding"))
sidebar_layout <- c(sidebar_layout, paste0("sidebar_padding_x: \"", input$sidebar_padding_x, "\""))
}
if (!is.na(input$sidebar_padding_y) && (input$sidebar_padding_y != "")) {
sidebar_layout <- c(sidebar_layout, paste0("### Sidebar vertical padding"))
sidebar_layout <- c(sidebar_layout, paste0("sidebar_padding_y: \"", input$sidebar_padding_y, "\""))
}
if (!is.na(input$sidebar_mini_width) && (input$sidebar_mini_width != "")) {
sidebar_layout <- c(sidebar_layout, paste0("### Width for mini sidebar"))
sidebar_layout <- c(sidebar_layout, paste0("sidebar_mini_width: \"", input$sidebar_mini_width, "\""))
}
if (length(sidebar_layout) > 0) {
if (length(lines) > 0) {
lines <- c(lines, "\n")
}
sidebar_layout <- c("# Sidebar Layout",
"## Sidebar colors variables allow you to change sidebars (left and right) related colors",
"## Blank/empty values will use the default values",
sidebar_layout)
lines <- c(lines, sidebar_layout)
}
###### Main colors
if (input$blue != "#00000000") {
main_colors <- c(main_colors, paste0("blue: \"", input$blue, "\""))
}
if (input$lightblue != "#00000000") {
main_colors <- c(main_colors, paste0("lightblue: \"", input$lightblue, "\""))
}
if (input$navy != "#00000000") {
main_colors <- c(main_colors, paste0("navy: \"", input$navy, "\""))
}
if (input$cyan != "#00000000") {
main_colors <- c(main_colors, paste0("cyan: \"", input$cyan, "\""))
}
if (input$teal != "#00000000") {
main_colors <- c(main_colors, paste0("teal: \"", input$teal, "\""))
}
if (input$olive != "#00000000") {
main_colors <- c(main_colors, paste0("olive: \"", input$olive, "\""))
}
if (input$green != "#00000000") {
main_colors <- c(main_colors, paste0("green: \"", input$green, "\""))
}
if (input$lime != "#00000000") {
main_colors <- c(main_colors, paste0("lime: \"", input$lime, "\""))
}
if (input$orange != "#00000000") {
main_colors <- c(main_colors, paste0("orange: \"", input$orange, "\""))
}
if (input$yellow != "#00000000") {
main_colors <- c(main_colors, paste0("yellow: \"", input$yellow, "\""))
}
if (input$fuchsia != "#00000000") {
main_colors <- c(main_colors, paste0("fuchsia: \"", input$fuchsia, "\""))
}
if (input$purple != "#00000000") {
main_colors <- c(main_colors, paste0("purple: \"", input$purple, "\""))
}
if (input$maroon != "#00000000") {
main_colors <- c(main_colors, paste0("maroon: \"", input$maroon, "\""))
}
if (input$red != "#00000000") {
main_colors <- c(main_colors, paste0("red: \"", input$red, "\""))
}
if (input$black != "#00000000") {
main_colors <- c(main_colors, paste0("black: \"", input$black, "\""))
}
if (input$gray_x_light != "#00000000") {
main_colors <- c(main_colors, paste0("gray_x_light: \"", input$gray_x_light, "\""))
}
if (input$gray_600 != "#00000000") {
main_colors <- c(main_colors, paste0("gray_600: \"", input$gray_600, "\""))
}
if (input$white != "#00000000") {
main_colors <- c(main_colors, paste0("white: \"", input$white, "\""))
}
if (length(main_colors) > 0) {
if (length(lines) > 0) {
lines <- c(lines, "\n")
}
main_colors <- c("# Main Colors",
"## Specify the specific hex codes for the following color words that can be referenced in the app.", main_colors)
lines <- c(lines, main_colors)
}
# colors contrast
if (!is.na(input$contrasted_threshold) && (input$contrasted_threshold != "")) {
colors_contrast <- c(colors_contrast, paste0("### The yiq lightness value that determines when the",
"### lightness of color changes from \"dark\" to \"light\".",
"Acceptable values are between 0 and 255"))
colors_contrast <- c(colors_contrast, paste0("contrasted_threshold: \"", input$contrasted_threshold, "\""))
}
if (input$text_dark != "#00000000") {
colors_contrast <- c(colors_contrast, paste0("### Dark text color"))
colors_contrast <- c(colors_contrast, paste0("text_dark: \"", input$text_dark, "\""))
}
if (input$text_light != "#00000000") {
colors_contrast <- c(colors_contrast, paste0("### Light text color"))
colors_contrast <- c(colors_contrast, paste0("text_light: \"", input$text_light, "\""))
}
if (length(colors_contrast) > 0) {
if (length(lines) > 0) {
lines <- c(lines, "\n")
}
colors_contrast <- c("# Colors Contrast",
"## These variables allow to customize color used if contrast between a color",
"## and its background is under threshold. For example, it's used to choose",
"## text color written in bs4ValueBox with background defined by a status.",
colors_contrast)
lines <- c(lines, colors_contrast)
}
# Other variables
if (length(added_variables()) > 0) {
for (var in added_variables()) {
name <- input[[paste0(var, "-variableName")]]
value <- input[[paste0(var, "-variableValue")]]
if (!is.na(name) && (name != "") &&
!is.na(value) && (value != "")) {
other_variables <- c(other_variables,
paste0("\"", name, "\": ", "\"", value, "\""))
}
}
}
if (length(other_variables) > 0) {
if (length(lines) > 0) {
lines <- c(lines, "\n")
}
other_variables <- c("# Other Variables",
"## Use any AdminLTE or Bootstrap variables to customize app theme",
other_variables)
lines <- c(lines, other_variables)
}
writeLines(lines, theme_file)
}
)
shiny::observeEvent(input$done, {
shiny::removeResourcePath(prefix = "img")
invisible(shiny::stopApp())
})
shiny::observeEvent(input$cancel, {
shiny::removeResourcePath(prefix = "img")
invisible(shiny::stopApp())
})
}
)
}
Try the periscope2 package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.