In openvolley/volleyreport: Reports from Volleyball Match Files

knitr::opts_chunk$set(eval = TRUE, echo = FALSE, message = FALSE, warning = FALSE, tidy = FALSE, cache = FALSE, include = TRUE, dpi = 175, fig.width = 12, fig.height = 8, fig.align = "center", results = "markup")
options(knitr.kable.NA = "")

tf_abs <- function(f) system.file(file.path("extdata", f), package = "volleyreport")
kable_format <- "html"

beach <- isTRUE(grepl("beach", vsx$file_type))
if (isTRUE(vsx$plot_summary) || isTRUE(vsx$use_plot_icons)) showtext::showtext_opts(dpi = 175 * 2.2) ## not sure why this multiplier is needed

icon_names_for_key <- character()

if (vsx$shiny_progress) try(shiny::setProgress(value = 0.3, message = "Generating header"), silent = TRUE)

if (!is.null(vsx$header_extra_pre)) cat(vsx$header_extra_pre, "\n")

cat("<div style=\"max-height:20mm; overflow-y:hidden;\">\n") ## otherwise e.g. long text entries in the header (e.g. league name) cause the page to overflow to a second
if (!is.null(vsx$icon)) {
    cat("<table class=\"mtbl\"><tr><td width=\"15%\">\n")
    cat("<p style=\"margin:0;\"><img src=\"", vsx$icon, "\" style=\"max-width:90%; max-height:18mm;\" /></p>\n", sep = "")
    cat("</td>\n")
    cat("<td width=\"85%\">\n")
}

cat("<table class=\"mtbl\"><tr>\n")

cat("<td width=\"25%\">")
volleyreport:::vr_content_match_outcome(vsx, kable_format)
cat("</td>\n")

cat("<td width=\"17%\">")
volleyreport:::vr_content_match_date(vsx, kable_format)
cat("</td>\n")

cat("<td width=\"22%\">")
volleyreport:::vr_content_match_refs(vsx, kable_format)
cat("</td>\n")

cat("<td width=\"36%\">")
volleyreport:::vr_content_partial_scores(vsx, kable_format)
cat("</td></tr></table>\n")
if (!is.null(vsx$icon)) {
    cat("</td></tr></table>\n")
}
cat("</div>\n")

if (beach) cat("<div style=\"height:3mm\"></div>\n")

cat("<table class=\"mtbl\"><tr>\n")
cat("<td width=\"100%\">")
if (isTRUE(vsx$home_players)) {
    volleyreport:::vr_content_team_table(vsx, kable_format, which_team = "home")
} else {
    cat("<div style=\"font-size:", vsx$base_font_size * 11/12, "px; font-weight:bold;\">", datavolley::home_team(vsx$x), "</div>\n", sep ="")
}
cat("</td>\n")
cat("</tr></table>\n")

cat("<table class=\"mtbl\"><tr>\n")
stf <- volleyreport:::vr_content_team_staff(vsx, kable_format, which_team = "home")
## if we don't have staff, indent a little
cat0("<td width=\"", if (!is.null(stf)) 18 else 8, "%\">")
if (!is.null(stf)) stf
cat0("</td>\n<td width=\"", if (!is.null(stf)) 81 else 91, "%\">")
volleyreport:::vr_content_team_set_summary(vsx, kable_format, which_team = "home")
cat("</td></tr></table>\n")

cat0("<table class=\"mtbl\"><tr>")
cat0("<td width=\"", if (!is.null(stf)) 18 else 8, "%\"></td>\n")
cat0("<td width=\"", if (!is.null(stf)) 27 else 30, "%\">")
volleyreport:::vr_content_kill_rec_trans(vsx, which_team = "home", rec_trans = "rec", kable_format = kable_format, eval_codes = c("#", "+", "#+"), hdr = "1st attack after pos. reception (R+#)")
cat0("</td>\n<td width=\"", if (!is.null(stf)) 27 else 30, "%\">")
volleyreport:::vr_content_kill_rec_trans(vsx, which_team = "home", rec_trans = "rec", kable_format = kable_format, eval_codes = c("-", "!", "-/"), hdr = "1st attack after neg. reception (R-!)")
cat0("</td>\n<td width=\"", if (!is.null(stf)) 27 else 30, "%\">")
volleyreport:::vr_content_kill_rec_trans(vsx, which_team = "home", rec_trans = "trans", kable_format = kable_format, hdr = "Attack in transition")
cat("</td></tr></table>\n")

