

# Create Tables ----------------------------------------------------------


#' @noRd
create_table_pages_pdf <- function(rs, cntnt, lpg_rows) {
  
  ts <- cntnt$object
  content_blank_row <- cntnt$blank_row
  
  pgby_var <- NA
  pgby_cnt <- 0
  pgby_fmt <- NULL
  if (!is.null(rs$page_by)) {
    pgby_var <- rs$page_by$var
    pgby_fmt <- rs$page_by$format
  } else if (!is.null(ts$page_by)) {
    pgby_var <- ts$page_by$var
    pgby_fmt <- ts$page_by$format
  }
  
  
  if (all(ts$show_cols == "none") & length(ts$col_defs) == 0) {
    
    stop("ERROR: At least one column must be defined if show_cols = \"none\".")
  }
  
  font_name <- rs$font
  
  # Set up control columns
  dat <- as.data.frame(ts$data, stringsAsFactors = FALSE)  
  dat$..blank <- ""
  dat$..row <- 1
  dat$..page_by <- NA
  
  # If page_break variable has been defined, use it
  if (is.null(ts$page_var)) {
    if (is.na(pgby_var))
      dat$..page <- NA
    else 
      dat$..page <-  dat[[pgby_var]]
    
  } else {
    if (any(class(dat[[ts$page_var]]) == "factor"))
      dat$..page <- as.character(dat[[ts$page_var]])
    else 
      dat$..page <- dat[[ts$page_var]]
  }
  
  # If page by is defined, use it
  if (!is.na(pgby_var)) {
    
    # Clear out factors on page by if they exist
    # Needed because split cells used to convert everything to characters
    if (any(class(dat[[pgby_var]]) == "factor")) {
      dat[[pgby_var]] <- as.character(dat[[pgby_var]] )
      dat$..page_by <- dat[[pgby_var]] 
      
      if (any(class(dat$..page) == "factor")) 
        dat$..page <- as.character(dat[[pgby_var]])
      
    } else {
      
      if (!is.null(pgby_fmt))
        dat$..page_by <-  fapply(dat[[pgby_var]], pgby_fmt)
      else 
        dat$..page_by <- dat[[pgby_var]]
    }
    
    pgby_cnt <- get_pgby_cnt(dat$..page_by)
    
    # Commenting out for now
    # if (is.unsorted(dat[[pgby_var]], strictly = FALSE))
    #   message("Page by variable not sorted.")
  }
  
  # Deal with invisible columns
  if (!is.null(ts$col_defs)) {
    for (def in ts$col_defs) {
      if (def$visible == FALSE) {
        nnm <- paste0("..x.", def$var_c)
        dat[[nnm]] <- dat[[def$var_c]]
      }
    }
    
    # Deal with Group Cohesion
    # Prepare ..group_cohesion and ..min_page_prop
    group_cohesion <- c()
    min_page_prop <- c()
    
    i <- 1
    for (def in ts$col_defs) {
      if (def$group_cohesion == TRUE) {
        group_cohesion <- c(group_cohesion, def$var_c)
        min_page_prop <- c(min_page_prop, def$min_page_prop)
        
        dat$..temp <- dat[[def$var_c]]
        names(dat)[names(dat) == "..temp"] <-  paste0("..group_cohesion",i)
        
        dat$..temp <- def$min_page_prop
        names(dat)[names(dat) == "..temp"] <-  paste0("..min_page_prop",i)
        i <- i + 1
      }
    }
    
    if (length(group_cohesion) == 0) {
      group_cohesion <- NULL
    }
    
    if (length(min_page_prop) == 0) {
      min_page_prop <- NULL
    }
    
    # Prepare empty ..break_label and ..break_label_lines for later use
    i <- 1
    for (def in ts$col_defs) {
      if (!is.null(def$break_label)) {
        
        dat$..temp <- ifelse(!is.na(dat[[def$var_c]]) & dat[[def$var_c]] != "",
                             paste0(dat[[def$var_c]], " ", def$break_label),
                             dat[[def$var_c]])
        names(dat)[names(dat) == "..temp"] <-  paste0("..break_label",i)
        
        dat$..temp <- rep(NA, nrow(dat))
        names(dat)[names(dat) == "..temp"] <-  paste0("..break_label_lines",i)
        i <- i + 1
      }
    }
    # Prepare repeated label occurrence for later use
    if (any(grepl("..break_label", names(dat)))) {
      dat$..break_occur <- rep(NA, nrow(dat))
    }
  }
  
  # Get control column names 
  control_cols <- names(dat)[is.controlv(names(dat))]
  
  # Get vector of all included column names
  # Not all columns in dataset are necessarily included
  # depends on show_cols parameter on create_table and
  # visible parameter on column definitions
  keys <- get_table_cols(ts, control_cols)
  # print("keys")
  # print(keys)
  
  # Filter dataset by included columns
  dat <- get_data_subset(dat, keys, rs$preview)
  # print("Key columns:")
  # print(dat)
  
  # Update column definitions with column defaults
  ts$col_defs <- set_column_defaults(ts, keys)
  # print("col_defs:")
  # print(ts$col_defs)
  
  # Deal with styles
  styles <- get_styles(ts)
  
  # Get labels
  labels <- get_labels(dat, ts)
  # print("Labels:")
  # print(labels)
  
  # Get column alignments
  aligns <- get_aligns(dat, ts)
  
  # Get alignment for labels
  # Follows column alignment by default
  label_aligns <- get_label_aligns(ts, aligns)
  # print("Label Aligns:")
  # print(label_aligns)
  
  # Clear out existing formats
  cdat <- clear_formats(dat)
  
  # Get column formats
  formats(cdat) <- get_col_formats(dat, ts)
  # print("formats:")
  # print(formats(cdat))
  
  # Apply formatting
  fdat <- fdata(cdat)
  # print("fdata:")
  # print(fdat)
  
  # Prep data for blank lines, indents, and stub columns
  fdat <- prep_data(fdat, ts, rs$char_width, rs$missing) # OK
  # print("prep_data")
  # print(fdat)
  # str(fdat)
  
  # Add stub_var into control_cols for adding indentation
  if ("..stub_var" %in% names(fdat)) {
    control_cols <- c(control_cols, "..stub_var")
  }
  
  if ("..group_border" %in% names(fdat)) {
    control_cols <- c(control_cols, "..group_border")
  }
  
  # Reset keys, since prep_data can add/remove columns for stub
  keys <- names(fdat)
  # print("Keys")
  # print(keys)
  # print("Aligns")
  # print(aligns)
  
  # Copy any width attributes to formatted data frame
  if ("width" %in% ts$use_attributes)
    widths(fdat) <- widths(dat)
  # print("Original Widths")
  # print(widths(dat))
  
  
  # Get column widths
  widths_uom <- get_col_widths_variable(fdat, ts, labels, 
                                        rs$font, rs$font_size, rs$units, 
                                        rs$gutter_width) 
  # print("Widths UOM")
  # print(widths_uom)
  
  # Split long text strings into multiple rows. Number of rows are stored in
  # ..row variable. If too slow, may need to be rewritten in C
  sp <- split_cells_variable(fdat, widths_uom, rs$font, 
                               rs$font_size, rs$units, rs$output_type, rs$char_width, ts) 
  fdat <- sp$data
  wdat <- sp$widths
  
  # print("split_cells")
  # print(fdat)
  
  
  # Break columns into pages
  wraps <- get_page_wraps(rs$line_size, ts, 
                          widths_uom, 0, control_cols)  # No gutter width for RTF
  # print("wraps")
  # print(wraps)
  
  
  # Create a temporary page info to pass into get_content_offsets
  tmp_pi <- list(keys = keys, col_width = widths_uom, label = labels,
                 label_align = label_aligns, table_align = cntnt$align, data = fdat)
  # print("Temp PI")
  # print(tmp_pi)
  
  
  # Offsets are needed to calculate splits and page breaks
  content_offset <- get_content_offsets_pdf(rs, ts, tmp_pi, 
                                            content_blank_row, pgby_cnt)
  
  # Need to do something with widths
  # split rows
  splits <- get_splits_text(fdat, widths_uom, rs$body_line_count, 
                            lpg_rows, content_offset$lines, ts, TRUE)  
  # print("splits")
  # print(splits)
  
  # Subset splits by preview, if requested
  if (!is.null(rs$preview)) {
    if (rs$preview < length(splits))
      splits <- splits[seq(1, rs$preview)] 
  }
  
  tot_count <- length(splits) * length(wraps)
  counter <- 0
  wrap_flag <- FALSE
  blnk_ind <- "none"
  spstart <- 1
  spend <- 1
  fp_offset <- lpg_rows
  
  pg_lst <- list()
  for(s in splits) {
    
    # Subset text widths by current split rows
    #spend <- spstart + nrow(s) - 1
    
    # If the data is changed because of break labels, grab the original row labels
    break_num <- NULL
    if (any(grepl("break_label", rownames(s)))) {
      rnms <- rownames(s)[!grepl("break_label", rownames(s))]
      break_num <- sum(grepl("break_label", rownames(s)))
    } else {
      rnms <- rownames(s)
    }
    
    spstart <- rnms[1]
    spend <- rnms[length(rnms)]
    spwidths <- wdat[seq(spstart, spend)]
    
    # Add additional objects for width data to align with new break label data
    if (!is.null(break_num)) {
      for (b in 1:break_num) {
        spwidths <- append("", spwidths)
      }
    }
    
    
    for(pg in wraps) {
      counter <- counter + 1
      
      if (counter < tot_count) {
        wrap_flag <- TRUE
      } else {
        wrap_flag <- FALSE
      } 
      
      #print(s)
      if (!is.na(pgby_var)) {
        pgby <- trimws(s[1, "..page_by"])
      } else {
        pgby <- NULL
      } 
      
      # Ensure content blank rows are added only to the first and last pages
      blnk_ind <- get_blank_indicator(counter, tot_count, content_blank_row,
                                      rs$body_line_count, content_offset$lines, 
                                      nrow(s), pgby)
      #print(blnk_ind)
      
      pi <- page_info(data= s[, pg], keys = pg, label=labels[pg],
                      col_width = widths_uom[pg], col_align = aligns[pg],
                      font_name = font_name, label_align = label_aligns[pg],
                      pgby, cntnt$align)
      pg_lst[[length(pg_lst) + 1]] <- create_table_pdf(rs, ts, pi, 
                                                       blnk_ind, wrap_flag,
                                                       fp_offset, spwidths, styles)
      
      fp_offset <- 0
    }
    
    #spstart <- spend + 1
  }
  
  ret <- list(widths = widths_uom, page_list = pg_lst)
  
  return(ret)
  
  
}



