R/misc.R

In card.pro: Lightweight Modern & Responsive Card Component for 'shiny'

#' Generate a row div
#'
#' A simple row div
#'
#' @param ... The elements to include within the body of the row
#'
#' @return An HTML containing elements of a container with class row to be embedded in a page
#' @examples
#' row(shiny::div(width=12,"Hello nextGenShinyApps"))
#' @export
#'
row <- function(...) {
  htmltools::tags$div(class = "row card-pro-row", ...)
}


#' Include stylesheets and scripts
#'
#' Use the package scripts and stylesheets in a page
#'
#' @param theme The template type
#' @param template template folder
#' @param jquery option. logical. include jquery
#' @param jqueryui option. logical. include jquery UI
#' @param fontawesome option. logical. include fontawesome
#' @param fix.header logical. fix header if titlePanel2() is used in UI
#'
#' @note
#' Theme options are "a", "b", "c", "d" or "e"
#'
#' @return A list of files to be inserted in the header of a page
#' @examples
#' if(interactive()){
#' use.cardpro()
#' use.cardpro(theme="a",jqueryui = TRUE, fontawesome = FALSE)
#' }
#' @export
#'
use.cardpro <-
  function(theme = letters[1:5],
           jquery = FALSE,
           jqueryui = TRUE,
           fontawesome = FALSE,
           template = "bundle",
           fix.header = FALSE
           ) {
    fxhdr = ifelse(fix.header," fixed-header","")
    p.v = 2.1
    j = ju = fa = NULL
    if (jquery)
      j = "opt/jquery-3.7.1.min.js"
    if (jqueryui)
      ju = "opt/bjquery-ui.min.js"
    theme = match.arg(theme)
    list(
      htmltools::tags$script(
        paste0(
          "document.body.className = document.body.className+'",fxhdr," fixed-page-footer smart-style-",
          switch (
            theme,
            a = "1';",
            b = "6';",
            c = "2';",
            d = "3';",
            e = "4';"
          )
        )
      ),
      if(file.exists("www/myscript.js")){htmltools::tags$script(src="myscript.js")},
      if(file.exists("www/myscript.css")){htmltools::tags$link(rel="stylesheet", type="text/css", href="myscript.css")},
      htmltools::tags$link(
        href = ifelse(
          fontawesome,
          "https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.6.0/css/fontawesome.min.css",
          ""
        )
      ),
      htmltools::htmlDependency(
        .packageName,
        p.v,
        src = template.loc(template),
        script = c(j, ju, paste0(
          "req/", list.files(template.loc(file.path(template, "req")), pattern = ".js$")
        )),
        stylesheet = c(paste0(
          "req/", list.files(template.loc(file.path(template, "req")), pattern = ".css$")
        ))
      )
    )
  }

#' Nav tag
#'
#' A nav tag for creating HTML navigations
#'
#' @param class The class of the navigation container
#' @param id The identification of the navigation container
#' @param role The character role of the container on the page
#' @param ... The content of the container
#'
#' @return HTML content of a container with type nav
#' @examples
#' nav('sample','id1','sample','some content')
#' @export
#'
nav <- function(class,
                id = NULL,
                role = NULL,
                ...) {
  shiny::HTML(paste0(
    "<nav class='card-pro-nav ",
    class,
    "' id='",
    id,
    "' role='",
    role,
    "'>",
    ...,
    "</nav>"
  ))
}


#' Template location full text
#'
#' Fetch the location of the scripts
#'
#' @param template The type of template to fetch
#'
#' @return A path for the location of the package
#' @examples
#' template.loc('bundle')
#' @export
#'
template.loc <- function(template = "bundle") {
  file.path(find.package(package = .packageName), template)
}


#' Empty server function
#'
#' For use in simple shiny apps not requiring server functions
#'
#' @param input the input object
#' @param output the output object
#' @param session the session object
#'
#' @return Empty server function
#' @examples
#' if(interactive()){
#'   library(shiny)
#'   library(card.pro)
#'   ui = fluidPage("Obi Obianom")
#'   shinyApp(ui = ui, server = empty.server)
#' }
#' @export
#'
empty.server <- function(input, output, session) {
}



