[WIP] progress bar in infoBox

R/boxes.R

@@ -41,7 +41,7 @@ valueBox <- function(value, subtitle, icon = NULL, color = "aqua", width = 4,
 
 #' Create an info box for the main body of a dashboard.
 #'
-#' An info box displays a large icon on the left side, and a title, value
+#' @description An info box displays a large icon on the left side, and a title, value
 #' (usually a number), and an optional smaller subtitle on the right side. Info
 #' boxes are meant to be placed in the main body of a dashboard.
 #'
@@ -58,14 +58,18 @@ valueBox <- function(value, subtitle, icon = NULL, color = "aqua", width = 4,
 #'   content; the icon will use the same color with a slightly darkened
 #'   background.
 #' @param href An optional URL to link to.
+#' @param progressBar If \code{FALSE} (the default), does not add a progress bar
+#'   below the \code{value} parameter.
+#' @param progressBarValue A numeric value to display in the progress bar. Must
+#'   be between zero percent and 100 percent (without the percent sign). See examples.
 #'
 #' @family boxes
 #' @seealso \code{\link{box}} for usage examples.
 #'
 #' @export
 infoBox <- function(title, value = NULL, subtitle = NULL,
   icon = shiny::icon("bar-chart"), color = "aqua", width = 4, href = NULL,
-  fill = FALSE) {
+  fill = FALSE, progressBar = FALSE, progressBarValue = NULL) {
 
   validateColor(color)
   tagAssert(icon, type = "i")
@@ -83,7 +87,12 @@ infoBox <- function(title, value = NULL, subtitle = NULL,
     div(class = "info-box-content",
       span(class = "info-box-text", title),
       if (!is.null(value)) span(class = "info-box-number", value),
-      if (!is.null(subtitle)) p(subtitle)
+      # if (progressBar) div(class = "progress", div(class = "progress-bar", style = progressBarValue)),
+      # if (progressBar) div(class = "progress", div(class = "progress-bar", style =
+      #                                                paste0("width: ", progressBarValue, "%; height: 2px;"))),
+
+      if (progressBar) div(class = "progress", progressBarValue),
+      if (!is.null(subtitle)) span(class = "progress-description", subtitle)
     )
   )
 

tests-manual/box.R

@@ -1,23 +1,25 @@
 # A dashboard body with a row of infoBoxes and valueBoxes, and two rows of other boxes
 
 library(shiny)
+library(shinydashboard)
+
 body <- dashboardBody(
 
-  # infoBoxes
+  # infoBoxes -> first row
   fluidRow(
     infoBox(
-      "Orders", uiOutput("orderNum2"), "Subtitle", icon = icon("credit-card")
+      "Orders", uiOutput("orderNum2"), subtitle = "Test", icon = icon("credit-card"),
+      progressBar = T, fill = T, progressBarValue = uiOutput("progressBarValue")
     ),
     infoBox(
-      "Approval Rating", "60%", icon = icon("line-chart"), color = "green",
-      fill = TRUE
+      "Approval Rating", "60%", icon = icon("line-chart"), color = "green", fill = TRUE
     ),
     infoBox(
       "Progress", uiOutput("progress2"), icon = icon("users"), color = "purple"
     )
   ),
 
-  # valueBoxes
+  # valueBoxes -> second row
   fluidRow(
     valueBox(
       uiOutput("orderNum"), "New Orders", icon = icon("credit-card"),
@@ -90,6 +92,17 @@ server <- function(input, output) {
     paste0(input$progress, "%")
   })
 
+  output$progressBarValue <- renderUI({
+    # input$progress
+    # numberPercent <- paste0("width: ", input$progress, "%")
+    # div(class = "progress", div(class = "progress-bar", style = numberPercent))
+
+    div(class = "progress-bar", style = paste0("width: ", input$progress, "%; height: 2px;"))
+    # tagList(style = paste0("width: ", input$progress, "%; height: 2px;"))
+
+    # paste0("width: ", input$progress, "%; height: 2px;")
+  })
+
   output$status <- renderText({
     paste0("There are ", input$orders,
            " orders, and so the current progress is ", input$progress, "%.")