tnsinp: Tennis Input

#' match UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
#' @importFrom jsonlite toJSON
#' @import dplyr



mod_match_ui <-function(id){
  ns <- NS(id)
  tagList(
    div(
      id = ns("match_stp"),
      class = "forty",
      p(textOutput(ns("courtmsg")) ), 
      tableOutput(ns("scr")),
      actionButton(ns("shwcrt"), "Court"),
      actionButton(ns("sv"), "Save"),
      actionButton(ns("lst"), "Delete point")
    ),
  )
}
    
#' match Server Function
#'
#' @noRd 
mod_match_server <- function(input, output, session, vdp, crt, pnt, stp, drp){
  ns <- session$ns
  mtch <- reactiveValues()
  mtch$p1nm <- mtch$p2nm <- ""
  mtch$crnrs <- c()
  mtch$corners <- c()
  mtch$shotsdf <- data.frame()
  mtch$scoredf <- data.frame()
  mtch$score <- data.frame(
    name = c("p1", "p2"),
    games = c(0, 0),
    points = c(0, 0)
    )
  mtch$pntid <- 0
  
  check_court <- function() {
    corners <- mtch$corners
    req(length(corners) == 8)
    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,
              "'match_canv'"
      ), collapse = ", "),
      ");"
    )
    runjs(dct)
  }
  
  observe({
    sn <- pnt$shotnum
    check_court()
  })
  
  observeEvent(input$shwcrt, {
    check_court()
    
  })
  
  observeEvent(input$lst, { ##  on clicking delete point button
    ### get id from scoredf
    mpnt <- max(mtch$scoredf$pntid)
    print(paste0("REMOVING LAST POINT ", mpnt))
    
    ### remove from scoredf and shotsdf
    mtch$scoredf <- mtch$scoredf %>% filter(pntid < mpnt)
    mtch$shotsdf <- mtch$shotsdf %>% filter(pntid < mpnt)
    ### update scoreboard and pointid
    mtch$score$points <- c(tail(mtch$scoredf$p1pnts, 1),
                           tail(mtch$scoredf$p2pnts, 1))
    mtch$pntid <- mpnt 
    
    
    ## (previous game?)
    
  })
  
  observe({ # on change to score data.frame
    df <- mtch$score
    df$Player <- df$name
    df$Games <- df$games
    df$oddeven <- ifelse(df$points %% 2 == 0, 4, 5)
    df$points <- ifelse(df$points > 5, df$oddeven, df$points)
    scoredict <- c("0", "15", "30", "40", "A")
    df$Points <- scoredict[df$points + 1]
    df <- df %>% select(Player, Games, Points)
    
    
    output$scr <- renderTable({
      df
    })
  })
  
  observe({ ## on video being ready
    stpgo <- stp$vidgo
    req(stpgo == TRUE)
    mtch$p1nm <- stp$p1nm
    mtch$p2nm <- stp$p2nm
    mtch$svtop <- stp$svtop
    output$otpt <- renderUI({
      HTML("<div id = 'player'></div><script src='www/youtube.js'></script>")
    })
  })
  
  
  observe({ #### ON POINT WINNER
    pdf <- pnt$pntdf
    call <- pnt$call
    df <- isolate(mtch$score)
    mpdf <- isolate(mtch$shotsdf)
    scrdf <- isolate(mtch$scoredf)
    pntid <- isolate(mtch$pntid)
    req("pointwinner" %in% names(pdf))
    print("POINT WINNER")
    
    save(pdf, df, mpdf, scrdf, pntid, file = "debug2.Rda")
    w <- which(df$name == unique(pdf$pointwinner))
    wl <- which(!df$name == unique(pdf$pointwinner))
    df$points[w] <- df$points[w] + 1
    pntid <- pntid + 1
    pdf$pntid <- pntid
    mtch$shotsdf <- rbind(mpdf, pdf)
    mtch$pntid <- pntid
    # df$ptind <- pntid
    
    ## send to dropbox ##
    
    if(df$points[w] >= 4 & df$points[w] - df$points[wl] >= 2) {
      print("GAME!")
      df$games[w] <- df$games[w] + 1
      df$points <- c(0, 0)
      if(sum(df$games) %% 2 == 1) {
        ###
        ptp <- isolate(pnt$plytop)
        pbt <- isolate(pnt$plybtm)
        pnt$plytop <- pbt
        pnt$plybtm <- ptp
      } else {
        ptp <- isolate(pnt$playertop)
        pnt$playertop <- ifelse(ptp == TRUE, FALSE, TRUE)
      }
      ## change server
      ## change ends? 
    }
    
    
    
    thisscrdf <- data.frame(
      pntid = pntid,
      p1pnts = df$points[1],
      p1gms = df$games[1],
      p2pnts = df$points[2],
      p2gms = df$games[2],
      call = call)
    
    
    mtch$scoredf <- rbind(scrdf, thisscrdf)
    drp$scoredf <- isolate(mtch$scoredf)
    drp$shotsdf <- isolate(mtch$shotsdf)
    drp$plytop <- isolate(pnt$plytop)
    drp$plybtm <- isolate(pnt$plybtm)
    drp$save <- TRUE
    pnt$refresh <- TRUE
    mtch$score <- df
    
    output$courtmsg <- renderText({
      paste0("POINT TO ", unique(pdf$pointwinner), 
             "(", pntid, ")")
    })
  })
  
  observe({ #### on change of mode.
    vdm <- vdp$mode
    req(vdm)
    req(vdm == "match")
    runjs("mtch = new MatchMode();")
    
    
  })
  
  
  observe({ #### when corners are ready
    
    crn <- crt$corners
    req(length(crn) == 8)
    
    mtch$corners <- crn
    pnt$corners <- crn
    drp$p1nm <- mtch$p1nm
    drp$p2nm <- mtch$p2nm
    drp$ytbid <- stp$url
    drp$svtop <- mtch$svtop
    drp$corners <- crn
    pnt$plytop <- drp$plytop
    pnt$plybtm <- drp$plybtm
    pnt$plytop <- ifelse(mtch$svtop == TRUE, mtch$p1nm, mtch$p2nm)
    print("this should really only be run when corners are loaded first time")
    drp$save <- TRUE
    # print("~~~~===~~~~~~~~~")
    # print(paste0(pnt$plytop, " is top"))
    
  })
  
  observe({
    fls <- drp$saved_matches
    dat <- drp$matchesdf
    req(length(fls) > 0)
    stp$fls <- fls
    stp$flsdf <- dat
  })
  
  observe({ ## when file to load is called in setup
    ftch <- stp$fetch
    req(nchar(ftch) > 0)
    drp$fetch <- ftch
    
  })
  
  
  observe({ # when loaded from dropbox
    ld <- drp$loaded
    req(ld == TRUE)
    crn <- drp$corners
    req(length(crn) == 8)
    mtch$corners <- crn
    pnt$corners <- crn
    mtch$corners <- crn
    stp$url <- drp$ytbid
    mtch$p1nm <- drp$p1nm
    mtch$p2nm <- drp$p2nm
    pnt$plytop <- drp$plytop
    pnt$plybtm <- drp$plybtm
    print("LOADING FROM DROPBOX")
    print("~~~~~~~~~~~~~")
    print(paste0(pnt$plytop, " is top"))
    mtch$score$name <- c(mtch$p1nm, mtch$p2nm)
    sdf <- drp$scoredf
    w <- nrow(sdf)
    if(w > 0) {
      mtch$score <- data.frame(
        name= c(isolate(mtch$p1nm), isolate(mtch$p2nm)),
        points = c(sdf$p1pnts[w], sdf$p2pnts[w]),
        games = c(sdf$p1gms[w], sdf$p2gms[w])
        )
      
    } 
    pntid <- max(sdf$pntid)
    if(pntid %in% 1:10000) {
      mtch$pntid <- pntid
    } else {
      pntid <- 0
    }
    mtch$scoredf <- sdf
    mtch$shotsdf <- drp$shotsdf
    mtch$svtop <- drp$svtop
    pnt$playertop <- drp$svtop
    stp$vidgo <- TRUE
    pnt$refresh <- TRUE
    drp$loaded <- FALSE
  })
  
  
  
  mtch
  
  
  
}
    
## To be copied in the UI
# mod_match_ui("match_ui_1")
    
## To be copied in the server
# callModule(mod_match_server, "match_ui_1")


#### TODO

# - Volley isn't working
# - For college, we need to add in sudden-death deuce