svgInput

svgInput/R/code_files.R

@@ -0,0 +1,122 @@
+
+
+write_svg_input_r_lines <- function(svg_lines, svg_input_name, class_name, 
+                                    include_css = TRUE) {
+
+  lines <- c(
+    "",
+    paste0(svg_input_name, ' <- function(inputId, svg) {'),
+    "  ",
+    '  svg <- "',
+    paste0("    ", svg_lines),
+    '  "',
+    "  ",
+    "  tagList(",
+    '    singleton(tags$head(',
+    paste0('      tags$script(src = "', svg_input_name, '.js")', 
+           ifelse(include_css, ',', '')),
+    if (include_css) {
+      paste0('      htmltools::includeCSS(path = "www/', svg_input_name, '.css")')
+    },
+    '    )),',
+    '    tags$div(',
+    paste0('      class = "', class_name, '",'),
+    '      id = inputId,',
+    '      `data-input-id` = inputId,',
+    '      shiny::HTML(svg)',
+    '    )',
+    '  )',
+    '}'
+  )
+
+  lines
+}
+
+write_svg_input_r_file <- function(lines, svg_input_name, path = ".") {
+  file_path <- file.path(path, paste0(svg_input_name, ".R"))
+  writeLines(lines, file_path)
+
+  file_path
+}
+
+
+
+write_svg_input_shiny_lines <- function(svg_input_name, r_file = NULL) {
+
+  if (is.null(r_file)) {
+    r_file <- paste0(svg_input_name, ".R")
+  }
+
+  lines <- c(
+    "library(shiny)",
+    "",
+    paste0('source("', r_file, '", local = TRUE)'),
+    "",
+    "ui <- fluidPage(",
+    '  textOutput("selected_svg"),',
+    paste0('  ', svg_input_name, '("input_id")'),
+    ")",
+    "",
+    "server <- function(input, output, session) {",
+    "  ",
+    "  output$selected_svg <- renderPrint({ input$input_id })",
+    "  ",
+    "}",
+    "",
+    "shinyApp(ui = ui, server = server)"
+  )
+
+  lines
+}
+
+write_svg_input_shiny_file <- function(lines, svg_input_name, path = ".") {
+  file_path <- file.path(path, paste0("app_", svg_input_name, ".R"))
+  writeLines(lines, file_path)
+
+  file_path
+}
+
+
+write_js_binding_lines <- function(svg_input_id, class_name) {
+  lines <- c(
+    'var shinyBinding = new Shiny.InputBinding();',
+    '$.extend(shinyBinding, {',
+    '  ',
+    '  find: function find(scope) {',
+    paste0('    return $(scope).find(".', class_name, '")'),
+    '  },',
+    '  ',
+    '  // get the data-svginput of the element with class selected as shiny input',
+    '  getValue: function getValue(el) {',
+    paste0("    var value = $(el).find('.selected').data('", svg_input_id, "')"),
+    '    console.log(value)',
+    '    return value',
+    '  },',
+    '',
+    '  subscribe: function(el, callback) {',
+    '    $(el).on("click.shinyBinding", function(evt) {',
+    '      // remove all of the selected classes inside our element',
+    '      $(el).find(".selected").removeClass("selected");',
+    '      // set the selected class to the closest clicked part',
+    "      //console.log($(evt.target).attr('id'))",
+    "      $(evt.target).addClass('selected');",
+    '      callback();',
+    '    })',
+    '  },',
+    '  unsubscribe: function(el) {',
+    '    $(el).off(".shinyBinding");',
+    '  }',
+    '});',
+    '',
+    'Shiny.inputBindings.register(shinyBinding);'
+  )
+
+  lines 
+}
+
+write_js_binding_file <- function(lines, svg_input_name, path = "www") {
+  file_path <- file.path(path, paste0(svg_input_name, ".js"))
+  writeLines(lines, file_path)
+
+  file_path
+}

svgInput/R/mod_create_svg_input.R