#' Create a tab panel item
#'
#' Create a tab panel item that is enclosed by a list
#'
#' @param title title of the tab
#' @param ... content of the tab
#'
#' @return An list containing the title and content of a tab
#'
#' @examples
#' if (interactive()) {
#' card.pro(
#'   title = "Sample tabs",
#'   tabs = list(
#'     tabEntry("Summary", "Convallis aesus."),
#'     tabEntry("Summary", "nextGenShinyApps.")
#'   )
#' )
#' }
#'
#' @export
#'
#'
tabEntry <- function(title, ...) {
  list(
    unit = quickcode::number(1, max.digits = 4),
    title = title,
    content = htmltools::div(...)
  )
}

#' Create a collapsible container panel item
#'
#' Create a collapsible container panel item that is enclosed by a list
#'
#' @param title title of the collapsible container
#' @param collapsed whether the panel is collapsed or not
#' @param color.on color of collapsible icon when hover on
#' @param color.off color of collapsible icon when hover off
#' @param ... content of the collapsible container
#'
#' @return An list containing the title and content of a collapsible container
#' @details
#' Get color choices using quickcode:::color.choice
#'
#' @examples
#' if (interactive()) {
#'  library(shiny)
#'  library(card.pro)
#'  card.pro(
#'   title = "Sample collapsible",width = 4,
#'   collapsibleGroup = list(
#'     collapseEntry(title = "Summary 1", collapsed = TRUE, "Convallis aesus."),
#'     collapseEntry(title = "Summary 2", "eiusmod tempor incididunt")
#'   )
#' )
#' }
#'
#' @export
#'
#'
collapseEntry <- function(...,title, collapsed = FALSE, color.off = "darken", color.on = "red") {
  unit <- quickcode::number(1, max.digits = 4)
  .colin <- ifelse(collapsed," in","")
  .colin2 <- ifelse(collapsed,"","collapsed")
  list(shiny::tags$div(
    class = "panel panel-default",
    shiny::tags$div(
      class = "panel-heading",
      shiny::tags$h4(
        class = "panel-title",
        shiny::tags$a(
          href = paste0("#collapse-",unit),
          `data-toggle` = "collapse",
          `data-parent` = paste0("#accordion-",options()$cardproaccordioniId),
          class = .colin2,
          shiny::tags$i(class = paste0(
            "fa fa-fw fa-plus-circle txt-color-", color.off
          )),
          shiny::tags$i(class = paste0(
            "fa fa-fw fa-minus-circle txt-color-", color.on
          )),
          title
        )
      )
    ),
    shiny::tags$div(
      id = paste0("collapse-",unit),
      class = paste0("panel-collapse collapse",.colin),
      shiny::tags$div(class = "panel-body", ...)
    )
  ))
}


#' Create a title and footer bar
#'
#' Create an alternative title bar
#'
#' @param title title of the tab
#' @param rightContent content of the right
#' @param windowTitle window title
#' @param bg.col background color
#' @param text.col text color
#'
#' @return An list containing the title and content of a header or footer
#' @rdname header-footer
#' @examples
#' if (interactive()) {
#' titlePanel2("Main title", "Right content | About me")
#' titlePanel2("Main title", action)
#' }
#'
#' @export
#'
titlePanel2 <- function(title, rightContent = NULL, windowTitle = title , text.col = "#2a2725", bg.col = "#ffffff") {
  htmltools::tags$header(id ="header", class = "cardpro-titlepanel", style = paste0("min-height: 70px;border-width:0!important;background:",bg.col,";color: ",text.col),
    shiny::h2(style="width: 100%;padding-left:10px",
      shiny::div(style="width: 100%; ",title, shiny::div(class="hidden-mobile hidden-tablet pull-right",rightContent))
    )
  )
}



#' @rdname header-footer
#' @examples
#' if (interactive()) {
#' footerPanel("Main footer @ 2024. All rights reserved", "Contact us")
#' }
#'
#' @export
#'
footerPanel <- function(title = shiny::HTML("&copy; 2024"), rightContent = NULL, bg.col = "#2a2725", text.col = "#f5f5f5") {
  htmltools::tags$div(class = "page-footer", style = paste0("background:",bg.col,";color: ",text.col),
                        shiny::div(title, shiny::div(class="hidden-mobile hidden-tablet pull-right",rightContent))
  )
}



