add demo shiny app

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: shinytip
 Title: Simple Flexible Tooltips for 'Shiny' Apps
-Version: 0.0.0.9001
+Version: 0.1.0
 Authors@R: c(
     person("Dean", "Attali",
         email = "[email protected]",
@@ -12,17 +12,20 @@ Authors@R: c(
     ))
 Description: Tooltips can be added to any 'Shiny' input and almost any element. Tooltips
     can be customized through a variety of options such as tooltip position,
-    colour, size, and animation. Based on the 'balloon.css' project.
-URL: https://github.com/daattali/shinytip
+    colour, size, and animation. Works in Rmd/qmd documents as well. Based on the
+    'balloon.css' project.
+URL: https://github.com/daattali/shinytip, https://daattali.com/shiny/shinytip-demo/
 BugReports: https://github.com/daattali/shinytip/issues
 Depends:
     R (>= 3.1.0)
 Imports:
     htmltools (>= 0.3.5),
     shiny (>= 1.0.0)
 Suggests:
+  colourpicker,
   shinyalert,
   shinycssloaders,
+  shinydisconnect,
   testthat (>= 3.0.0)
 License: MIT + file LICENSE
 Encoding: UTF-8

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(runExample)
 export(tip)
 export(tip_icon)
 export(tip_input)

NEWS.md

@@ -0,0 +1,3 @@
+# shinytip 0.1.0 (TBD)
+
+Initial release

R/runExample.R

@@ -0,0 +1,11 @@
+#' Run shinytip example
+#'
+#' Launch an example Shiny app that shows how to use {shinytip}.\cr\cr
+#' The demo app is also
+#' \href{https://daattali.com/shiny/shinytip-demo/}{available online}
+#' to experiment with.
+#' @export
+runExample <- function() {
+  appDir <- system.file("examples", "demo", package = "shinytip")
+  shiny::runApp(appDir, display.mode = "normal")
+}

R/tip.R

@@ -34,8 +34,8 @@
 #' @param size The font size of the tooltip text.
 #' @param click If `FALSE` (default), the tooltip shows on hover. If `TRUE`, the tooltip will
 #' only show when the tag is clicked.
-#' @param animate If `FALSE`, don't animate the tooltip appearing and disappearing.
-#' @param pointer If `FALSE`, don't change the cursor when hovering over the tag.
+#' @param animate If `TRUE`, animate the tooltip appearing and disappearing.
+#' @param pointer If `TRUE`, change the cursor when hovering over the tag.
 #' @param ... Additional parameters to pass to the tag.
 #' @return A Shiny tag that supports tooltips.
 #' @seealso [tip_input()], [tip_icon()]

inst/examples/demo/app.R

@@ -0,0 +1,121 @@
+library(shiny)
+
+allowed_positions <- c("top", "bottom", "left", "right", "top-left", "top-right", "bottom-left", "bottom-right")
+
+share <- list(
+  title = "{shinytip}",
+  url = "https://daattali.com/shiny/shinytip-demo/",
+  source = "https://github.com/daattali/shinytip",
+  image = "https://daattali.com/shiny/img/shinytip.png",
+  description = "Simple flexible tootips for Shiny apps",
+  twitter_user = "daattali"
+)
+
+ui <- fluidPage(
+  shinydisconnect::disconnectMessage2(),
+
+  title = paste0("{shinytip} ", as.character(packageVersion("shinytip"))),
+
+  tags$head(
+    tags$link(rel = "stylesheet", href = "style.css"),
+    # Favicon
+    tags$link(rel = "shortcut icon", type="image/x-icon", href="https://daattali.com/shiny/img/favicon.ico"),
+    # Facebook OpenGraph tags
+    tags$meta(property = "og:title", content = share$title),
+    tags$meta(property = "og:type", content = "website"),
+    tags$meta(property = "og:url", content = share$url),
+    tags$meta(property = "og:image", content = share$image),
+    tags$meta(property = "og:description", content = share$description),
+
+    # Twitter summary cards
+    tags$meta(name = "twitter:card", content = "summary"),
+    tags$meta(name = "twitter:site", content = paste0("@", share$twitter_user)),
+    tags$meta(name = "twitter:creator", content = paste0("@", share$twitter_user)),
+    tags$meta(name = "twitter:title", content = share$title),
+    tags$meta(name = "twitter:description", content = share$description),
+    tags$meta(name = "twitter:image", content = share$image)
+  ),
+
+  div(
+    id = "header",
+    div(id = "pagetitle", share$title),
+    div(id = "subtitle", share$description),
+    div(
+      id = "subsubtitle",
+      "Created by",
+      tags$a(href = "https://deanattali.com/", "Dean Attali"),
+      HTML("&bull;"),
+      "Available",
+      tags$a(href = share$source, "on GitHub"),
+      HTML("&bull;"),
+      tags$a(href = "https://daattali.com/shiny/", "More apps"), "by Dean"
+    )
+  ),
+
+  div(
+    id = "main-row",
+    uiOutput("tooltip")
+  ),
+
+  fluidRow(
+    column(
+      4,
+      shinytip::tip_input(
+        textInput("content", "Text", "Hello there 👋 I'm a tooltip from {shinytip}"),
+        "The text can include emojis but not HTML"
+      ),
+      shinytip::tip_input(
+        selectInput("position", "Position", allowed_positions),
+        "Tooltip position relative to the tag"
+      ),
+      selectInput("length", "Length", c("line", "fit", "s", "m", "l", "xl")),
+    ),
+    column(
+      4,
+      colourpicker::colourInput("bg", "Background", "black"),
+      colourpicker::colourInput("fg", "Text colour", "white"),
+      numericInput("size", "Text size", 16),
+    ),
+    column(
+      4,
+      checkboxInput("click", "Trigger on click", FALSE),
+      checkboxInput("animate", "Allow animation", TRUE),
+      checkboxInput("pointer", "Change cursor on hover", TRUE)
+    )
+  ),
+  fluidRow(
+    column(
+      12, h3("Generated code"), verbatimTextOutput("code")
+    )
+  )
+)
+
+server <- function(input, output, session) {
+  code <- reactive({
+    text <- if (input$click) "Click me!" else "Hover me!"
+    code <- paste0(
+      'shinytip::tip(\n',
+      '  "', text, '",\n',
+      '  content = "', input$content, '",\n',
+      '  position = "', input$position, '",\n',
+      '  length = "', input$length, '",\n',
+      '  bg = "', input$bg, '",\n',
+      '  fg = "', input$fg, '",\n',
+      '  size = ', input$size, ',\n',
+      '  click = ', input$click, ',\n',
+      '  animate = ', input$animate, ',\n',
+      '  pointer = ', input$pointer, ',\n',
+      ')'
+    )
+  })
+
+  output$code <- renderText({
+    code()
+  })
+
+  output$tooltip <- renderUI({
+    eval(parse(text = code()))
+  })
+}
+
+shinyApp(ui, server)

inst/examples/demo/www/style.css

@@ -0,0 +1,85 @@
+html, body {
+  font-size: 16px;
+}
+body {
+  padding: 0 20px;
+  background-image: url('maze-white.png');
+  background-color: #fafafa;
+  color: #333;
+}
+
+#header {
+  text-align: center;
+  color: #fdfdfd;
+  padding: 50px 5px 90px;
+  border-bottom: 1px solid #ddd;
+  margin: 0 -35px 30px;
+  clip-path: polygon(0 0,100% 0,100% calc(100% - 3vw),0 100%);
+  background-color: #e64a19;
+  background-image: url('diagonals.png');
+}
+
+#pagetitle {
+  font-size: 5em;
+  line-height: 1.2;
+  margin-bottom: 15px;
+}
+
+#subtitle {
+  font-size: 2em;
+  margin-bottom: 15px;
+  line-height: 1.1;
+}
+
+#subsubtitle {
+  font-size: 1.3em;
+}
+
+#subsubtitle a {
+  color: #fdfdfd;
+  text-decoration: underline;
+}
+
+@media only screen and (max-width: 979px) {
+  #header {
+    padding: 15px 5px 35px;
+  }
+  #pagetitle {
+    font-size: 3em;
+  }
+  #subtitle {
+    font-size: 1.7em;
+  }
+  #subsubtitle {
+    font-size: 1.2em;
+  }
+}
+
+@media only screen and (max-width: 767px) {
+  #pagetitle {
+    font-size: 3em;
+  }
+  #subtitle {
+    font-size: 1.5em;
+  }
+  #subsubtitle {
+    font-size: 1.1em;
+  }
+}
+
+#main-row {
+  margin: 4rem 0 5rem;
+  text-align: center;
+}
+
+#tooltip .shinytip {
+  font-size: 2rem;
+  background: #fff;
+  padding: 1rem 3rem;
+  font-weight: bold;
+  border: 1px solid #aaa;
+}
+
+.checkbox label {
+  font-weight: bold;
+}