#' @noRd
create_table_pdf <- function(rs, ts, pi, content_blank_row, wrap_flag, 
                             lpg_rows, spwidths, styles) {
  rh <- rs$row_height
  ys <- lpg_rows * rh
  conv <- rs$point_conversion
  bf <- FALSE
  
  # Default to content width
  ls <- rs$content_size[["width"]]
  
  ys <- sum(ys, rs$page_template$page_header$points, 
            rs$page_template$titles$points, rs$page_template$title_hdr$points)
  
  # Get table width
  if (!is.null(pi$col_width))
    ls <- sum(pi$col_width, na.rm = TRUE)
  
  if (content_blank_row %in% c("above", "both"))
    ys <- ys + rh
  
  if (!is.null(ts$title_hdr)) {
    ttls <- get_title_header_pdf(ts$title_hdr, ls, rs, pi$table_align, 
                                 ystart = ys)
    
  } else {
    ttls <- get_titles_pdf(ts$titles, ls, rs, pi$table_align, ystart = ys) 
  }
  
  ys <-  ys + ttls$points 
  if (ttls$lines > 0)
    bf <- ttls$border_flag
  
  if (!is.null(rs$page_by)) {
    pgby <- get_page_by_pdf(rs$page_by, rs$content_size[["width"]], 
                            pi$page_by, rs, pi$table_align, ystart = ys,
                            brdr_flag = bf)
  } else if(!is.null(ts$page_by)) {
    pgby <- get_page_by_pdf(ts$page_by, ls, pi$page_by, rs, pi$table_align, 
                            ystart = ys, brdr_flag = bf)
  } else {
    pgby <- c()
  } 
  
  if (length(pgby) > 0) {
    ys <- ys + pgby$points
    bf <- pgby$border_flag 
  }
  
  shdrs <- list(lines = 0, points = 0)
  hdrs <- list(lines = 0, points = 0)
  
  if (ts$headerless == FALSE) {
    shdrs <- get_spanning_header_pdf(rs, ts, pi, ystart = ys,
                                     brdr_flag = bf)
    
    ys <- ys + shdrs$points
    
    hs <- FALSE
    if (shdrs$lines > 0) {
      bf <- shdrs$border_flag
      hs <- TRUE
    }
    
    hdrs <- get_table_header_pdf(rs, ts, pi$col_width, 
                                 pi$label, pi$label_align, 
                                 pi$table_align, ystart = ys,
                                 brdr_flag = bf, has_spans = hs)
    
    ys <- ys + hdrs$points
  }
  
  # rs, ts, widths,  algns, halgns, talgn
  bdy <- get_table_body_pdf(rs, pi$data, pi$col_width, 
                            pi$col_align, pi$table_align, ts$borders,
                            ystart = ys,
                            spwidths, frb = ts$first_row_blank, styles = styles,
                            ts = ts)
  ys <- ys + bdy$points


  if (bdy$lines > 0)
    bf <- bdy$border_flag
  
  # blnks <- c()
  
  # Get row count by summing ..row variable
  # if ("..row" %in% names(pi$data)) {
  #   rcnt <- sum(pi$data$..row)
  # } else {
  #   rcnt <- nrow(pi$data) 
  # }
  
  
  # Get footnotes, passing in sum of all current lines
  ftnts <- get_page_footnotes_pdf(rs, ts, ls, lpg_rows, ys,
                                  wrap_flag, content_blank_row,  pi$table_align,
                                  brdr_flag = bf)
  
  # Deal with cell padding.  Don't count this in line count.
  # cp <- paste0("\\li", rs$cell_padding, "\\ri", rs$cell_padding, rs$spacing_multiplier)
  
  # # On LibreOffice, have to protect the table from the title width or
  # # the table row will inherit the title row width. Terrible problem.
  # tpt <- "{\\pard\\fs1\\sl0\\par}"
  # if (any(ts$borders %in% c("all", "top", "outside"))) {
  #   if (ttls$border_flag | rs$page_template$titles$border_flag |  
  #       rs$page_template$title_hdr$border_flag)
  #     tpt <- ""
  #   
  #   if (length(pgby) > 0) {
  #     if (pgby$border_flag)
  #       tpt <- ""
  #   }
  # }
  # 
  # # Same thing as above with titles.  If footnote block is contiguous
  # # with table and footnotes are wider than table, row width of footnotes
  # # will infect row width of table.  On libre only.  So this is to protect
  # # the table width.
  # bpt <- "{\\pard\\fs1\\sl0\\par}"
  # if (any(ts$borders %in% c("all", "top", "outside", "body"))) {
  #   if (!is.null(ftnts)) {
  #     if (ftnts$border_flag)
  #       bpt <- ""
  #   }
  #   
  #   if (!is.null(rs$page_template$footnotes)) {
  #     if (rs$page_template$footnotes$border_flag)
  #       bpt <- ""
  #   }
  # }
  
  # Determine sum of all lines
  rc <- sum(ttls$lines, pgby$lines, shdrs$lines, 
            hdrs$lines, bdy$lines, ftnts$lines)
  
  ret <- list(pdf = c(ttls$pdf, pgby$pdf, shdrs$pdf, 
                      hdrs$pdf, bdy$pdf, ftnts$pdf),
              lines = rc,
              points = rc * rh)
  
  return(ret) 
}