p <- volleyreport:::vr_content_score_evplot(vsx, with_summary = vsx$plot_summary)
if (!is.null(p)) {
    if (length(attr(p, "icon_names")) > 0) icon_names_for_key <- c(icon_names_for_key, attr(p, "icon_names"))
    print(p)
}

cat("<table class=\"mtbl\"><tr>\n")
cat("<td width=\"100%\">")
if (isTRUE(vsx$visiting_players)) {
    volleyreport:::vr_content_team_table(vsx, kable_format, which_team = "visiting")
} else {
    cat("<div style=\"font-size:", vsx$base_font_size * 11/12, "px; font-weight:bold;\">", datavolley::visiting_team(vsx$x), "</div>\n", sep ="")
}
cat("</td>\n")
cat("</tr></table>\n")

cat("<table class=\"mtbl\"><tr>\n")
stf <- volleyreport:::vr_content_team_staff(vsx, kable_format, which_team = "visiting")
## if we don't have staff, indent a little
cat0("<td width=\"", if (!is.null(stf)) 18 else 8, "%\">")
if (!is.null(stf)) stf
cat0("</td>\n<td width=\"", if (!is.null(stf)) 81 else 91, "%\">")
volleyreport:::vr_content_team_set_summary(vsx, kable_format, which_team = "visiting")
cat("</td>\n</tr></table>\n")

cat0("<table class=\"mtbl\"><tr>")
cat0("<td width=\"", if (!is.null(stf)) 18 else 8, "%\"></td>\n")
cat0("<td width=\"", if (!is.null(stf)) 27 else 30, "%\">")
volleyreport:::vr_content_kill_rec_trans(vsx, which_team = "visiting", rec_trans = "rec", kable_format = kable_format, eval_codes = c("#", "+", "#+"), hdr = "1st attack after pos. reception (R+#)")
cat0("</td>\n<td width=\"", if (!is.null(stf)) 27 else 30, "%\">")
volleyreport:::vr_content_kill_rec_trans(vsx, which_team = "visiting", rec_trans = "rec", kable_format = kable_format, eval_codes = c("-", "!", "-/"), hdr = "1st attack after neg. reception (R-!)")
cat0("</td>\n<td width=\"", if (!is.null(stf)) 27 else 30, "%\">")
volleyreport:::vr_content_kill_rec_trans(vsx, which_team = "visiting", rec_trans = "trans", kable_format = kable_format, hdr = "Attack in transition")
cat("</td></tr></table>\n")

if (vsx$shiny_progress) try(shiny::setProgress(value = 0.8, message = "Generating footer"), silent = TRUE)

cat("<div style=\"height:5mm\"></div>\n") ## space
rgs <- vsx$court_plots_args
rgs$x <- structure(list(meta = vsx$meta, plays = vsx$x), class = "datavolley")
if (!"use_icons" %in% names(rgs)) rgs$use_icons <- TRUE
if (!"icons" %in% names(rgs)) rgs$icons <- vsx$plot_icons
if (!"attack_plot_colour" %in% names(rgs)) rgs$attack_plot_colour <- vsx$css$header_background
if (!"reception_plot_colour" %in% names(rgs)) rgs$reception_plot_colour <- vsx$css$header_background
p <- do.call(vsx$court_plots_fun, rgs)
## p can have a "icon_names" attr, which tells us the names of the (fontawesome) icons that were used in the plots
if (length(attr(p, "icon_names")) > 0) icon_names_for_key <- c(icon_names_for_key, attr(p, "icon_names"))
if (!is.null(p)) print(p)

