R/mod_setup.R

In joeheywood/tnsinp: Tennis Input

#' setup UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
#' @import fullPage
#' @import DT
mod_setup_ui <- function(id){
  ns <- NS(id)
  tagList(
    
    fullSlide(
      fullContainer(
        fullRow(
          h1("Start new video here"),
          textInput(ns("ytbid"), label = "YouTube ID: " ),
          selectInput(ns("ptp"), "First server top?",
                      choices = c("Yes", "No")),
          fullRow(
            fullColumn(
              textInput(ns("p1nm"), label = "Player 1: "),
              selectInput(ns("p1h"), "Player 1 hand:",
                          choices = c("Right", "Left")),
            ),
            fullColumn(
              textInput(ns("p2nm"), label = "Player 2: "),
              selectInput(ns("p2h"), "Player 1 hand:",
                          choices = c("Right", "Left")),
              actionButton(ns("blah"), "Go")
              
            )
          )
        )
      )
    ),
    fullSlide(
      fullContainer(
        fullRow(
          selectInput(ns("fls"), "File: ",
                      choices = c("file 1", "file2")),
          actionButton(ns("loadfl"), "Load")
        ),
        fullRow(
          dataTableOutput(ns("svdmtchs"))
          
        )
      )
    )
  )
}
    
#' setup Server Function
#'
#' @noRd 
mod_setup_server <- function(input, output, session){
  ns <- session$ns
  stp <- reactiveValues()
  stp$vidgo <- FALSE
  stp$fls <- c()
  stp$flsdf <- data.frame()
  
  observeEvent(input$blah, {
    stp$url <- input$ytbid
    stp$p1nm <- input$p1nm
    stp$p2nm <- input$p2nm
    stp$svtop <- input$ptp == "Yes"
    
    stp$vidgo <- TRUE
  })
  
  observeEvent(input$loadfl, {
    stp$fetch <- input$fls
    
  })
  
  observe({
    fls <- stp$fls
    req(length(fls) > 0)
    updateSelectInput(session, "fls", choices = fls)
  })
  
  observe({
    df <- stp$flsdf
    output$svdmtchs <- renderDataTable({
      df
    }, options = list(class = "compact", paging = FALSE,
                      searching = FALSE))
  })
  
  stp
}
    
    
## To be copied in the UI
# mod_setup_ui("setup_ui_1")
    
## To be copied in the server
# callModule(mod_setup_server, "setup_ui_1")