get_page_footnotes_pdf <- function(rs, spec, spec_width, lpg_rows, ystart,
                                   wrap_flag, content_blank_row, talgn,
                                   brdr_flag = FALSE) {
  
  ftnts <- list(lines = 0, twips = 0, border_flag = FALSE)
  vflag <- "none"
  
  fl <- rs$page_template$page_footer$lines
  
  # Deal with valign parameter
  if (!is.null(spec$footnotes)) {
    if (!is.null(spec$footnotes[[length(spec$footnotes)]])) {
      if (spec$footnotes[[length(spec$footnotes)]]$valign == "bottom") {
        
        vflag <- "bottom"
        ftnts <- get_footnotes_pdf(spec$footnotes, 
                                   spec_width, rs, 
                                   talgn, footer_lines = fl) 
      } else {
        vflag <- "top"
        ftnts <- get_footnotes_pdf(spec$footnotes, spec_width, rs, talgn,
                                   ystart = ystart,
                                   brdr_flag = brdr_flag) 
      }
      
    }
  } else {
    
    if (!is.null(rs$footnotes[[1]])) {
      if (!is.null(rs$footnotes[[1]]$valign)) {
        if (rs$footnotes[[1]]$valign == "top") {
          vflag <- "top"
          ftnts <- get_footnotes_pdf(rs$footnotes, 
                                     spec_width, rs, 
                                     talgn, ystart = ystart,
                                     brdr_flag = brdr_flag) 
        } else {
          
          if (wrap_flag)
            vflag <- "bottom" 
        }
      }
    }
  }
  

  blen <- 0
  if (content_blank_row %in% c("below", "both")) {
    blen <- 1
  }
  # } else {
  #   b <- paste0("\\fs1\\sl0\\par\\pard", rs$font_rtf, rs$spacing_multiplier)
  # }
  
  # Add extra offsets if table has a lot of borders turned on
  # to avoid undesired page wraps
  # boff <- 0
  # if (any(class(spec) == "table_spec") &
  #     any(spec$borders %in% c("all", "inside"))) {
  #   
  #   boff <- round(row_count * rs$border_height / rs$row_height)
  # }
  
  tlns <- ftnts$lines + blen
  ret <- list(pdf = ftnts$pdf,
              lines = tlns,
              points = tlns * rs$line_height,
              border_flag = ftnts$border_flag)
  
  return(ret)
}

