R/bulma-demo.R

In tjpalanca/bulma.R: Bulma CSS Framework for R

#' @title Bulma Demo Page
#'
#' @description
#' This generates a fully functioning static website that showcases (and tests)
#' the various bulma components that can be generated using the utility
#' functions.
#'
#' @export
bulma_demo <- function() {

  browsable(bulma_demo_tags())

}

#' @rdname bulma_demo
#' @export
bulma_demo_tags <- function() {

  tagList(
    bulma_demo_assets(),
    bulma_hero(
      color = "primary",
      bulma_hero_body(
        bulma_title("Bulma for R", size = 3L),
        bulma_subtitle(
          "The modern CSS framework that just works, just for R.",
          size = 5L
        )
      )
    ),
    bulma_demo_nav(
      class = "mb-0",
      "Layout"     = bulma_demo_layout(),
      "Components" = bulma_demo_components(),
      "Elements"   = bulma_demo_elements(),
      "Forms"      = bulma_demo_forms(),
      "Helpers"    = bulma_demo_helpers()
    )
  )

}

bulma_demo_assets <- function() {

  tagList(
    bulma_assets(),
    highlightjs_assets("base16/one-light"),
    jquery_core(major_version = 3L, minified = TRUE),
    tags$head(
      tags$title("Bulma for R"),
      tags$link(rel = "icon", href = "//bulma.io/favicons/favicon-32x32.png"),
      includeScript(pkg_inst("bulma-demo/bulma_demo.js"))
    )
  )

}

bulma_demo_nav <- function(...,
                           align = "centered",
                           size  = "normal",
                           class = NULL) {

  nav_items <- assert_named(list(...))
  div(
    class = "navigation",
    exec(
      bulma_tabs,
      class = "navigation-tabs",
      align = align,
      size  = size,
      outer_tag = function(...) tags$div(class = class, ...),
      !!!map(names(nav_items), bulma_tabs_item)
    ),
    div(
      class = "navigation-content",
      tagList(
        imap(
          nav_items,
          ~tagAppendAttributes(.x,
                               id = to_snake_case(.y),
                               class = "navigation-item")
        )
      )
    )
  )

}

bulma_demo_side <- function(tags, ..., width = 40L, code_size = "half") {

  code <- enexpr(tags)
  bulma_columns(
    bulma_column(
      size = code_size,
      capture.output(
        tidy_source(
          text   = quo_text(code, width = width),
          indent = 2,
          width.cutoff = width,
          args.newline = TRUE
        )
      ) %>%
        paste0(collapse = "\n") %>%
        highlight_code_block(),
    ),
    bulma_column(
      ...,
      tags
    )
  )

}

bulma_demo_html <- function(tags, width = 60L, code_size = "half") {

  code <- enexpr(tags)
  bulma_columns(
    bulma_column(
      size = code_size,
      capture.output(
        tidy_source(
          text   = quo_text(code, width = width),
          indent = 2,
          width.cutoff = width,
          args.newline = TRUE
        )
      ) %>%
        paste0(collapse = "\n") %>%
        highlight_code_block(),
    ),
    bulma_column(
      highlight_code_block(as.character(tags), language = "html")
    )
  )

}

bulma_demo_down <- function(tags, width = 80L) {

  code <- enexpr(tags)
  bulma_columns(
    bulma_column(
      capture.output(
        tidy_source(
          text   = rlang::quo_text(code, width = width),
          indent = 2,
          width.cutoff = width,
          args.newline = TRUE
        )
      ) %>%
        paste0(collapse = "\n") %>%
        highlight_code_block(language = "html"),
      tags
    )
  )

}

bulma_demo_modal <- function(tags) {

  bulma_demo_side(
    tags = {{ tags }},
    code_size = "three-quarters",
    width = 60L,
    bulma_button(
      class = "modal-open",
      color = "primary",
      "Launch modal"
    )
  )

}