@@ -0,0 +1,53 @@
+
+
+# Module UI function
+mod_create_svg_input_ui <- function(id) {
+  ns <- shiny::NS(id)
+
+  shiny::tagList(
+    bs4Dash::accordion(
+      id = ns("accordion"),
+      bs4Dash::accordionItem(
+        title = "1 Upload", status = "olive", collapsed = FALSE, 
+        shiny::div(
+          style = "max-width:1200px; width:100%; margin:0 auto;",
+          mod_upload_svg_ui(ns("up")),
+          shiny::fluidRow(shiny::column(width = 12, shiny::actionButton(ns("btn_1"), "Next")))
+        )
+      ),
+      bs4Dash::accordionItem(
+        title = "2 Set Inputs", status = "olive",
+        shiny::div(
+          style = "max-width:1200px; width:100%; margin:0 auto;",
+          mod_set_inputs_ui(ns("si")),
+          shiny::fluidRow(shiny::column(width = 12, shiny::actionButton(ns("btn_2"), "Next")))
+        )
+      ),
+      bs4Dash::accordionItem(
+        title = "3 Download", status = "olive",
+        shiny::div(
+          style = "max-width:1200px; width:100%; margin:0 auto;",
+          mod_download_files_ui(ns("df"))
+        )
+      )
+    ),
+    if (Sys.getenv("BROWSE") == "TRUE") { shiny::actionButton(ns("browse"), "Browse")}
+  )
+}
+
+# Module server function
+mod_create_svg_input_server <- function(id) {
+  shiny::moduleServer(id, function(input, output, session) {
+
+      shiny::observeEvent(input$browse, { browser() })
+
+      shiny::observeEvent(input$btn_1, { bs4Dash::updateAccordion(id = "accordion", selected = 2, session = session) })
+      shiny::observeEvent(input$btn_2, { bs4Dash::updateAccordion(id = "accordion", selected = 3, session = session) })
+
+      svg_base   <- mod_upload_svg_server("up")
+      svg_inputs <- mod_set_inputs_server("si", svg_base)
+      mod_download_files_server("df", svg_inputs)
+
+
+  })    
+}

svgInput/R/mod_download_files.R

@@ -0,0 +1,156 @@
+
+
+# Module UI function
+mod_download_files_ui <- function(id) {
+  ns <- shiny::NS(id)
+
+  shiny::tagList(
+    shiny::uiOutput(ns("ui")),
+    if (Sys.getenv("BROWSE") == "TRUE") { shiny::actionButton(ns("browse"), "Browse")}
+    # svg_input_name <- "svginput"
+    # svg_input_id   <- "shinyclick"
+    # class_name     <- svg_input_name
+  )
+}
+
+# Module server function
+mod_download_files_server <- function(id, create_upload, svg_inputs) {
+  shiny::moduleServer(id, function(input, output, session) {
+
+    shiny::observeEvent(input$browse, { browser() })
+
+    output$ui <- shiny::renderUI({
+      ns <- session$ns
+
+      if (!is.list(create_upload())) { return("Please upload or select an SVG first") }
+
+      initial_name <- paste0("svg_", create_upload()$name)
+      # initial_name <- paste(sample(as.character(unique(iris$Species)), 1),
+      #                      sample(rownames(mtcars), 1)) %>% 
+      #   stringr::str_replace_all(" ", "_") %>% 
+      #   tolower()
+
+      shiny::tagList(
+        shiny::fluidRow(
+          # style = "text-align:center;",
+          column(
+            width = 4, 
+            shiny::textInput(ns("name"), "Input name (preferably unique)", value = initial_name),
+            shiny::textInput(ns("data_element"), "Element data_<name> to collect with JS", value = "shinyclick"),
+            shiny::hr(),
+            shiny::p(style = "margin:10px 0 0;", "Script containing the input function"),
+            shiny::downloadButton(ns("dwnl_r_function"), "R function"),
+            shiny::p(style = "margin:10px 0 0;", "JS script to add to your apps 'www' directory"),
+            shiny::downloadButton(ns("dwnl_js"), "JS"),
+            shiny::p(style = "margin:10px 0 0;", "Simple Shiny app displaying only the SVG input and textOutput (optional)"),
+            shiny::downloadButton(ns("dwnl_r_sample_app"), "Sample Shiny app")
+          ),
+          shiny::column(
+            width = 8,
+            shiny::tabsetPanel(
+              id = "file_tabs",
+              shiny::tabPanel(title = "R function", value = "create_r_function", shiny::uiOutput(ns("tab1"))),
+              shiny::tabPanel(title = "JS", value = "create_js", shiny::uiOutput(ns("tab2"))),
+              shiny::tabPanel(title = "R sample app", value = "create_r_sample_app", shiny::uiOutput(ns("tab3")))
+            )
+          )
+        )
+      )
+    })
+
+
+    temp_dir <- paste0("temp_", paste(letters[ceiling(26 * runif(10))], collapse = ""))
+    dir.create(temp_dir)
+    temp_dir_www <- file.path(temp_dir, "www")
+    dir.create(temp_dir_www)
+    shiny::onStop(function() { unlink(temp_dir, recursive = TRUE) })
+
+    svg_final <- shiny::reactive({
+      shiny::req(svg_inputs())
+
+      svg_inputs() %>% 
+        dplyr::mutate(line_mod = purrr::pmap_chr(list(line, shiny_value), function(line_, sv_) {
+          if (!is.na(sv_)) { line_ <- stringr::str_replace(line_, " ", paste0(" data-shinyclick='", sv_, "' ")) }
+          line_
+        }))
+    })
+
+    rv_filenames <- shiny::reactiveValues(r_function_file   = "",
+                                          js_file           = "",
+                                          r_sample_app_file = "")
+
+    # R function
+
+    r_function_file <- shiny::reactive({
+      shiny::req(svg_final())
+      shiny::req(input$name)
+
+      isolate({ if (rv_filenames$r_function_file != "") { unlink(rv_filenames$r_function_file) } })
+
+      filename <- write_svg_input_r_lines(svg_lines      = svg_final()$line_mod, 
+                                          svg_input_name = input$name,
+                                          class_name     = input$name,
+                                          include_css    = FALSE) %>% 
+        write_svg_input_r_file(lines = ., svg_input_name = input$name, path = temp_dir)
+
+      isolate({ rv_filenames$r_function_file <- filename })
+
+      filename
+    })
+
+    output$tab1 <- shiny::renderUI({ shiny::pre(shiny::includeText(r_function_file())) })
+    shiny::observe({ 
+      shiny::req(r_function_file())
+      r_function_file() 
+    }) # In case the tab isn't opened
+
+    output$dwnl_r_function <- shiny::downloadHandler(
+      filename = function() { paste0(input$name, ".R") }, 
+      content = function(file) { file.copy(r_function_file(), file) })
+
+    # JS
+
+    js_file <- shiny::reactive({
+      shiny::req(input$name)
+
+      isolate({ if (rv_filenames$js_file != "") { unlink(rv_filenames$js_file) } })
+
+      filename <- write_js_binding_lines(svg_input_id = input$data_element, class_name = input$name) %>% 
+        write_js_binding_file(svg_input_name = input$name, path = temp_dir_www)
+
+      isolate({ rv_filenames$js_file <- filename })
+
+      filename
+    })
+
+    output$tab2 <- shiny::renderUI({ shiny::pre(shiny::includeText(js_file())) })
+    shiny::observeEvent(js_file(), { js_file() }) # In case the tab isn't opened
+
+    output$dwnl_js <- shiny::downloadHandler(
+      filename = function() { paste0(input$name, ".js") }, 
+      content = function(file) { file.copy(js_file(), file) })
+
+    # R sample app
+
+    r_sample_app_file <- shiny::reactive({
+      shiny::req(input$name)
+
+      isolate({ if (rv_filenames$r_sample_app_file != "") { unlink(rv_filenames$r_sample_app_file) } })
+
+      filename <- write_svg_input_shiny_lines(svg_input_name = input$name) %>% 
+        write_svg_input_shiny_file(lines = ., svg_input_name = input$name, path = temp_dir)
+
+      isolate({ rv_filenames$r_sample_app_file <- filename })
+
+      filename
+    })
+
+    output$tab3 <- shiny::renderUI({ shiny::pre(shiny::includeText(r_sample_app_file())) })
+    shiny::observeEvent(r_sample_app_file(), { r_sample_app_file() }) # In case the tab isn't opened
+
+    output$dwnl_r_sample_app <- shiny::downloadHandler(
+      filename = function() { paste0("app_", input$name, ".R") }, 
+      content = function(file) { file.copy(r_sample_app_file(), file) })
+
+  })
+}