cat("<div class=\"sectionblock\">\n<table class=\"mtbl\"><tr>\n")
## left-hand content panel
cat0("<td", if (!beach) " width=\"78%\"", ">\n")

## team names
cat("<table class=\"mtbl\"><tr>\n")
cat0("<td width=\"50%\" style=\"font-size:", vsx$base_font_size * 10/12, "px; font-weight:bold; text-align:center; border-left:", vsx$css$border, "; border-top:", vsx$css$border, ";\">", vsx$meta$teams$team[1], "</td>\n")
cat0("<td width=\"50%\" style=\"font-size:", vsx$base_font_size * 10/12, "px; font-weight:bold; text-align:center; border-left:", vsx$css$border, "; border-top:", vsx$css$border, "; border-right:", vsx$css$border, ";\">", vsx$meta$teams$team[2], "</td>\n")
cat("</tr></table>\n")
cat("<table class=\"mtbl\"><tr>\n")

## home team points by rot
if (vsx$style %in% c("ov1")) {
    cat("<td width=\"29%\">\n")
    cat(volleyreport:::vr_content_points_by_rot(vsx, kable_format, which_team = "home"))
    cat("</td>\n")
} else {
    ## default, show points by rot vertically and other stuff next to it
    ## wtf? this doesn't work if it's an if { ...} else {...} block??
    cat0("<td width=\"10%\" style=\"border-right:", vsx$css$border, ";\">\n")
    cat(volleyreport:::vr_content_points_by_rot(vsx, kable_format, which_team = "home"))
    cat("</td>\n")
    cat0("<td width=\"19%\">\n")
    hteach <- volleyreport:::vr_content_team_each(vsx, kable_format, which_team = "home")
    for (this in hteach) cat(this, "\n")
    cat("</td>\n")
}

## middle content
cat0("<td width=\"42%\" style=\"border-right:", vsx$css$border, "; border-left:", vsx$css$border, ";\">\n")
volleyreport:::vr_content_kill_rec_trans(vsx, which_team = "both", rec_trans = "rec", kable_format = kable_format, eval_codes = c("#", "+", "#+"), hdr = "1st attack after pos. reception (R+#)")
volleyreport:::vr_content_kill_rec_trans(vsx, which_team = "both", rec_trans = "rec", kable_format = kable_format, eval_codes = c("-", "!", "-/"), hdr = "1st attack after neg. reception (R-!)")
volleyreport:::vr_content_kill_rec_trans(vsx, which_team = "both", rec_trans = "trans", kable_format = kable_format, hdr = "Attack in transition")
cat("</td>\n")

## visiting team points by rot
if (vsx$style %in% c("ov1")) {
    cat("<td width=\"29%\">\n")
    cat(volleyreport:::vr_content_points_by_rot(vsx, kable_format, which_team = "visiting"))
    cat("</td>\n")
} else {
    cat0("<td width=\"19%\" style=\"border-right:", vsx$css$border, ";\">\n")
    vteach <- volleyreport:::vr_content_team_each(vsx, kable_format, which_team = "visiting")
    for (this in vteach) cat(this, "\n")
    cat("</td>\n")
    ## wtf? this doesn't work if it's an if { ...} block??
    cat0("<td width=\"10%\">\n")
    cat(volleyreport:::vr_content_points_by_rot(vsx, kable_format, which_team = "visiting"))
    cat("</td>\n")
}
cat("</tr></table>\n")

## the right-hand panel for the report legend
cat0("</td><td width=\"", if (beach) 100 else 21.7, "%\">\n")
rgs <- list(vsx, kable_format = kable_format, icon_names = icon_names_for_key)
if (beach) rgs$rows <- 2 else rgs$cols <- 2
do.call(volleyreport:::vr_content_key, rgs)
cat("</td>\n")
cat("</tr></table>\n</div>\n")

if (length(vsx$footnotes) > 0) cat0("<div style=\"float:right; font-size:", vsx$base_font_size * 8/12, "px;\">", paste(footnotes, collapse = " "), "</p>")