# Sub-Functions ---------------------------------------------------------


#' Get content offsets for table header, titles, footnotes, and content blanks.
#' Needed to calculate page breaks accurately.
#' @return A vector of upper and lower offsets
#' @noRd
get_content_offsets_pdf <- function(rs, ts, pi, content_blank_row, pgby_cnt = NULL) {
  
  ret <- c(upper = 0, lower = 0, blank_upper = 0, blank_lower = 0)
  cnt <- c(upper = 0, lower = 0, blank_upper = 0, blank_lower = 0)
  
  # Width is normally the width of the table, not the page
  wdth <- rs$content_size[["width"]]
  if (!is.null(pi$col_width))
    wdth <- sum(pi$col_width)
  
  # Default to zero
  shdrs <- list(lines = 0, points = 0)
  hdrs <- list(lines = 0, points = 0)
  
  if (ts$headerless == FALSE) {
    shdrs <- get_spanning_header_pdf(rs, ts, pi)   
    
    hdrs <- get_table_header_pdf(rs, ts, pi$col_width, 
                                 pi$label, pi$label_align, 
                                 pi$table_align)  
  }
  
  # Get title headers or titles
  if (is.null(ts$title_hdr))
    ttls <- get_titles_pdf(ts$titles, wdth, rs) 
  else 
    ttls <- get_title_header_pdf(ts$title_hdr, wdth, rs)
  
  # Get page by if it exists
  # if (!is.null(ts$page_by))
  #   pgb <- get_page_by_pdf(ts$page_by, wdth, NULL, rs, pi$table_align, pgby_cnt = pgby_cnt)
  # else if (!is.null(rs$page_by))
  #   pgb <- get_page_by_pdf(rs$page_by, wdth, NULL, rs, pi$table_align, pgby_cnt = pgby_cnt)
  
  
  #print(length(pgb))
  
  # print(paste("Table titles:", ttls))
  
  # Add everything up
  # ret[["upper"]] <- shdrs$points + hdrs$points + ttls$points + pgb$points
  # cnt[["upper"]] <- shdrs$lines + hdrs$lines + ttls$lines + pgb$lines
  
  page_by_info <- NULL
  if (!is.null(ts$page_by)) {
    page_by_info <- ts$page_by
  } else if (!is.null(rs$page_by)) {
    page_by_info <- rs$page_by
  }
  
  # Get lines for each page by value
  if (!is.null(page_by_info)) {
    ret <- c(upper = list(), lower = 0, blank_upper = 0, blank_lower = 0)
    cnt <- c(upper = list(), lower = 0, blank_upper = 0, blank_lower = 0)
    
    pgby_unique <- unique(pi$data$..page_by)
    
    for (i in 1:length(pgby_unique)) {
      pgby_temp <- get_page_by_pdf(page_by_info, wdth, pgby_unique[i], rs, pi$table_align, pgby_cnt = pgby_cnt)
      
      # Add everything up
      ret[["upper"]][[i]] <- shdrs$points + hdrs$points + ttls$points + pgby_temp$points
      cnt[["upper"]][[i]] <- shdrs$lines + hdrs$lines + ttls$lines + pgby_temp$lines
    }
    
    names(ret[["upper"]]) <- pgby_unique
    names(cnt[["upper"]]) <- pgby_unique
    
  } else {
    pgb <- list(lines = 0, points = 0)
    pgb <- get_page_by_pdf(page_by_info, wdth, NULL, rs, pi$table_align, pgby_cnt = pgby_cnt)
    ret <- c(upper = 0, lower = 0, blank_upper = 0, blank_lower = 0)
    cnt <- c(upper = 0, lower = 0, blank_upper = 0, blank_lower = 0)
    
    # Add everything up
    ret[["upper"]] <- shdrs$points + hdrs$points + ttls$points + pgb$points
    cnt[["upper"]] <- shdrs$lines + hdrs$lines + ttls$lines + pgb$lines
    
  }
  
  if (content_blank_row %in% c("above", "both")) {
    ret[["blank_upper"]] <- rs$line_height
    cnt[["blank_upper"]] <- 1 
  }
  
  ftnts <- get_footnotes_pdf(ts$footnotes, wdth, rs) 
  rftnts <- get_footnotes_pdf(rs$footnotes, wdth, rs)
  
  if (has_top_footnotes(rs)) {
    ret[["lower"]] <- ftnts$points + rftnts$points
    cnt[["lower"]] <- ftnts$lines + rftnts$lines
  } else {
    ret[["lower"]] <- ftnts$points
    cnt[["lower"]] <- ftnts$lines
  }
  
  # Add extra offsets if table has a lot of borders turned on
  # to avoid undesired overlay
  # Not perfect but good enough
  brdrs <- strip_borders(ts$borders )
  if (any(brdrs %in% c("all", "inside"))) {
    if (is.null(page_by_info)) {
      
      epnts <- floor(rs$body_line_count - cnt[["lower"]] - cnt[["upper"]]) * rs$border_height 
      ret[["lower"]] <- ret[["lower"]] + epnts - rs$line_height
      cnt[["lower"]] <- cnt[["lower"]] + floor(epnts / rs$row_height) - 1
      
    } else {
      
      # Convert lower to list because of different upper
      ret_lower <- ret[["lower"]]
      cnt_lower <- cnt[["lower"]]
      ret[["lower"]] <- list()
      cnt[["lower"]] <- list()
      
      for (i in 1:length(pgby_unique)) {
        epnts <- floor(rs$body_line_count - cnt_lower - cnt[["upper"]][[i]]) * rs$border_height 
        ret[["lower"]][[i]] <- ret_lower + epnts - rs$line_height
        cnt[["lower"]][[i]] <- cnt_lower + floor(epnts / rs$row_height) - 1
      }
      
      names(ret[["lower"]]) <- pgby_unique
      names(cnt[["lower"]]) <- pgby_unique
    }
  }
  
  if (content_blank_row %in% c("both", "below")) {
    ret[["blank_lower"]] <- rs$line_height
    cnt[["blank_lower"]] <- 1 
  }
  
  res <- list(lines = cnt,
              points = ret)
  
  return(res)
  
}