#' Create simple progress bar
#'
#' Create a progress bar within card container
#'
#' @param id id of the container
#' @param label title of the progress bar
#' @param value value of the progress bar in percent
#' @param outer.value value shown next to title
#' @param color color of the progress bar
#' @param vertical if the progress bar should be vertical or horizontal
#' @param size size of progress bar
#' @param striped whether to show the progressed bar background as striped
#' @return an HTML content to display a progress bar
#'
#' @examples
#' if (interactive()) {
#' library(shiny)
#' library(card.pro)
#'
#' # Without much modification of defaults
#' progressInput(id="id1")
#'
#' # Set color and value
#' progressInput(id="id1", value = "90%", color = "green")
#' }
#' @export


progressInput <- function(id, label = "", value = "35%", outer.value = value, color = color.choice, vertical = FALSE, size = c("m","s","l"), striped = FALSE) {
  color = match.arg(color)
  size = match.arg(size)
  size = switch (size,"s" = "-sm", "m" = "", "l"="-lg")
  .cl = "progress progress"
  .cl2 = ""
  .wh = "width"
  #if vertical
  if(vertical){
    .cl = "progress vertical progress"
    .wh = "height"
  }
  #if striped
  if(striped).cl2 = " progress-striped"
  #create display
  shiny::tags$div(
    id = id,
    if(quickcode::not.empty(label)) shiny::tags$span(
      class = "text", label,
      shiny::tags$span(class = "pull-right", outer.value)
    ),
    shiny::tags$div(
      class = paste0(.cl,size,.cl2),
      shiny::tags$div(class = paste0("progress-bar bg-color-", color), `data-transitiongoal` = "1", `aria-valuenow` = "1", style = paste0(.wh,": ", value, ";"), value)
    )
  )
}






#' Main panel to display content
#'
#' Customizable main panel for inclusion of various UI elements
#'
#' @param ... List of content
#' @param width Width of the main panel
#' @param border Should border be declared for the panel
#' @param shadow Should a shadow be added to the panel
#'
#' @note For more information on the features of the main panel, look through the Github examples
#' @return Creates a container for displaying contents
#'
#' @examples
#' \donttest{
#' primePanel("content 1")
#' }
#' @export

primePanel <- function(..., width = 8, border = FALSE, shadow = FALSE) {
  shiny::div(
    class = paste0("card-pro-prime p-0 m-0 col-12 col-md-", width),
    class = ifelse(border, "border", ""),
    class = ifelse(shadow, "shadow", ""),
    role = "main",
    ...
  )
}



#' New sidebar panel to display content
#'
#' Customizable sidebar panel for inclusion of various UI elements
#'
#' @param ... List of content
#' @param width Width of the sidebar panel
#' @param border Should border be declared for the panel
#' @param shadow Should a shadow be added to the panel
#'
#' @note For more information on the features of the sidebar panel, look through the Github examples
#' @return Creates an alternate container for displaying contents
#'
#' @examples
#' \donttest{
#' altPanel("content 2")
#' }
#' @export

altPanel <- function(..., width = 4, border = FALSE, shadow = FALSE) {
  htmltools::tags$div(
    class = paste0("col-12 col-md-", width),
    class = ifelse(border, "border", ""),
    class = ifelse(shadow, "shadow", ""),
    htmltools::tags$form(
      class = "well",
      role = "complementary", ...
    )
  )
}


#' A wrapper for panels
#'
#' Create a wrapper div for pannels
#'
#' @param ... div contents
#' @param bg background color of the wrapper
#'
#' @return a container for other containers
#'
#' @examples
#' wrapper(altPanel("hello"), shiny::mainPanel("test"))
#' wrapper(shiny::mainPanel("hello"), shiny::column(width = 2, "test"))
#' @export
#'

wrapper <- function(..., bg = c("default", "primary", "secondary", "warning", "info", "danger", "success")) {
  bg <- match.arg(bg)
  htmltools::tags$div(class = "xwrapper card-pro-wrapper", class = paste0("bg-", bg), ...)
}