R/materialise.R

Defines functions tabs_menu generate_autocompleteScript pageLayout element_nav navbar element_tab tabs autocomplete

Documented in autocomplete element_nav element_tab navbar pageLayout tabs

#' Autocomplete in Forms
#'
#' @param id A character.
#' @param inputIcon A tag that shows icon on the left of the input field.
#' @param label A charater, showing the label in input area.
#' @param datalist A list of name and value pairs. Names will be autocomplete for input field
#'
#' @return
#' @export
#'
#' @examples
#' inputIcon <- tags$i(class = "material-icons prefix",
#'            "textsms")
#' id ="autocomplete-input"
#' label = "Autocomplete"
#' list(
#'   apple=NULL, microsoft=NULL, google='https://placehold.it/250x250'
#' ) -> datalist
#' tag_autocomplete <- autocomplete(
#'   id=id, inputIcon=inputIcon, label=label, datalist=datalist
#' )
autocomplete <- function(id, inputIcon, label, datalist){
  tags$div(class = "row",
    tags$div(class = "input-field col s12",
      inputIcon,
      tags$input(type = "text", id = id, class = "autocomplete"),
      tags$label("for" = id, label)
    )
  ) -> tag_autocomplete
  tagList(
    tag_autocomplete,
    tags$script(
      generate_autocompleteScript(datalist)
    )
  )
}
#' Generate tabs
#'
#' @param ... inputs generated by element_tab, separated by comma
#'
#' @return
#' @export
#'
#' @examples
#' tabs(element_tab(...), element_tab(...))
tabs <- function(...) {
  arglist = list(...)
  purrr::map(arglist,
    ~{.x$li}) -> list_li
  purrr::map(arglist,
    ~{.x$div}) -> list_div
  tagList(
    tags$div(
      class = "row",
      do.call(tabs_menu, list_li),
      as.tags(list_div)
    ),
    tags$script("$(document).ready(function(){
    $('.tabs').tabs();
  });")
  )
}
#' Element function for tabs
#'
#' @param id An id for the tab
#' @param name A name for the tab
#' @param content A tags class object or a character
#' @param active logical, default=F
#' @param disabled logical, default=F
#'
#' @return
#' @export
#'
#' @examples none
element_tab <- function(id, name, content, active=F, disabled=F)
{
  tab <- list()
  tab$li <- {
    tags$li(
      class = "tab col s3",
      {
        tags$a(
          href = glue::glue("#{id}"),
          name
        ) -> aTag
        if(active){
          tagAppendAttributes(aTag, class="active") -> aTag
        }
        aTag
      }
    ) -> liTag
    if(disabled){
      tagAppendAttributes(liTag, class="disabled") -> liTag
    }
    liTag
  }

  tab$div <-
    tags$div(
      id = id,
      class = "col s12",
      content
    )
  return(tab)
}

#' Generate nav tag
#'
#' @param title the title
#'
#' @return
#' @export
#'
#' @examples none
navbar <- function(title, ...){
  tags$nav(tags$div(class = "nav-wrapper",
    tags$a(href = "#",
      class = "brand-logo",
      title),
    tags$ul(id = "nav-mobile",
      class = "right", # hide-on-med-and-down",
      tagList(...)
    )))
}
#' Generate li tags for navbar
#'
#' @param href A href link
#' @param label A label
#'
#' @return
#' @export
#'
#' @examples none
element_nav <- function(href, label){
  tags$li(tags$a(href = href,
    label))
}
#' Simple layout
#'
#' @param sidebarPanel A tag object. (width fixed at s3)
#' @param mainPanel A tag object. (width fixed at s9)
#' @param width_sidebar a character descripting the column width following materialise css
#' @param width_main a character descripting the column width following materialise css
#' @param class_sidebar extra class name for sidebar
#' @param class_main extra class name for main
#'
#' @return
#' @export
#'
#' @examples none
pageLayout <- function(sidebarPanel="", mainPanel="", width_sidebar="s3", width_main="s9", class_sidebar="sidebar", class_main="main") {
  class_sidebar = paste("col", width_sidebar, class_sidebar, sep=" ")
  class_main = paste("col", width_main, class_main, sep=" ")
  tags$div(class = "row",
    tags$div(class = class_sidebar,
      sidebarPanel),
    tags$div(class = class_main,
      mainPanel))
}

# helpers --------------------------------------------------------------------

generate_autocompleteScript <- function(datalist){
  jsonData <- jsonlite::toJSON(datalist, auto_unbox=T, null="null")

  scripts_autocomplete <- glue::glue("var jsonData = <<jsonData>>
  $(document).ready(function(){
      $('input.autocomplete').autocomplete({
        data: jsonData,
      });
    });", .open="<<", .close=">>")

  return(scripts_autocomplete)
}

tabs_menu <- function(...){
  tags$div(
    class = "col s12",
    tags$ul(
      class = "tabs",
      tagList(...)))
}
tpemartin/materialise documentation built on Dec. 23, 2021, 12:01 p.m.