#' @description Return a vector of strings for the table header
#' @details Basic idea of this function is to create a list
#' of string vectors of label words sized according to the column 
#' widths, then combine by line/row, and concatenate everything and justify.
#' @noRd
get_table_header_pdf <- function(rs, ts, widths, lbls, halgns, talgn, 
                                 ystart = 0, brdr_flag = FALSE, 
                                 has_spans = FALSE) {
  
  ret <- c()
  cnt <- 0
  rh <- rs$row_height 
  bs <- rs$border_spacing
  bh <- rs$border_height
  tbl <- ts$data
  conv <- rs$point_conversion
  nms <- names(lbls)[is.controlv(names(lbls)) == FALSE]
  unts <- rs$units
  wdths <- widths[nms]
  brdrs <- strip_borders(ts$borders)
  pnts <- 0
  # print("ystart header")
  # print(ystart)
  
  # Sum up widths 
  width <- sum(wdths, na.rm = TRUE)
  
  # Get content alignment codes
  if (talgn == "right") {
    tlb <- rs$content_size[["width"]] - width
    trb <- rs$content_size[["width"]]
  } else if (talgn %in% c("center", "centre")) {
    tlb <- (rs$content_size[["width"]] - width) / 2
    trb <- width + tlb
  } else {
    tlb <- 0
    trb <- width
  }

  cnt <-  1
 
  # Loop for column names
  pdf(NULL)
  par(family = get_font_family(rs$font), ps = rs$font_size)
  
  
  tmplst <- list()
  mxlns <- 0
  for(k in seq_along(nms)) {
    
    tmplst[[k]] <- split_string_text(lbls[k], wdths[k], rs$units)
    
    if (tmplst[[k]]$lines > mxlns)
      mxlns <- tmplst[[k]]$lines
    
    pnts <- mxlns * rh
  }
  
  if (any(brdrs %in% c("all", "outside", "top"))) {
    if (!brdr_flag & !has_spans) {
      tbs <- ystart + bs - rh 
      pnts <- pnts + bs + 1
    } else {
      tbs <- ystart - rh + 1
      pnts <- pnts + 3
    }
  } else {
    tbs <- ystart - rh + 1
    pnts <- pnts + bh
  }

  for(k in seq_along(nms)) {
    
    # Split label strings if they exceed column width
    tmp <- tmplst[[k]]
    

    yline <- ystart + (rh * (mxlns - tmp$lines)) 
    if (any(brdrs %in% c("all", "outside", "top")) & !brdr_flag & !has_spans) {
      yline <- yline + bh

    }
    
    #print(yline)
    
    if (k == 1) {
      lb <- tlb
      rb <- lb + wdths[k]
    } else {
      lb <- rb
      rb <- lb + wdths[k]
    }
      
    for (ln in seq_len(tmp$lines)) {
      
      ret[[length(ret) + 1]] <- page_text(tmp$text[ln], rs$font_size, 
                                          bold = ts$header_bold,
                                          xpos = get_points(lb, 
                                                            rb,
                                                            tmp$widths[ln],
                                                            units = unts,
                                                            align = halgns[k]),
                                          ypos = yline)
      yline <- yline + rh
    }
    
    if (any(brdrs %in% c("all", "inside"))) {
      
      
      ret[[length(ret) + 1]] <- page_vline(rb * conv, 
                                           tbs, 
                                           (rh * mxlns) + bs) 
      
    }
    
    # Add in extra lines for labels that wrap
    xtr <- tmp$lines
    if (xtr > cnt)
      cnt <- xtr
    
  }
  
  dev.off()

  if (ts$first_row_blank == TRUE) {
    cnt <- cnt + 1
    pnts <- pnts + rh
  }
  
  # Top border
  if ((any(brdrs == "all")) | (any(brdrs %in% c("outside", "top")) & !has_spans)) {
    
    ret[[length(ret) + 1]] <- page_hline(tlb * conv, 
                                         tbs, 
                                         (trb - tlb) * conv) 
    
  }
  
  # Left border
  if (any(brdrs %in% c("all", "outside", "left"))) {
    
    
    ret[[length(ret) + 1]] <- page_vline(tlb * conv, 
                                         tbs, 
                                         (rh * cnt) + bs) 
    
  }
  
  # Right border
  if (any(brdrs %in% c("all", "outside", "right"))) {
    
    
    ret[[length(ret) + 1]] <- page_vline(trb * conv, 
                                         tbs, 
                                         (rh * cnt) + bs) 
    
  }
  

  yline <- tbs + (rh * mxlns) + bs 
  if (!any(brdrs %in% c("all", "outside", "top")) & brdr_flag) {
    # yline <- yline + bs
    # pnts <- pnts + bs
  }
  
  
  # First row blank
  if (ts$first_row_blank == TRUE) {
    if (any(brdrs %in% c("all", "inside")) ) {
      
      ret[[length(ret) + 1]] <- page_hline(tlb * conv, 
                                           yline + rh, 
                                           (trb - tlb) * conv)
      
    }
  }
  
  # print("yline")
  # print(yline)
  
  # Bottom header border always present
  ret[[length(ret) + 1]] <- page_hline(tlb * conv, 
                                       yline, 
                                       (trb - tlb) * conv)
  
  
  
  res <- list(pdf = ret,
              lines = pnts / rh,
              points = pnts )
  
  return(res)
  
}

