R/mod_court.R

In joeheywood/tnsinp: Tennis Input

#' court UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
#' @importFrom shinyjs runjs 
#' @import reticulate

reticulate::source_python("court_trans.py")

mod_court_ui <- function(id){
  ns <- NS(id)
  tagList(
    div(id = ns("court_stp"), 
        class = "love",
        
      p(textOutput(ns("courtmsg"))),
      actionButton(ns("rdrw"), "Redraw")
    )
 
  )
}
    
#' court Server Function
#'
#' @noRd 
mod_court_server <- function(input, output, session, vdp){
  ns <- session$ns
  ctstp <- reactiveValues()
  ctstp$corners <- c()
  
  observeEvent(input$rdrw, {
    vdp$mode <- "court"
  })
  
  observe({
    vdm <- vdp$mode
    req(vdm)
    req(vdm == "court")
    runjs("runCourtDims();")
    output$courtmsg <- renderText({
      "R: Court mode" 
    })
    
  })
  
  observe({
    a <- input$corners
    req(a)
    corners <- c(a$tl$x, a$tl$y, a$tr$x, a$tr$y, 
                 a$bl$x, a$bl$y, a$br$x, a$br$y)
    mnpoints <- py_get_main_points(corners)
    dct <- paste0(
      "drawCourt(", 
      paste(c(mnpoints$tl$x, mnpoints$tl$y,
              mnpoints$tr$x, mnpoints$tr$y,
              
              mnpoints$bl$x, mnpoints$bl$y,
              mnpoints$br$x, mnpoints$br$y,
              mnpoints$ltt$x, mnpoints$ltt$y,
              mnpoints$ltb$x, mnpoints$ltb$y,
              mnpoints$rtt$x, mnpoints$rtt$y,
              mnpoints$rtb$x, mnpoints$rtb$y,
              "'court_canv'"
      ), collapse = ", "),
      ");"
    )
    # print(dct)
    runjs(dct)
    ctstp$corners <- corners
  })
  
  ctstp
  
}
    
## To be copied in the UI
# mod_court_ui("court_ui_1")
    
## To be copied in the server
# callModule(mod_court_server, "court_ui_1")