Skip to content

Commit 7c72c6d

Browse files
authored
feat(build-a-box): Add example value box builder app (#790)
1 parent 7d7b6e9 commit 7c72c6d

23 files changed

+1289
-12
lines changed

.github/workflows/R-CMD-check.yaml

Lines changed: 13 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -40,10 +40,6 @@ jobs:
4040
- name: Install bslib from GitHub
4141
shell: Rscript {0}
4242
run: |
43-
# rsconnect 1.0 introduced an issue with deploying from CI
44-
# Once a proper fix is CRAN, we can go back install.packages
45-
if (!require('remotes')) install.packages('remotes')
46-
remotes::install_version("rsconnect", "0.8.29")
4743
pak::pkg_install("rstudio/bslib", dependencies = TRUE, upgrade = TRUE)
4844
4945
# Workaround for this (probably spurious error):
@@ -58,18 +54,26 @@ jobs:
5854
run: |
5955
install.packages("cpp11")
6056
61-
- name: Register account
57+
- name: Register account(s)
6258
shell: Rscript {0}
6359
run: |
6460
rsconnect::setAccountInfo(
6561
name = '${{ secrets.SHINYAPPS_NAME }}',
6662
token = '${{ secrets.SHINYAPPS_TOKEN }}',
6763
secret = '${{ secrets.SHINYAPPS_SECRET }}'
6864
)
65+
rsconnect::setAccountInfo(
66+
name = 'bslib',
67+
token = '${{ secrets.SHINYAPPS_BSLIB_TOKEN }}',
68+
secret = '${{ secrets.SHINYAPPS_BSLIB_SECRET }}'
69+
)
6970
7071
- name: Deploy
72+
shell: bash
7173
run: |
72-
Rscript 'inst/themer-demo/deploy.R'
73-
Rscript 'inst/examples/card/deploy.R'
74-
Rscript 'inst/examples/value_box/deploy.R'
75-
Rscript 'inst/examples/flights/deploy.R'
74+
deployScripts=$(find inst -name "deploy.R" -type f)
75+
76+
for deployScript in $deployScripts; do
77+
echo "Deploying $deployScript"
78+
Rscript $deployScript
79+
done

DESCRIPTION

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -57,6 +57,8 @@ Remotes:
5757
rstudio/htmltools
5858
Config/Needs/deploy:
5959
BH,
60+
colourpicker,
61+
commonmark,
6062
cpp11,
6163
dplyr,
6264
DT,
@@ -65,6 +67,7 @@ Config/Needs/deploy:
6567
gt,
6668
hexbin,
6769
histoslider,
70+
htmlwidgets,
6871
lattice,
6972
leaflet,
7073
lubridate,
@@ -75,9 +78,12 @@ Config/Needs/deploy:
7578
reshape2,
7679
rprojroot,
7780
rsconnect,
78-
scales
81+
rstudio/shiny,
82+
scales,
83+
styler,
84+
tibble
7985
Config/Needs/routine: chromote, desc, renv
80-
Config/Needs/website:
86+
Config/Needs/website:
8187
brio,
8288
crosstalk,
8389
dplyr,

NEWS.md

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,8 @@
2323

2424
* The `showcase_layout` argument of `value_box()` now accepts one of three character values: `"left center"`, `"top right"`, `"bottom"`. (#758)
2525

26+
* A new [Build a Box app](https://bslib.shinyapps.io/build-a-box/) is now available online or via bslib. See `?value_box()` for details. The app helps preview a set of value boxes while you configure and customize their appearance and provides you with code to copy and paste into your app. (#790)
27+
2628
* Added `input_dark_mode()`, a new input control that provides a toggle button that can be used to switch between the dark and light modes when using Bootstrap 5.3. By default, dark mode is applied automatically if the user's operating system is also in dark mode. App authors can toggle dark mode programmatically from the server using `toggle_dark_mode()`, and if you provide `input_dark_mode()` with an `id`, you can read the current color mode via the corresponding input value. (#787)
2729

2830
## Improvements

R/sysdata.rda

223 Bytes
Binary file not shown.

R/value-box.R

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,17 @@
55
#' `value` represents (for example, it could hold a [bsicons::bs_icon()], or
66
#' even a [shiny::plotOutput()]).
77
#'
8+
#' @section Build a Box App:
9+
#'
10+
#' Explore all of the `value_box()` options and layouts interactively with the
11+
#' [Build a Box app](https://bslib.shinyapps.io/build-a-box/), available
12+
#' online thanks to [shinyapps.io](https://www.shinyapps.io/). Or, you can
13+
#' run the app locally with:
14+
#'
15+
#' ```r
16+
#' shiny::runApp(system.file("examples", "build-a-box", package = "bslib"))
17+
#' ```
18+
#'
819
#' @section Themes:
920
#'
1021
#' ```{r child="man/fragments/value-box-themes.Rmd"}
Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
code_modal <- function(code) {
2+
if (rlang::is_call(code)) {
3+
code <- rlang::expr_text(code)
4+
}
5+
6+
if (requireNamespace("styler", quietly = TRUE)) {
7+
code <- styler::style_text(code)
8+
}
9+
10+
code <- paste(code, collapse = "\n")
11+
12+
showModal(
13+
modalDialog(
14+
HTML(sprintf(
15+
'<pre><code id="value-box-code">%s</code></pre>',
16+
code
17+
)),
18+
p(
19+
id = "copy-clipboard-not-supported",
20+
class = "text-muted d-none",
21+
HTML("Press <kbd>Ctrl</kbd>/<kbd>Cmd</kbd> + <kbd>C</kbd> to copy the value box example code.")
22+
),
23+
tags$button(
24+
id = "copy-code-to-clipboard",
25+
class = "btn btn-outline-primary",
26+
onclick = "copyValueBoxCode()",
27+
"Copy to clipboard"
28+
),
29+
singleton(tags$script(src = "code-modal.js")),
30+
footer = modalButton("Done"),
31+
easyClose = TRUE
32+
)
33+
)
34+
}
Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
theme_colors <- list(
2+
"primary",
3+
"secondary",
4+
"success",
5+
"danger",
6+
"warning",
7+
"info",
8+
"light",
9+
"dark"
10+
)
11+
12+
named_colors <- c(
13+
"blue",
14+
"indigo",
15+
"purple",
16+
"pink",
17+
"red",
18+
"orange",
19+
"yellow",
20+
"green",
21+
"teal",
22+
"cyan"
23+
)
24+
25+
gc <- expand.grid(named_colors, named_colors)
26+
gc <- gc[gc$Var1 != gc$Var2,]
27+
gradient_classes <- sprintf("bg-gradient-%s-%s", gc$Var1, gc$Var2)
28+
29+
30+
all_themes <- c(
31+
"Default" = "",
32+
theme_colors,
33+
named_colors,
34+
paste0("text-", theme_colors),
35+
paste0("text-", named_colors),
36+
sort(gradient_classes)
37+
)
Lines changed: 123 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,123 @@
1+
ui_global_controls <- function(id) {
2+
ns <- shiny::NS(id)
3+
4+
tagList(
5+
layout_columns(
6+
class = "align-items-end",
7+
selectizeInput(
8+
ns("theme_style"),
9+
"Theme style",
10+
list(
11+
"Default" = "default",
12+
"All" = "all",
13+
"Semantic Colors" = list(
14+
"Semantic Background" = "semantic-bg",
15+
"Semantic Text" = "semantic-fg"
16+
),
17+
"Theme Colors" = list(
18+
"Colored Background" = "colors-bg",
19+
"Colored Text" = "colors-fg"
20+
),
21+
"Vibrant" = list(
22+
"Gradient Background" = "gradient"
23+
)
24+
)
25+
),
26+
shuffleButton(ns("random_theme"), "Theme"),
27+
shuffleButton(ns("random_stat"), "Stats")
28+
),
29+
layout_columns(
30+
class = "align-items-start",
31+
div(
32+
radioButtons(
33+
ns("showcase_item"),
34+
"Showcase Item",
35+
choices = c("Plot", "Icon"),
36+
inline = TRUE
37+
),
38+
conditionalPanel(
39+
"input.showcase_item == 'Plot'",
40+
ns = ns,
41+
p(
42+
class = "text-muted",
43+
"See",
44+
tags$a(href = "https://rstudio.github.io/bslib/articles/value-boxes/index.html#expandable-sparklines", "Expandable Sparklines"),
45+
"for example plot code."
46+
)
47+
),
48+
conditionalPanel(
49+
"input.showcase_item == 'Icon'",
50+
ns = ns,
51+
shuffleButton(ns("random_icon"), "Icons")
52+
)
53+
),
54+
radioButtons(
55+
ns("showcase_layout"),
56+
"Showcase Layout",
57+
choices = c("Left center", "Top right", "Bottom"),
58+
inline = TRUE
59+
)
60+
)
61+
)
62+
}
63+
64+
server_global_controls <- function(input, output, sessions, one, two, three) {
65+
observeEvent(c(input$random_theme, input$theme_style), {
66+
new_values <- switch(
67+
input$theme_style,
68+
all = {
69+
one$theme$shuffle()
70+
two$theme$shuffle()
71+
three$theme$shuffle()
72+
NULL
73+
},
74+
default = {
75+
one$theme$set("Default")
76+
two$theme$set("Default")
77+
three$theme$set("Default")
78+
NULL
79+
},
80+
"semantic-bg" = sample(setdiff(theme_colors, c("light", "dark")), 3),
81+
"semantic-fg" = paste0("text-", sample(setdiff(theme_colors, c("light", "dark")), 3)),
82+
"colors-bg" = sample(named_colors, 3, replace = TRUE),
83+
"colors-fg" = paste0("text-", sample(named_colors, 3, replace = TRUE)),
84+
gradient = sample(gradient_classes, 3)
85+
)
86+
87+
if (is.null(new_values)) return()
88+
89+
one$theme$set(new_values[[1]])
90+
two$theme$set(new_values[[2]])
91+
three$theme$set(new_values[[3]])
92+
}, ignoreInit = TRUE)
93+
94+
observeEvent(input$random_stat, {
95+
one$random_stat()
96+
two$random_stat()
97+
three$random_stat()
98+
})
99+
100+
observeEvent(input$random_icon, {
101+
one$showcase_icon$shuffle()
102+
two$showcase_icon$shuffle()
103+
three$showcase_icon$shuffle()
104+
})
105+
106+
observeEvent(input$showcase_item, {
107+
item <- tolower(input$showcase_item)
108+
one$set_showcase_item(item)
109+
two$set_showcase_item(item)
110+
three$set_showcase_item(item)
111+
}, ignoreInit = TRUE)
112+
113+
observeEvent(input$showcase_layout, {
114+
layout <- tolower(input$showcase_layout)
115+
one$set_showcase_layout(layout)
116+
two$set_showcase_layout(layout)
117+
three$set_showcase_layout(layout)
118+
}, ignoreInit = TRUE)
119+
}
120+
121+
module_global_controls <- function(id, one, two, three) {
122+
callModule(server_global_controls, id, one = one, two = two, three = three)
123+
}

0 commit comments

Comments
 (0)