R/mod_shot.R

In joeheywood/tnsinp: Tennis Input

#' shot UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
mod_shot_ui <- function(id){
  ns <- NS(id)
  tagList(
    div(id = ns("shotdiv"),
        class = "fifteen", 
		h4("Shot"),
        textOutput(ns("abt")),
        textOutput("htr"),
        textOutput("cntct"),
        textOutput("rcvr"),
        textOutput("bounce")
    )
  )
}
    
#' shot Server Function
#'
#' @noRd 
mod_shot_server <- function(input, output, session){
  ns <- session$ns
  sht <- reactiveValues()
  sht$shot <- list()
  sht$corners <- c()
  sht$balltop <- NULL
  sht$hit <- FALSE
  sht$ptop <- ""
  sht$pbtm <- ""
  
  
  observe({
    htr <- input$hitter
    crnrs <- isolate(sht$corners)
    btop <- isolate(sht$balltop)
    tp <- isolate(sht$balltop)
    ptp <- isolate(sht$ptop)
    pbt <- isolate(sht$pbtm)
    req(htr)  
    req(length(crnrs) == 8)
    output$abt <- renderText({
      ifelse(tp == TRUE, ptp, pbt)
    })
    
    
    tp <- ifelse(btop == TRUE, 1, -1)
    
    h = py_get_line_points(crnrs, htr$x, htr$y, tp)
    h$tp <- tp
    h$p <- htr
    hjs <- toJSON(h)
    jjs <- paste0( "mtch.draw_player(", hjs, ");") 
    runjs(jjs)
    sht$hit <- TRUE
    
  })
  
  observe({
    pp <- input$shot
    crnrs <- isolate(sht$corners)
    req(pp)
    req(crnrs)
    shot <- list(
      h = py_get_coords(crnrs, pp$h$x, pp$h$y),
      r = py_get_coords(crnrs, pp$r$x, pp$r$y),
      cntct = py_get_coords(crnrs, pp$cntct$x, pp$cntct$y),
      ball = py_get_coords(crnrs, pp$ball$x, pp$ball$y),
      hght = pp$hght
    )
    shot$h$rtm <- pp$h$rtm
    shot$r$rtm <- pp$r$rtm
    shot$ball$rtm <- pp$ball$rtm
    sht$shot <- shot
  })
  sht
 
}
    
## To be copied in the UI
# mod_shot_ui("shot_ui_1")
    
## To be copied in the server
# callModule(mod_shot_server, "shot_ui_1")