svgInput/R/mod_example_header.R

@@ -0,0 +1,26 @@
+
+mod_example_header_ui <- function(id, title = "") {
+  ns <- shiny::NS(id)
+
+  shiny::tagList(
+    shiny::HTML(paste0('<h2 class="hh2" style="color:#565656;text-align:center;margin-bottom:25px;"><b>&nbsp;GALLERY&nbsp;</b></h2>')),
+    # shiny::h2(shiny::tags$b(" GALLERY "), class = "hh2", style = "color:#565656;text-align:center;margin-bottom:25px;"),
+    shiny::fluidRow(
+      style = "color:#666666;",
+      shiny::column(width = 1, shiny::actionLink(ns("left"), NULL, icon = shiny::icon("chevron-left", "fa-2x"))),
+      shiny::column(width = 10, shiny::h2(title, style = "margin-top:-4px;")),
+      shiny::column(width = 1, shiny::actionLink(ns("right"), NULL, icon = shiny::icon("chevron-right", "fa-2x")))
+    ),
+    shiny::hr(style = "color:#666666")
+  )
+}
+
+mod_example_header_server <- function(id, parent, prev_tab, next_tab) {
+  shiny::moduleServer(id, function(input, output, session) {
+
+    shiny::observeEvent(input$left,  { shiny::updateTabsetPanel(session = parent, inputId = "wizard", selected = prev_tab) })
+    shiny::observeEvent(input$right, { shiny::updateTabsetPanel(session = parent, inputId = "wizard", selected = next_tab) })
+
+  })
+}
+