#' @description Return a vector of pdf codes for the table spanning headers
#' @details Basic idea of this function is to figure out which columns 
#' the header spans, add widths, then call get_table_header.  Everything
#' from there is the same.  Border adjustments are the closest thing to spaghetti
#' in this package. But it works.
#' @import stats
#' @noRd
get_spanning_header_pdf <- function(rs, ts, pi, ystart = 0, brdr_flag = FALSE) {
  
  spns <- ts$col_spans
  cols <- pi$keys
  cols <- cols[!is.controlv(cols)]
  w <- pi$col_width 
  w <- w[cols]
  gutter <- 0
  gap <- 3
  cnt <- c()
  rh <- rs$row_height
  bs <- rs$border_spacing
  bh <- rs$border_height
  border_flag <-  FALSE
  
  # print("Cols:")
  # print(cols)
  #print(w)
  wlvl <- get_spanning_info(rs, ts, pi, w, gutter)
  lvls <- sort(seq_along(wlvl), decreasing = TRUE)
  
  # At this point we have a data frame with labels, etc. and spanning
  # column widths, and are ready to create spanning header rows
  #print(wlvl)
  
  conv <- rs$point_conversion
  talgn <- pi$table_align
  
  # Table alignment
  # ta <- "\\trql"
  # if (talgn == "right")
  #   ta <- "\\trqr"
  # else if (talgn %in% c("center", "centre"))
  #   ta <- "\\trqc"
  
  # Get borders
  brdrs <- strip_borders(ts$borders)
  
  rh <- rs$row_height
  if (any(brdrs %in% c("all", "inside")))
    rh <-  rh + bh
  
  width <- sum(w)
  
  if (talgn == "right") {
    tlb <- rs$content_size[["width"]] - width
    trb <- rs$content_size[["width"]]
  } else if (talgn %in% c("center", "centre")) {
    tlb <- (rs$content_size[["width"]] - width) / 2
    trb <- width + tlb
  } else {
    tlb <- 0
    trb <- width
  }
  
  ret <- list()
  
  tbrdrs <- any(brdrs %in% c("top", "outside", "all"))
  
  # Nightmare
  lline <- ystart
  if (brdr_flag & !tbrdrs) {
    lline <- ystart + bs
  } else if (brdr_flag & tbrdrs) {
    if (all(brdrs %in% "outside"))
      lline <- ystart + 1
    else 
      lline <- ystart + bs 
  } else if (!brdr_flag & tbrdrs) {
    lline <- ystart + bs + bs
  }
  
  ybegin <- lline
  
  # Open device context
  pdf(NULL)
  par(family = get_font_family(rs$font), ps = rs$font_size)
  
  # Format labels for each level
  ln <- c()
  for (l in lvls) {
    
    s <- wlvl[[l]]
    
    widths <- s$width
    names(widths) <- s$name
    algns <- s$align
    names(algns) <- s$name
    lbls <- s$label
    names(lbls) <- s$name
    cs <- s$col_span
    
    r <- ""
    cnt[length(cnt) + 1] <- 1 
  
    

    
   mxyl <- 0
   mxlns <- 0
   lnadj <- 0
   tmps <- list()
   
   # Get max lines for this spanning level
   for (k in seq_along(lbls)) {
     
     # Split label strings if they exceed column width
     tmps[[k]] <- split_string_text(lbls[k], widths[k], rs$units) 
     
     if (tmps[[k]]$lines > mxlns)
       mxlns <- tmps[[k]]$lines
   }
    
    # Loop for labels
   for(k in seq_along(lbls)) {

     yline <- lline 
     
     # Get left and right bounds for this span
     # Will accumulate as it goes across 
     if (k == 1) {
       lb <- tlb
       rb <- lb + widths[k]
     } else {
       lb <- rb
       rb <- lb + widths[k]
     }
     
     if (lbls[k] != "") {
      
        tmp <- tmps[[k]]
        
        for (ln in seq_len(tmp$lines)) {
          
          # Adjust yline to push down labels
          if (ln == 1)
            yline <- yline + ((mxlns - tmp$lines) * rh)
          
          adj <- 0
          if (any(brdrs %in% c("all", "inside")))
              adj <- 4
          
          # Get pdf text for label
          ret[[length(ret) + 1]] <- page_text(tmp$text[ln], rs$font_size, 
                                              bold = s$bold[k],
                                              xpos = get_points(lb, 
                                                                rb,
                                                                tmp$widths[ln],
                                                                units = rs$units,
                                                                align = algns[k]),
                                              ypos = yline - adj)
          yline <- yline + rh
          if (yline > mxyl)
            mxyl <- yline
        }
        
        if (any(brdrs %in% c("all", "inside"))) { 
          

          ret[[length(ret) + 1]] <- page_vline(lb * conv,
                                               lline - rh,
                                               (mxlns * rh) +  .5)
          
          ret[[length(ret) + 1]] <- page_vline(rb * conv,
                                               lline - rh,
                                               (mxlns * rh) +  .5)
          
          
        } else {
          # Get underline for label if requested
          if (s$span[k] > 0 & s$underline[k]) {
            
            lnadj <- .5
            
            yline <- mxyl + lnadj - (rh * .75) + 1 
    
            ret[[length(ret) + 1]] <- page_hline((lb * conv) + gap,
                                                 yline,
                                                 ((rb - lb) * conv) - (gap * 2))
  
          }
        }
        

        # Add in extra lines for labels that wrap
        xtr <- tmp$lines + lnadj
        if (xtr > cnt[length(cnt)])
          cnt[length(cnt)] <- xtr
      
     }
      
   }
   
   if (any(brdrs %in% c("all", "inside"))) {
     
     ret[[length(ret) + 1]] <- page_hline(tlb * conv, 
                                          lline - rh, 
                                          (trb - tlb) * conv) 
     
   }

    lline <- mxyl + (rh * lnadj)
    
    
  }
  dev.off()
  
  cnts <- sum(cnt)
  
  if (length(lvls) > 0) {

    
    ypos <- ybegin - rh #+ bs 
    
    if (any(brdrs %in% c("top", "outside"))) {
      
      ret[[length(ret) + 1]] <- page_hline(tlb * conv,
                                           ypos,
                                           (trb - tlb) * conv)
      
    }
    
    # if (any(brdrs %in% c("all"))) {
    #   
    #   ret[[length(ret) + 1]] <- page_hline(tlb * conv, 
    #                                        ystart - rh  + (cnts * rh) + (1.5 * bs), 
    #                                        (trb - tlb) * conv) 
    #   
    # }
    
    if (any(brdrs %in% c("all", "outside", "left"))) {
      
      
      ret[[length(ret) + 1]] <- page_vline(tlb * conv, 
                                           ypos, 
                                           (cnts * rh)) 
      
    }
    
    if (any(brdrs %in% c("all", "outside", "right"))) {
      
      
      ret[[length(ret) + 1]] <- page_vline(trb * conv, 
                                           ypos, 
                                           (cnts * rh)) 
      
    }
  }
  
  pnts <- cnts * rh
  if (!brdr_flag & tbrdrs)
    pnts <- pnts + bs
  
  res <- list(pdf = ret, 
              lines = cnts, 
              points = pnts,
              border_flag = border_flag)
  
  return(res)
}

