Nothing
#' Framework7 page container
#'
#' \code{f7Page} is the main app container.
#'
#' @param ... Slot for shinyMobile skeleton elements: \link{f7Appbar}, \link{f7SingleLayout},
#' \link{f7TabLayout}, \link{f7SplitLayout}.
#' @param title Page title.
#' @param options shinyMobile configuration. See \url{https://framework7.io/docs/app.html}. Below are the most
#' notable options. General options:
#' \itemize{
#' \item \code{theme}: App skin: "ios", "md", "auto" or "aurora".
#' \item \code{dark}: Dark layout. TRUE or FALSE.
#' \item \code{skeletonsOnLoad}: Whether to display skeletons on load.
#' This is a preloading effect. Not compatible with preloader.
#' \item \code{preloader}: Loading spinner. Not compatible with skeletonsOnLoad.
#' \item \code{filled}: Whether to fill the \link{f7Navbar} and \link{f7Toolbar} with
#' the current selected color. FALSE by default.
#' \item \code{color}: Color theme: See \url{https://framework7.io/docs/color-themes.html}.
#' Expect a name like blue, red or hex code like `#FF0000`. If NULL, use the default color.
#' If a name is specified it must be accepted either by \link[gplots]{col2hex} or
#' \link{getF7Colors} (valid Framework 7 color names).
#' \item \code{pullToRefresh}: Whether to active the pull to refresh feature. Default to FALSE.
#' See \url{https://v5.framework7.io/docs/pull-to-refresh.html#examples}.
#' \item \code{iosTranslucentBars}: Enable translucent effect (blur background) on navigation bars for iOS theme (on iOS devices).
#' FALSE by default.
#' }
#' Touch module options \url{https://v5.framework7.io/docs/app.html#app-parameters}:
#' \itemize{
#' \item \code{tapHold}: It triggers (if enabled) after a sustained, complete touch event.
#' By default it is disabled. Note, that Tap Hold is a part of built-in Fast Clicks library,
#' so Fast Clicks should be also enabled.
#' \item \code{tapHoldDelay}: Determines how long (in ms) the user must hold their tap before the taphold event is fired on the target element.
#' Default to 750 ms.
#' \item \code{iosTouchRipple}: Default to FALSE. Enables touch ripple effect for iOS theme.
#' }
#' Navbar options \url{https://v5.framework7.io/docs/navbar.html#navbar-app-parameters}:
#' \itemize{
#' \item \code{iosCenterTitle}: Default to TRUE. When enabled then it will try to position
#' title at the center in iOS theme. Sometime (with some custom design) it may not needed.
#' \item \code{hideOnPageScroll}: Default to FALSE. Will hide Navbars on page scroll.
#' }
#' Toolbar options \url{https://v5.framework7.io/docs/toolbar-tabbar.html#toolbar-app-parameters}:
#' \itemize{
#' \item \code{hideOnPageScroll}: Default to FALSE. Will hide tabs on page scroll.
#' }
#'
#' In any case, you must follow the same structure as provided in the function arguments.
#'
#' @param allowPWA Whether to include PWA dependencies. Default to FALSE.
#'
#' @author David Granjon, \email{dgranjon@@ymail.com}
#'
#' @export
f7Page <- function(
...,
title = NULL,
# default options
options = list(
theme = c("auto", "ios", "md", "aurora"),
dark = TRUE,
skeletonsOnLoad = FALSE,
preloader = FALSE,
filled = FALSE,
color = "#007aff",
touch = list(
tapHold = TRUE,
tapHoldDelay = 750,
iosTouchRipple = FALSE
),
iosTranslucentBars = FALSE,
navbar = list(
iosCenterTitle = TRUE,
hideOnPageScroll = TRUE
),
toolbar = list(
hideOnPageScroll = FALSE
),
pullToRefresh = FALSE
),
allowPWA = FALSE
) {
# Color must be converted to HEX before going to JavaScript
if (!is.null(options$color)) {
# If color is a name
if (!grepl("#", options$color)) {
# Color belongs to Framework7 valid colors
if (options$color %in% getF7Colors()) {
options$color <- colorToHex(options$color)
} else {
# If not we use gplots and internal R colors
options$color <- gplots::col2hex(options$color)
}
}
}
# fallback to auto
if (length(options$theme) > 1) options$theme <- "auto"
if (!is.null(options$skeletonsOnLoad) && !is.null(options$preloader)) {
if (options$skeletonsOnLoad && options$preloader) {
stop("Choose either skeletonsOnLoad or preloader.")
}
}
if (!is.null(options$theme) && !is.null(options$filled) && !is.null(options$color)) {
if (options$theme == "dark" && options$filled == TRUE &&
(options$color == "white" || options$color == "#fff")) {
stop("Wrong theme combination: navbar color cannot be white in a dark theme!")
}
}
if (!is.null(options$pullToRefresh)) {
dataPTR <- tolower(options$pullToRefresh)
options$pullToRefresh <- NULL
} else {
dataPTR <- NULL
}
# configuration tag to be passed to JS
configTag <- shiny::tags$script(
type = "application/json",
`data-for` = "app",
jsonlite::toJSON(
x = options,
auto_unbox = TRUE,
json_verbatim = TRUE
)
)
# Can also contain app bar
items <- list(...)
# Find current layout stored in attribute
layout <- unlist(lapply(items, function(item) {
is_layout <- inherits(item, "shiny.tag.list")
if (is_layout) {
attributes(item)$layout
}
}))
bodyTag <- shiny::tags$body(
`data-pwa` = tolower(allowPWA),
`data-ptr`= dataPTR,
shiny::tags$div(
id = "app",
class = layout,
items
),
configTag
)
pwaDeps <- if (allowPWA) {
c("pwa", "pwacompat")
} else {
NULL
}
shiny::tagList(
# Head
shiny::tags$head(
shiny::tags$meta(charset = "utf-8"),
shiny::tags$meta(
name = "viewport",
content = "
width=device-width,
initial-scale=1,
maximum-scale=1,
minimum-scale=1,
user-scalable=no,
viewport-fit=cover"
),
shiny::tags$title(title)
),
# Body
add_dependencies(
deps = c(
"framework7",
"shinyMobile",
pwaDeps,
"f7icons"
),
bodyTag
)
)
}
#' Framework7 single layout
#'
#' \code{f7SingleLayout} provides a simple page layout.
#'
#' @param ... Content.
#' @param navbar Slot for \link{f7Navbar}.
#' @param toolbar Slot for \link{f7Toolbar}.
#' @param panels Slot for \link{f7Panel}.
#' Wrap in \code{tagList} if multiple panels.
#' @param appbar Slot for \link{f7Appbar}.
#'
#' @examples
#' if(interactive()){
#' library(shiny)
#' library(shinyMobile)
#' shinyApp(
#' ui = f7Page(
#' title = "Single layout",
#' f7SingleLayout(
#' navbar = f7Navbar(
#' title = "Single Layout",
#' hairline = FALSE,
#' shadow = TRUE
#' ),
#' toolbar = f7Toolbar(
#' position = "bottom",
#' f7Link(label = "Link 1", href = "https://www.google.com"),
#' f7Link(label = "Link 2", href = "https://www.google.com")
#' ),
#' # main content
#' f7Shadow(
#' intensity = 10,
#' hover = TRUE,
#' f7Card(
#' title = "Card header",
#' f7Slider("obs", "Number of observations", 0, 1000, 500),
#' plotOutput("distPlot"),
#' footer = tagList(
#' f7Button(color = "blue", label = "My button", href = "https://www.google.com"),
#' f7Badge("Badge", color = "green")
#' )
#' )
#' )
#' )
#' ),
#' server = function(input, output) {
#' output$distPlot <- renderPlot({
#' dist <- rnorm(input$obs)
#' hist(dist)
#' })
#' }
#' )
#' }
#'
#' @author David Granjon, \email{dgranjon@@ymail.com}
#'
#' @export
f7SingleLayout <- function(..., navbar, toolbar = NULL,
panels = NULL, appbar = NULL) {
single_layout_tag <- shiny::tagList(
# appbar goes here
appbar,
# panels go here
panels,
shiny::tags$div(
class = "view view-main",
shiny::tags$div(
class = "page",
# top navbar goes here
navbar,
# toolbar goes here
toolbar,
shiny::tags$div(
class= "page-content",
# page content
...
)
)
)
)
attr(single_layout_tag, "layout") <- "single-layout"
single_layout_tag
}
#' Framework7 tab layout
#'
#' \code{f7TabLayout} create a single page app with multiple tabs,
#' giving the illusion of a multi pages experience.
#'
#' @param ... Slot for \link{f7Tabs}.
#' @param navbar Slot for \link{f7Navbar}.
#' @param messagebar Slot for \link{f7MessageBar}.
#' @param panels Slot for \link{f7Panel}.
#' Wrap in \code{tagList} if multiple panels.
#' @param appbar Slot for \link{f7Appbar}.
#'
#' @examples
#' if(interactive()){
#' library(shiny)
#' library(shinyMobile)
#' library(shinyWidgets)
#'
#' shinyApp(
#' ui = f7Page(
#' title = "Tab layout",
#' f7TabLayout(
#' tags$head(
#' tags$script(
#' "$(function(){
#' $('#tapHold').on('taphold', function () {
#' app.dialog.alert('Tap hold fired!');
#' });
#' });
#' "
#' )
#' ),
#' panels = tagList(
#' f7Panel(title = "Left Panel", side = "left", theme = "light", "Blabla", effect = "cover"),
#' f7Panel(title = "Right Panel", side = "right", theme = "dark", "Blabla", effect = "cover")
#' ),
#' navbar = f7Navbar(
#' title = "Tabs",
#' hairline = FALSE,
#' shadow = TRUE,
#' leftPanel = TRUE,
#' rightPanel = TRUE
#' ),
#' f7Tabs(
#' animated = FALSE,
#' swipeable = TRUE,
#' f7Tab(
#' tabName = "Tab1",
#' icon = f7Icon("envelope"),
#' active = TRUE,
#' f7Shadow(
#' intensity = 10,
#' hover = TRUE,
#' f7Card(
#' title = "Card header",
#' f7Stepper(
#' "obs1",
#' "Number of observations",
#' min = 0,
#' max = 1000,
#' value = 500,
#' step = 100
#' ),
#' plotOutput("distPlot1"),
#' footer = tagList(
#' f7Button(inputId = "tapHold", label = "My button"),
#' f7Badge("Badge", color = "green")
#' )
#' )
#' )
#' ),
#' f7Tab(
#' tabName = "Tab2",
#' icon = f7Icon("today"),
#' active = FALSE,
#' f7Shadow(
#' intensity = 10,
#' hover = TRUE,
#' f7Card(
#' title = "Card header",
#' f7Select(
#' inputId = "obs2",
#' label = "Distribution type:",
#' choices = c(
#' "Normal" = "norm",
#' "Uniform" = "unif",
#' "Log-normal" = "lnorm",
#' "Exponential" = "exp"
#' )
#' ),
#' plotOutput("distPlot2"),
#' footer = tagList(
#' f7Button(label = "My button", href = "https://www.google.com"),
#' f7Badge("Badge", color = "orange")
#' )
#' )
#' )
#' ),
#' f7Tab(
#' tabName = "Tab3",
#' icon = f7Icon("cloud_upload"),
#' active = FALSE,
#' f7Shadow(
#' intensity = 10,
#' hover = TRUE,
#' f7Card(
#' title = "Card header",
#' f7SmartSelect(
#' inputId = "variable",
#' label = "Variables to show:",
#' c("Cylinders" = "cyl",
#' "Transmission" = "am",
#' "Gears" = "gear"),
#' multiple = TRUE,
#' selected = "cyl"
#' ),
#' tableOutput("data"),
#' footer = tagList(
#' f7Button(label = "My button", href = "https://www.google.com"),
#' f7Badge("Badge", color = "green")
#' )
#' )
#' )
#' )
#' )
#' )
#' ),
#' server = function(input, output) {
#' output$distPlot1 <- renderPlot({
#' dist <- rnorm(input$obs1)
#' hist(dist)
#' })
#'
#' output$distPlot2 <- renderPlot({
#' dist <- switch(
#' input$obs2,
#' norm = rnorm,
#' unif = runif,
#' lnorm = rlnorm,
#' exp = rexp,
#' rnorm
#' )
#'
#' hist(dist(500))
#' })
#'
#' output$data <- renderTable({
#' mtcars[, c("mpg", input$variable), drop = FALSE]
#' }, rownames = TRUE)
#' }
#' )
#' }
#'
#' @author David Granjon, \email{dgranjon@@ymail.com}
#'
#' @export
f7TabLayout <- function(..., navbar, messagebar = NULL, panels = NULL, appbar = NULL) {
tab_layout_tag <- shiny::tagList(
# appbar goes here
appbar,
# panels go here
panels,
shiny::tags$div(
class = "view view-main",
# the page wrapper is important for tabs
# to swipe properly. It is not mentionned
# in the doc. Also necessary to adequately
# apply the dark mode
messagebar,
shiny::tags$div(
class = "page",
# top navbar goes here
navbar,
# f7Tabs go here. The toolbar is
# automatically generated
...
)
)
)
attr(tab_layout_tag, "layout") <- "tab-layout"
tab_layout_tag
}
#' Framework7 split layout
#'
#' This is a modified version of the \link{f7SingleLayout}.
#' It is intended to be used with tablets.
#'
#' @param ... Content.
#' @param navbar Slot for \link{f7Navbar}.
#' @param sidebar Slot for \link{f7Panel}. Particularly we expect the following code:
#' \code{f7Panel(title = "Sidebar", side = "left", theme = "light", "Blabla", style = "reveal")}
#' @param toolbar Slot for \link{f7Toolbar}.
#' @param panel Slot for \link{f7Panel}. Expect only a right panel, for instance:
#' \code{f7Panel(title = "Left Panel", side = "right", theme = "light", "Blabla", style = "cover")}
#' @param appbar Slot for \link{f7Appbar}.
#'
#' @examples
#' if(interactive()){
#' library(shiny)
#' library(shinyMobile)
#' shinyApp(
#' ui = f7Page(
#' title = "Split layout",
#' f7SplitLayout(
#' sidebar = f7Panel(
#' id = "sidebar",
#' title = "Sidebar",
#' side = "left",
#' theme = "dark",
#' f7PanelMenu(
#' id = "menu",
#' f7PanelItem(tabName = "tab1", title = "Tab 1", icon = f7Icon("envelope"), active = TRUE),
#' f7PanelItem(tabName = "tab2", title = "Tab 2", icon = f7Icon("house"))
#' ),
#' uiOutput("selected_tab")
#' ),
#' navbar = f7Navbar(
#' title = "Split Layout",
#' hairline = FALSE,
#' shadow = TRUE
#' ),
#' toolbar = f7Toolbar(
#' position = "bottom",
#' f7Link(label = "Link 1", href = "https://www.google.com"),
#' f7Link(label = "Link 2", href = "https://www.google.com")
#' ),
#' # main content
#' f7Items(
#' f7Item(
#' tabName = "tab1",
#' f7Slider("obs", "Number of observations:",
#' min = 0, max = 1000, value = 500
#' ),
#' plotOutput("distPlot")
#' ),
#' f7Item(tabName = "tab2", "Tab 2 content")
#' )
#' )
#' ),
#' server = function(input, output) {
#'
#' output$selected_tab <- renderUI({
#' HTML(paste0("Selected tab: ", strong(input$menu)))
#' })
#'
#' output$distPlot <- renderPlot({
#' dist <- rnorm(input$obs)
#' hist(dist)
#' })
#' }
#' )
#' }
#'
#' @author David Granjon, \email{dgranjon@@ymail.com}
#' @export
f7SplitLayout <- function(..., navbar, sidebar, toolbar = NULL,
panel = NULL, appbar = NULL) {
# add margins
items <- shiny::div(...) %>% f7Margin(side = "left") %>% f7Margin(side = "right")
sidebar <- shiny::tagAppendAttributes(sidebar, class = "panel-in")
# this trick to prevent to select the panel view in the following
# javascript code
sidebar$children[[1]]$attribs$class <- "panel-visible-by-breakpoint"
splitSkeleton <- f7SingleLayout(
items,
navbar = navbar,
toolbar = toolbar,
panels = shiny::tagList(
sidebar,
panel
),
appbar = appbar
)
# Customize class
splitSkeleton[[3]] <- tagAppendAttributes(
splitSkeleton[[3]],
class = "safe-areas"
)
attr(splitSkeleton, "layout") <- "split-layout"
splitSkeleton
}
#' Framework7 item container
#'
#' Build a Framework7 wrapper for \link{f7Item}
#'
#' @param ... Slot for wrapper for \link{f7Item}.
#'
#' @author David Granjon, \email{dgranjon@@ymail.com}
#'
#' @export
f7Items <- function(...){
#shiny::tags$div(
#class = "tabs-animated-wrap",
shiny::tags$div(
# ios-edges necessary to have
# the good ios rendering
class = "tabs ios-edges",
...
)
#)
}
#' Framework7 body item
#'
#' Similar to \link{f7Tab} but for the \link{f7SplitLayout}.
#'
#' @inheritParams f7Tab
#'
#' @author David Granjon, \email{dgranjon@@ymail.com}
#'
#' @export
f7Item <- function(..., tabName) {
shiny::tags$div(
class = "page-content tab",
id = tabName,
`data-value` = tabName,
...
)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.