#' @description This function counts lines per row independently because
#' the ..row field does not account for page wrapping.  Need number
#' of lines on this particular page.
#' @noRd
get_table_body_pdf <- function(rs, tbl, widths, algns, talgn, tbrdrs, 
                               ystart = 0, spwidths = list(), 
                               brdr_flag = FALSE, frb = FALSE, styles, ts) {
  
  border_flag <- FALSE
  
  if ("..blank" %in% names(tbl)) {
    flgs <- tbl$..blank
  } else {
    flgs <- NA
  } 
  
  # Count lines per row
  rws <- c()
  cnt <- 0
  
  nms <- names(widths)
  nms <- nms[!is.na(nms)]
  nms <- nms[!is.controlv(nms)]
  wdths <- widths[nms]
  
  #saveRDS(spwidths, "spwidths0a.rds")
  
  if (!"..blank" %in% names(tbl)) {
    blnks <- rep("", nrow(tbl))
  } else {
    blnks <- tbl$..blank
  } 
  
  # Deal with one column situation
  if (length(nms) == 1) {
    t <- as.data.frame(tbl[[nms]])
    names(t) <- nms
  } else {
    t <- tbl[ , nms]
  }
  
  conv <- rs$point_conversion
  unts <- rs$units
  bs <- rs$border_spacing
  bh <- rs$border_height
  cp <- rs$cell_padding
  
  brdrs <- strip_borders(tbrdrs)
  if (all(tbrdrs == "body"))
    brdrs <- c("top", "bottom", "left", "right")

  # Get line height.  Don't want to leave editor default.
  if (any(brdrs %in% c("all", "inside"))) {
    rh <- rs$row_height + bh
  } else {
    rh <- rs$row_height
  } 
  
  # Sum up widths 
  width <- sum(wdths, na.rm = TRUE)
  
  # Get content alignment codes
  if (talgn == "right") {
    tlb <- rs$content_size[["width"]] - width
    trb <- rs$content_size[["width"]]
  } else if (talgn %in% c("center", "centre")) {
    tlb <- (rs$content_size[["width"]] - width) / 2
    trb <- width + tlb
  } else {
    tlb <- 0
    trb <- width
  }
  
  rline <- ystart + 1
  
  ret <- c()
  fs <- rs$font_size
  
  defs <- ts$col_defs
  
  # For break labels, prepare the break label columns for later use
  break_label_col <- c()
  if (any(grepl("..break_label", names(tbl)))) {
    
    for (d in 1:length(defs)) {
      if (!is.null(defs[[d]]$break_label)){
        break_label_col <- c(break_label_col, defs[[d]]$var_c)
      }
    }
  }
  
  pdf(NULL)
  par(family = get_font_family(rs$font), ps = fs)
  
  # Loop for rows
  for(i in seq_len(nrow(t))) {
    
    yline <- rline
    mxrw <- yline
    cnt <- cnt + 1
  
    # Loop for columns 
    for(j in nms) {
      
      # Seems like this should be done already
      # Need to get widths from split_cells
      if (all(class(tbl[i, j]) != "character")) {
        vl <- as.character(tbl[i, j])
      } else {
        vl <- tbl[i, j]
      } 
      
      if (flgs[i] %in% c("B", "A", "L")) {
        
        # Strip out line feeds for label rows
        #vl <- gsub("\n", " ", vl, fixed = TRUE)
        
        #browser()
        # Recalculate based on total width of table
        #stmp <- split_string_text(vl, sum(wdths), rs$units)
        
        #tmp <- stmp$text
        
        tmp <- strsplit(vl, "\n", fixed = TRUE)[[1]]
        
      } else {
      
        tmp <- strsplit(vl, "\n", fixed = TRUE)[[1]]
      }
        
      
      if (j == nms[1]) {
        lb <- tlb
        rb <- lb + wdths[j]
      } else {
        lb <- rb
        rb <- lb + wdths[j]
      }
      
      # If value is empty or blank
      if (length(tmp) == 0) {
        yline <- yline + rh
      } else if (length(trimws(tmp)) == 0) {
        yline <- yline + rh
      } else {
        
        stl <- get_cell_styles(j, styles, flgs, i, tbl)
        
        bflg <- FALSE
        if ("bold" %in% stl) {
          bflg <- TRUE 
        }
      
        # Loop for cell wraps
        for (ln in seq_len(length(tmp))) {
          lb_cell <- lb
          # Indenting with lb
          if (flgs[i] == "L" & any(grepl("..break_label", names(tbl)))) {
            if (!is.na(tbl$..break_occur[i])) {
              cur_break_label_col <- break_label_col[as.numeric(tbl$..break_occur[i])]
              if (!is.null(defs[[cur_break_label_col]]$indent)) {
                lb_cell <- lb_cell + defs[[cur_break_label_col]]$indent
              }
            }
            width_cell <- width
          } else if (!is.null(defs[[j]]$indent)) {
            lb_cell <- lb_cell + defs[[j]]$indent
            width_cell <- spwidths[[i]][[j]][ln]
          } else if (j == "stub" & !is.null(ts$stub)) {
            stub_var <- tbl$..stub_var[i]
            if (!is.null(defs[[stub_var]]$indent)) {
              lb_cell <- lb_cell + defs[[stub_var]]$indent
            }
            width_cell <- spwidths[[i]][[j]][ln]
          } else {
            width_cell <- spwidths[[i]][[j]][ln]
          }
          
          ret[[length(ret) + 1]] <- page_text(tmp[ln], fs, 
                                              bold = bflg,
                                              xpos = get_points(lb_cell, 
                                                                rb,
                                                                width_cell,
                                                                units = unts,
                                                                align = algns[j]),
                                              ypos = yline)
          yline <- yline + rh
        }
      }
      
      if (yline > mxrw)
        mxrw <- yline
      
      yline <- rline
      
    }
    

    # Loop for columns 
    for(j in nms) {
      
      # Applies inside vertical borders
      if (any(brdrs %in% c("all", "inside")) & j != nms[length(nms)] 
          & !blnks[i] %in% c("B", "A", "L")) {
        
        if (j == nms[1]) {
          lb <- tlb
          rb <- lb + wdths[j]
        } else {
          lb <- rb
          rb <- lb + wdths[j]
        }
        
        if (i == 1) { 
          
          if (is.null(frb)) {
            ret[[length(ret) + 1]] <- page_vline(rb * conv, (rline + bs) - rh - 1, 
                                               mxrw - rline + 1)
           } else if (frb == FALSE) {
            ret[[length(ret) + 1]] <- page_vline(rb * conv, (rline + bs) - rh - 1, 
                                               mxrw - rline + 1)
           } else {
             ret[[length(ret) + 1]] <- page_vline(rb * conv, (rline + bs) - rh, 
                                                  mxrw - rline + 1)
           }
          
        } else if (i == nrow(t)) {
          
          ret[[length(ret) + 1]] <- page_vline(rb * conv, (rline + bs) - rh, 
                                               mxrw - rline + 1)
        
        } else {
          
          ret[[length(ret) + 1]] <- page_vline(rb * conv, (rline + bs) - rh, 
                                               mxrw - rline )
          
        }
        
      }
      
    }

    group_border <- ""
    if ("..group_border" %in% names(tbl)) {
      group_border <- tbl[["..group_border"]][i]
    }
    
    # Don't draw group line for first blank row
    if (blnks[i] %in% c("B", "A") & i == 1){
      group_border <- ""
    }
    
    # Don't draw group line for last record when table border is all, bottom, outside
    if (i == nrow(t) & any(brdrs %in% c("all", "outside", "bottom"))) {
      group_border <- ""
    }
    
    # Applies inside horizontal borders
    if ((any(brdrs %in% c("all", "inside")) & i < nrow(t)) |
        group_border == "bottom"
        ) {
    
      ret[[length(ret) + 1]] <- page_hline(tlb * conv, mxrw -rh + bs, 
                                           (trb - tlb) * conv)
    
    }
    
    rline <- mxrw
    
    # Add border height if the line is drawn by group border
    if (!any(brdrs %in% c("all", "inside")) & group_border == "bottom") {
      rline <- rline + bh
    }
  }
  
  dev.off()
  
  if (frb & "body" %in% tbrdrs) {
    
    
    ypos <- ystart - rs$row_height - rs$row_height + bh 
    
    #ylen <- cnt * rh
    ylen <- rline - rh + rs$row_height + bs + 1
    
  } else {

    ypos <- ystart - rs$row_height + bh - 1
    
    #ylen <- cnt * rh
    ylen <- rline - rh + bs + 1
  }
  
  if (any(brdrs %in% c("all", "left", "outside"))) {
    
    ret[[length(ret) + 1]] <- page_vline(tlb * conv, ypos, ylen - ypos)
  }
  if (any(brdrs %in% c("all", "right", "outside"))) {
    
    ret[[length(ret) + 1]] <- page_vline(trb * conv, ypos, ylen - ypos)
  }
  
  # pnts <- cnt * rh
  pnts <- ylen - ystart + rh 
  
  if (any(brdrs %in% c("all", "bottom", "outside"))) {
    
    
    # ret[[length(ret) + 1]] <- page_hline(tlb * conv, ypos + ylen, 
    #                                      (trb - tlb) * conv)
    
    ret[[length(ret) + 1]] <- page_hline(tlb * conv, ylen, 
                                         (trb - tlb) * conv)
    
    border_flag <- TRUE
    if (any(brdrs %in% c("all"))) {
      
      pnts <- pnts - bh 
    }
   # pnts <- pnts + bh
    
  }

  # fcntr <- fcntr + 1
  # saveRDS(ret, paste0("ret", fcntr, ".rds"))

  
  rws <- rline
  
  res <- list(pdf = ret,
              lines = pnts / rs$row_height,
              points = pnts ,
              border_flag = border_flag)
  
  return(res)
  
  
}

fcntr <- 0
