# The page template is everything except the content: page header/footer,
# titles, footnotes, etc.

# Page Template RTF Functions ---------------------------------------------


#' Create a page template with header, titles, footnotes, and footer.
#' @param rs The report spec
#' @return The page template object
#' @noRd
page_template_rtf<- function(rs) {
  
  pt <- structure(list(), class = c("page_template_rtf", "list"))
  
  pt$page_header <- get_page_header_rtf(rs)
  pt$title_hdr <- get_title_header_rtf(rs$title_hdr, rs$line_size, rs)
  pt$titles <- get_titles_rtf(rs$titles, rs$line_size, rs)
  pt$footnotes <- c()
  if (!is.null(rs$footnotes)) {
    if (!is.null(rs$footnotes[[1]])) {
      if (rs$footnotes[[1]]$valign == "bottom")
        pt$footnotes <- get_footnotes_rtf(rs$footnotes, rs$line_size, rs)
    }
    
  }
  pt$page_footer <- get_page_footer_rtf(rs)
  
  pt$lines <- sum(pt$page_header$lines, pt$page_footer$lines,
                  pt$title_hdr$lines, pt$titles$lines, pt$footnotes$lines)
  
  pt$twips <- sum(pt$page_header$twips, pt$page_footer$twips,
                  pt$title_hdr$twips, pt$titles$twips, pt$footnotes$twips)
  
  # Page by not here.  Messes up line counts.
  
  return(pt)
}

#' @import grDevices
#' @noRd
get_page_header_rtf <- function(rs) {
  
  ret <- ""
  cnt <- 0
  twps <- 0
  
  if ((!is.null(rs$header_image_left) & is.null(rs$page_header_left)) |
      (!is.null(rs$header_image_center) & is.null(rs$page_header_center)) |
      (!is.null(rs$header_image_right) & is.null(rs$page_header_right))) {
    
    stop("`page_header` must be used when using `header_image`.")
  }
  
  # Make sure the length is 3, NA will be imputed later.
  width <- c(rs$page_header_width, rep(NA, 3 - length(rs$page_header_width)))
  
  image_left <- FALSE
  image_center <- FALSE
  image_right <- FALSE
  
  if (!is.null(rs$header_image_left)) {
    image_left <- TRUE
    hl <- rs$header_image_left
  } else{
    hl <- rs$page_header_left
  }
  
  if (!is.null(rs$header_image_right)) {
    image_right <- TRUE
    hr <- rs$header_image_right
  } else {
    hr <- rs$page_header_right
  }
  
  if (!is.null(rs$header_image_center)) {
    image_center <- TRUE
    hc <- rs$header_image_center
    
    # Default center cell is not displayed, open it when picture exists
    if (width[2] == 0) {
      width[2] <- NA
    }
  } else {
    hc <- rs$page_header_center
  }
  
  conv <- rs$twip_conversion
  lh <- rs$row_height
  
  # # User controlled width of left column
  # lwdth <- rs$page_header_width
  # if (is.null(lwdth)) {
  #   lwdth <- rs$content_size[["width"]]/2
  # } else if (lwdth > rs$content_size[["width"]]) {
  #   stop(sprintf(
  #     "Total width of page header %s cannot be greater than content width %s.",
  #     lwdth,
  #     rs$content_size[["width"]]
  #   ))
  # }
  # 
  # # Calculate right column width
  # rwdth <- rs$content_size[["width"]] - lwdth
  
  
  # Calculate the widths
  total_width <- sum(width, na.rm = T)
  if (total_width > rs$content_size[["width"]]) {
    
    stop(sprintf("Total width of page header %s %s cannot be greater than content width %s %s.",
                 total_width,
                 rs$units,
                 rs$content_size[["width"]],
                 rs$units))
    
  } else {
    na_num <- sum(is.na(width))
    imputed_width <- (rs$content_size[["width"]] - total_width) / na_num
    
    left_width <- ifelse(is.na(width[1]), imputed_width, width[1])
    center_width <- ifelse(is.na(width[2]), imputed_width, width[2])
    right_width <- ifelse(is.na(width[3]), imputed_width, width[3])
    
    width <- c(left_width, center_width, right_width)
    
    # cellx must be an integer
    c1 <- round(left_width * conv)
    c2 <- round((left_width + center_width) * conv)
    c3 <- round((left_width + center_width + right_width) * conv)
    
    c_lst <- c(c1, c2, c3)
  }
  
  hl_num <- ifelse(image_left, length(hl$image_path), length(hl))
  hc_num <- ifelse(image_center, length(hc$image_path), length(hc))
  hr_num <- ifelse(image_right, length(hr$image_path) , length(hr))
  
  maxh <- max(hl_num, hc_num, hr_num)

  if (maxh > 0 | length(rs$header_titles) > 0) {
    
    fs <- rs$font_size * 2
    
    # c1 <- round(lwdth * conv) 
    # c2 <- round(rwdth * conv) + c1
    
    ret <- paste0("{\\header \\f0\\fs", fs)
    
    if (maxh > 0) {
      pdf(NULL)
      par(family = get_font_family(rs$font), ps = rs$font_size)
      
      max_twips <- 0
      for (i in seq(1, maxh)) {
        # ret <- paste0(ret, "\\trowd\\trgaph0\\trrh", lh, 
        #               "\\cellx", c1, "\\cellx", c2, "\\cellx", c3)
        
        ret <- paste0(ret, "\\trowd\\trgaph0\\trrh", lh)
        for (j in 1:length(width)){
          if (width[j] > 0) {
            ret <- paste0(ret, "\\cellx", c_lst[j])
          }
        }
        
        lcnt <- 0
        ccnt <- 0
        rcnt <- 0
        
        ltwips <- 0
        ctwips <- 0
        rtwips <- 0
        
        if (left_width > 0) {
          if (hl_num >= i) {
            
            # If header image is assigned, the header text will be ignored
            if (image_left == FALSE) {
              
              # Split strings if they exceed width
              tmp <- split_string_rtf(hl[[i]], left_width, rs$units)
              
              ret <- paste0(ret, "\\ql ", get_page_numbers_rtf(tmp$rtf), "\\cell")
              lcnt <- tmp$lines
              
            } else {
              
              # Get image RTF codes
              img <- get_image_rtf(hl$image_path[i], min(hl$width, left_width), hl$height, rs$units)
              
              ret <- paste0(ret, "\\ql ", img, "\\cell")
              
              # Calculate the total lines of image after summarize all twips to
              # prevent from rounding bias
              ltwips <- hl$height * rs$twip_conversion
            }
            
          } else {
            ret <- paste0(ret, "\\ql \\cell")
            lcnt <- 1 
          }
        }
        
        if (center_width > 0) {
          if (hc_num >= i) {
            
            # If header image is assigned, the header text will be ignored
            if (image_center == FALSE) {
              
              # Split strings if they exceed width
              tmp <- split_string_rtf(hc[[i]], center_width, rs$units)
              
              ret <- paste0(ret, "\\qc ", get_page_numbers_rtf(tmp$rtf), "\\cell")
              ccnt <- tmp$lines
              
            } else {
              
              # Get image RTF codes
              img <- get_image_rtf(hc$image_path[i], min(hc$width, center_width), hc$height, rs$units)
              
              ret <- paste0(ret, "\\qc ", img, "\\cell")
              
              ctwips <- hc$height * rs$twip_conversion
            }
            
          } else {
            ret <- paste0(ret, "\\qc \\cell")
            ccnt <- 1 
          }
        }
        
        if (right_width > 0) {
          if (hr_num >= i) {
            
            # If header image is assigned, the header text will be ignored
            if (image_right == FALSE) {
              
              # Split strings if they exceed width
              tmp2 <- split_string_rtf(hr[[i]], right_width, rs$units)
              
              ret <- paste0(ret, "\\qr ", get_page_numbers_rtf(tmp2$rtf), "\\cell")
              rcnt <- tmp2$lines
              
            } else {
              
              # Get image RTF codes
              img <- get_image_rtf(hr$image_path[i], min(hr$width, right_width), hr$height, rs$units)
              
              ret <- paste0(ret, "\\qr ", img, "\\cell")
              
              rtwips <- hr$height * rs$twip_conversion
            }
            
          } else {
            ret <- paste0(ret, "\\qr \\cell")
            rcnt <- 1
          }
        }
        
        ret <- paste0(ret, "\\row\n")
        
        # if (lcnt > rcnt)
        #   cnt <- cnt + lcnt
        # else 
        #   cnt <- cnt + rcnt
        max_twips <- max_twips + max(ltwips, ctwips, rtwips)
        cnt <- cnt + max(lcnt, ccnt, rcnt)
      }
      
      dev.off()

      # Calculate total lines of pictures
      if (max_twips > 0) {
        cnt <- max(cnt, round(max_twips/lh))
      }
    
      if (rs$page_header_blank_row == "below") {
        ret <- paste0(ret, "\\par\\pard", rs$font_rtf, rs$spacing_multiplier)
        cnt <- cnt + 1
      } else {
        
        ret <- paste0(ret, "\\fs1\\sl0\\par\\pard", rs$font_rtf, 
                      rs$spacing_multiplier) 
      }
    }
    
    htitles <- ""
    if (!is.null(rs$header_titles)) {
    
      tret <- get_titles_rtf(rs$header_titles, rs$content_size[["width"]], rs)
      htitles <- paste0(tret$rtf, "\\fs1\\sl0\\par\\pard", rs$font_rtf, 
                                              rs$spacing_multiplier) 
      cnt <- cnt + tret$lines
    
    }
    
    ret <- paste0(ret, htitles, "}")
  }
  
  twps <- cnt * lh
  
  res <- list(rtf = ret, lines = cnt, twips = twps)
  
  return(res)
}

#' @import grDevices
#' @noRd
get_page_footer_rtf <- function(rs) {
  
  ret <- ""
  cnt <- 0
  twps <- 0
  
  if ((!is.null(rs$footer_image_left) & is.null(rs$page_footer_left)) |
      (!is.null(rs$footer_image_right) & is.null(rs$page_footer_right)) |
      (!is.null(rs$footer_image_center) & is.null(rs$page_footer_center))) {
    
    stop("`page_footer` must be used when using `footer_image`.")
  }
  
  image_left <- FALSE
  image_center <- FALSE
  image_right <- FALSE
  
  if (!is.null(rs$footer_image_left)) {
    fl <- rs$footer_image_left
    image_left <- TRUE
  } else {
    fl <- rs$page_footer_left
  }
  
  if (!is.null(rs$footer_image_center)) {
    fc <- rs$footer_image_center
    image_center <- TRUE
  } else {
    fc <- rs$page_footer_center
  }
  
  if (!is.null(rs$footer_image_right)) {
    fr <- rs$footer_image_right
    image_right <- TRUE
  } else {
    fr <- rs$page_footer_right
  }
  
  conv <- rs$twip_conversion
  lh <- rs$row_height
  
  fl_num <- ifelse(image_left, length(fl$image_path), length(fl))
  fc_num <- ifelse(image_center, length(fc$image_path), length(fc))
  fr_num <- ifelse(image_right, length(fr$image_path) , length(fr))
  
  maxf <- max(fl_num, fc_num, fr_num)
  
  if (maxf > 0 | length(rs$footer_footnotes) > 0) {
    
    fs <- rs$font_size * 2
    
    width <- rs$page_footer_width
    
    # Make sure the length is 3, NA will be imputed later.
    width <- c(width, rep(NA, 3 - length(width)))
    
    total_width <- sum(width, na.rm = T)
    if (total_width > rs$content_size[["width"]]) {
      
      stop(sprintf("Total width of page footer %s %s cannot be greater than content width %s %s.",
                   total_width,
                   rs$units,
                   rs$content_size[["width"]],
                   rs$units))
      
    } else {
      na_num <- sum(is.na(width))
      imputed_width <- (rs$content_size[["width"]] - total_width) / na_num
      
      left_width <- ifelse(is.na(width[1]), imputed_width, width[1])
      center_width <- ifelse(is.na(width[2]), imputed_width, width[2])
      right_width <- ifelse(is.na(width[3]), imputed_width, width[3])
      
      width <- c(left_width, center_width, right_width)
      
      # cellx must be an integer
      c1 <- round(left_width * conv)
      c2 <- round((left_width + center_width) * conv)
      c3 <- round((left_width + center_width + right_width) * conv)
      
      c_lst <- c(c1, c2, c3)
    }
    
    
    ret <- paste0("{\\footer \\f0\\fs", fs, "[ff]")
    
    if (maxf > 0) {
      pdf(NULL)
      par(family = get_font_family(rs$font), ps = rs$font_size)
      
      max_twips <- 0
      for (i in seq(1, maxf)) {
        
        # ret <- paste0(ret, "\\trowd\\trgaph0\\cellx", c1, 
        #               "\\cellx", c2 , "\\cellx", c3)
        ret <- paste0(ret, "\\trowd\\trgaph0")
        for (j in 1:length(width)){
          if (width[j] > 0) {
            ret <- paste0(ret, "\\cellx", c_lst[j])
          }
        }
        
        lcnt <- 0
        ccnt <- 0
        rcnt <- 0
        
        ltwips <- 0
        ctwips <- 0
        rtwips <- 0
        
        if (left_width > 0) {
          if (fl_num >= i) {
            
            # If header image is assigned, the header text will be ignored
            if (image_left == FALSE) {
              
              # Split strings if they exceed width
              tmp1 <- split_string_rtf(fl[[i]], left_width, rs$units)
              
              ret <- paste0(ret, "\\ql ", get_page_numbers_rtf(tmp1$rtf), "\\cell")
              lcnt <- tmp1$lines
              
            } else {
              
              # Get image RTF codes
              img <- get_image_rtf(fl$image_path[i], min(fl$width, left_width), fl$height, rs$units)
              
              ret <- paste0(ret, "\\ql ", img, "\\cell")
              
              # Calculate the total lines of image after summarize all twips to
              # prevent from rounding bias
              ltwips <- fl$height * rs$twip_conversion
            }
          } else {
            ret <- paste0(ret, "\\ql \\cell")
            lcnt <- 1
          }
        }
        
        if (center_width > 0) {
          if (fc_num >= i) {
            
            # If header image is assigned, the header text will be ignored
            if (image_center == FALSE) {
              
              # Split strings if they exceed width
              tmp2 <- split_string_rtf(fc[[i]], center_width, rs$units)
              
              ret <- paste0(ret, "\\qc ", get_page_numbers_rtf(tmp2$rtf), "\\cell")
              ccnt <- tmp2$lines
              
            } else {
              
              # Get image RTF codes
              img <- get_image_rtf(fc$image_path[i], min(fc$width, center_width), fc$height, rs$units)
              
              ret <- paste0(ret, "\\qc ", img, "\\cell")
              
              ctwips <- fc$height * rs$twip_conversion
            }
          } else {
            ret <- paste0(ret, "\\qc \\cell")
            ccnt <- 1
          }
        }
        
        if (right_width > 0) {
          if (fr_num >= i) {
            
            # If header image is assigned, the header text will be ignored
            if (image_right == FALSE) {
              
              # Split strings if they exceed width
              tmp3 <- split_string_rtf(fr[[i]], right_width, rs$units)
              
              ret <- paste0(ret, "\\qr ", get_page_numbers_rtf(tmp3$rtf), "\\cell")
              rcnt <- tmp3$lines
              
            } else {
              
              # Get image RTF codes
              img <- get_image_rtf(fr$image_path[i], min(fr$width, right_width), fr$height, rs$units)
              
              ret <- paste0(ret, "\\qr ", img, "\\cell")
              
              rtwips <- fr$height * rs$twip_conversion
            }
          } else {
            ret <- paste0(ret, "\\qr \\cell")
            rcnt <- 1
          }
        }
        
        ret <- paste0(ret, "\\row\n")
        max_twips <- max_twips + max(ltwips, ctwips, rtwips)
        cnt <- cnt + max(lcnt, ccnt, rcnt)
        
      }
      dev.off()
      
      if (max_twips > 0) {
        cnt <- max(cnt, round(max_twips/lh))
      }
    }
    
    
    ffootnotes <- ""
    if (!is.null(rs$footer_footnotes)) {
      
      tret <- get_footnotes_rtf(rs$footer_footnotes, rs$content_size[["width"]], rs)
      ffootnotes <- paste0(tret$rtf, "\\fs1\\sl0\\par\\pard", rs$font_rtf, 
                        rs$spacing_multiplier) 
      cnt <- cnt + tret$lines
      
    }
    
    ret <- sub("[ff]", ffootnotes, ret, fixed = TRUE)
    
    ret <- paste0(ret, "\\fs1\\sl0\\par\\pard", 
                  rs$font_rtf, rs$spacing_multiplier, "}")
  }
  

  res <- list(rtf = paste0(ret, collapse = ""),
              lines = cnt, 
              twips = cnt * lh)
  
  return(res)
}

#' @import grDevices
#' @noRd
get_titles_rtf <- function(ttllst, content_width, rs, talgn = "center") {
  
  ret <- c()
  cnt <- 0
  twps <- 0
  
  conv <- rs$twip_conversion
  lh <- rs$row_height
  border_flag <- FALSE

  
  ta <- "\\trql"
  if (talgn == "right")
    ta <- "\\trqr"
  else if (talgn %in% c("center", "centre"))
    ta <- "\\trqc"

  if (length(ttllst) > 0) {
    
    for (ttls in ttllst) {
      
      cols <- ttls$columns
      
      
      if (ttls$width == "page")
        width <- rs$content_size[["width"]] 
      else if (ttls$width == "content") 
        width <- content_width 
      else if (is.numeric(ttls$width))
        width <- ttls$width 
        
      w <- round(width * conv)
      
      cwidth <- width / cols
      cw <- round(w / cols)
      

      if (ttls$align == "center")
        algn <- "\\qc"
      else if (ttls$align == "right")
        algn <- "\\qr"
      else 
        algn <- "\\ql"
      
      border_flag <- FALSE
      alcnt <- 0
      blcnt <- 0
      
      # Open device context
      pdf(NULL)
      
      # Set point size (ps) for strwidth to calculate string width
      if (!is.null(ttls$font_size)) {
        ttlfs <- ttls$font_size
      } else {
        ttlfs <- rs$font_size
      }
      par(family = get_font_family(rs$font), ps = ttlfs)
      
      
      al <- ""
      # Get blank row above
      if (any(ttls$blank_row %in% c("above", "both"))) {
        
        alcnt <- 1
        
        tb <- get_cell_borders(1, 1, length(ttls$titles) + alcnt, 1, ttls$borders)
        
        al <- paste0("\\trowd\\trgaph0", ta, tb, "\\cellx", w, 
                     algn, "\\cell\\row\n")
        cnt <- cnt + 1 
        
      }
      
      bl <- ""
      # Get blank row below
      if (any(ttls$blank_row %in% c("below", "both"))) {
        blcnt <- 1
        
        tb <- get_cell_borders(length(ttls$titles) + alcnt + blcnt, 1, 
                               length(ttls$titles) + alcnt + blcnt, 
                               1, ttls$borders)
        
        sm <- get_spacing_multiplier(rs$font_size)
        
        bl <- paste0("\\trowd\\trgaph0", ta, tb, "\\cellx", w, 
                     algn, sm, "\\cell\\row\n")
        cnt <- cnt + 1
      }
      
      # Append blank row above
      if (al != "")
        ret <- append(ret, al)
      
      fz <- ""
      fs <- ""
      # Get font size
      if (!is.null(ttls$font_size)) {
        
        fz <- paste0("\\fs", ttls$font_size * 2, 
                     get_spacing_multiplier(ttls$font_size)) 
        fs <- paste0("\\fs", rs$font_size * 2)
      }
      
      # Reset column width accumulation
      cwa <- 0
      
      # Calculate total number of rows in this block
      rws <- ceiling(length(ttls$titles) / cols) + alcnt + blcnt

      i <- 1
      while (i <= length(ttls$titles)) {    
        
        mxlns <- 0
        
        # Calculate current row
        rw <- ceiling(i / cols)

        # Start row
        ret <- append(ret, paste0("\\trowd\\trgaph0", ta))
        
        for (j in seq_len(cols)) {
          
          # Get border specs for this cell
          b <- get_cell_borders(rw + alcnt, j, 
                                rws, 
                                cols, ttls$borders)
          
          # Not all cells have titles
          if (i > length(ttls$titles))
            vl <- ""
          else 
            vl <- ttls$titles[[i]]
          
          # Deal with column alignments
          if (cols == 1) {
            calgn <- algn 
          } else if (cols == 2) {
           if (j == 1)
             calgn <- "\\ql"
           else 
             calgn <- "\\qr"
          } else if (cols == 3) {
           if (j == 1)
             calgn <- "\\ql"
           else if (j == 2)
             calgn <- "\\qc"
           else if (j == 3) 
             calgn <- "\\qr"
          }
          
          if (j == 1) 
            cwa <- 0
        
          # RTF cell widths are absolute ending points
          cwa <- cwa + cw
          
          # Split title strings if they exceed width
          tmp <- split_string_rtf(vl, cwidth, rs$units)
          
          # Track max lines for counting
          if (tmp$lines > mxlns)
            mxlns <- tmp$lines

          # Add bold if needed
          tb <- get_page_numbers_rtf(tmp$rtf, FALSE)
          if (ttls$bold)
            tb <- paste0("\\b ", get_page_numbers_rtf(tmp$rtf, FALSE), "\\b0")
          
          # Construct cell from constituent parts
          ret <- append(ret, paste0(b, "\\cellx", cwa, 
                                    calgn, fz, " ", tb, fs, "\\cell"))
          
          i <- i + 1
          
        }
        
        # End row
        ret <- append(ret, "\\row\n")

        # Track lines
        cnt <- cnt + mxlns
      }
      
      # Append blank row below
      if (bl != "")
        ret <- append(ret, bl)
      
      if (any(ttls$borders %in% c("outside", "all", "bottom")))
        border_flag <- TRUE
      
      dev.off()
    
    }
    
  }
  
  res <- list(rtf = paste0(ret, collapse = ""), 
              lines = cnt, 
              twips = cnt * lh,
              border_flag = border_flag)
  
  return(res)
}



#' @import grDevices
#' @noRd
get_titles_rtf_back <- function(ttllst, content_width, rs, talgn = "center") {
  
  ret <- c()
  cnt <- 0
  twps <- 0
  
  conv <- rs$twip_conversion
  lh <- rs$row_height
  border_flag <- FALSE
  
  
  ta <- "\\trql"
  if (talgn == "right")
    ta <- "\\trqr"
  else if (talgn %in% c("center", "centre"))
    ta <- "\\trqc"
  
  if (length(ttllst) > 0) {
    
    for (ttls in ttllst) {
      
      
      if (ttls$width == "page")
        width <- rs$content_size[["width"]]
      else if (ttls$width == "content")
        width <- content_width
      else if (is.numeric(ttls$width))
        width <- ttls$width
      
      w <- round(width * conv)
      
      
      if (ttls$align == "center")
        algn <- "\\qc"
      else if (ttls$align == "right")
        algn <- "\\qr"
      else 
        algn <- "\\ql"
      
      border_flag <- FALSE
      alcnt <- 0
      blcnt <- 0
      
      # Open device context
      pdf(NULL)
      par(family = get_font_family(rs$font), ps = rs$font_size)
      
      for (i in seq_along(ttls$titles)) {
        
        
        
        al <- ""
        
        if (i == 1) {
          if (any(ttls$blank_row %in% c("above", "both"))) {
            
            alcnt <- 1
            
            tb <- get_cell_borders(i, 1, length(ttls$titles) + alcnt, 1, ttls$borders)
            
            al <- paste0("\\trowd\\trgaph0", ta, tb, "\\cellx", w, 
                         algn, "\\cell\\row\n")
            cnt <- cnt + 1 
            
          }
        }
        
        bl <- ""
        if (i == length(ttls$titles)) {
          if (any(ttls$blank_row %in% c("below", "both"))) {
            blcnt <- 1
            
            tb <- get_cell_borders(i + alcnt + blcnt, 1, 
                                   length(ttls$titles) + alcnt + blcnt, 
                                   1, ttls$borders)
            
            sm <- get_spacing_multiplier(rs$font_size)
            
            bl <- paste0("\\trowd\\trgaph0", ta, tb, "\\cellx", w, 
                         algn, sm, "\\cell\\row\n")
            cnt <- cnt + 1
          }
          
          if (any(ttls$borders %in% c("outside", "all", "bottom")))
            border_flag <- TRUE
        }
        
        b <- get_cell_borders(i + alcnt, 1, 
                              length(ttls$titles) + alcnt + blcnt, 
                              1, ttls$borders)
        
        # Split title strings if they exceed width
        tmp <- split_string_rtf(ttls$titles[[i]], width, rs$units)
        
        fz <- ""
        fs <- ""
        if (!is.null(ttls$font_size)) {
          
          fz <- paste0("\\fs", ttls$font_size * 2, 
                       get_spacing_multiplier(ttls$font_size)) 
          fs <- paste0("\\fs", rs$font_size * 2)
        }
        
        
        tb <- tmp$rtf
        if (ttls$bold)
          tb <- paste0("\\b ", tmp$rtf, "\\b0")
        
        # Concatenate title string
        if (al != "")
          ret <- append(ret, al)
        ret <- append(ret, paste0("\\trowd\\trgaph0", ta, b, "\\cellx", w, 
                                  algn, fz, " ", tb, fs, "\\cell\\row\n"))
        if (bl != "")
          ret <- append(ret, bl)
        
        cnt <- cnt + tmp$lines
      }
      dev.off()
      
    }
    
  }
  
  res <- list(rtf = paste0(ret, collapse = ""), 
              lines = cnt, 
              twips = cnt * lh,
              border_flag = border_flag)
  
  return(res)
}

#' @import grDevices
#' @noRd
get_footnotes_rtf <- function(ftnlst, content_width, rs, talgn = "center") {
  
  ret <- c()
  cnt <- 0
  twps <- 0
  border_flag <- FALSE
  
  conv <- rs$twip_conversion
  lh <- rs$row_height
  
  ta <- "\\trql"
  if (talgn == "right")
    ta <- "\\trqr"
  else if (talgn %in% c("center", "centre"))
    ta <- "\\trqc"
  
  if (length(ftnlst) > 0) {
    
    for (ftnts in ftnlst) {
      
      cols <- ftnts$columns
      
      if (ftnts$width == "page")
        width <- rs$content_size[["width"]]
      else if (ftnts$width == "content")
        width <- content_width
      else if (is.numeric(ftnts$width))
        width <- ftnts$width
      
      w <- round(width * conv)
      
      cwidth <- width / cols
      cw <- round(w / cols)
      
      if (ftnts$align == "center")
        algn <- "\\qc"
      else if (ftnts$align == "right")
        algn <- "\\qr"
      else 
        algn <- "\\ql"
      
      alcnt <- 0
      blcnt <- 0
      border_flag <- FALSE
      
      pdf(NULL)
      
      # Set point size (ps) for strwidth to calculate string width
      if (!is.null(ftnts$font_size)) {
        ftntfs <- ftnts$font_size
      } else {
        ftntfs <- rs$font_size
      }
      par(family = get_font_family(rs$font), ps = ftntfs)
      
      al <- ""
      # Get blank row above
      if (any(ftnts$blank_row %in% c("above", "both"))) {
        
        alcnt <- 1
        
        tb <- get_cell_borders(1, 1, length(ftnts$footnotes) + alcnt, 
                               1, ftnts$borders)
        
        al <- paste0("\\trowd\\trgaph0", ta, tb, "\\cellx", w, 
                     algn, "\\cell\\row\n")
        cnt <- cnt + 1 
        
      }
      
      
      bl <- ""
      # Get blank row below
      if (any(ftnts$blank_row %in% c("below", "both"))) {
        blcnt <- 1
        
        tb <- get_cell_borders(length(ftnts$footnotes) + alcnt + blcnt, 1, 
                               length(ftnts$footnotes) + alcnt + blcnt, 
                               1, ftnts$borders)
        
        bl <- paste0("\\trowd\\trgaph0", ta, tb, "\\cellx", w, 
                     algn, "\\cell\\row\n")
        cnt <- cnt + 1
      }
      if (any(ftnts$borders %in% c("outside", "all", "top")))
        border_flag <- TRUE
      
      # Append blank row above
      if (al != "")
        ret <- append(ret, al)
      
      fz <- ""
      fs <- ""
      # Get font size - Not used yet
      if (!is.null(ftnts$font_size)) {
        
        fz <- paste0("\\fs", ftnts$font_size * 2, 
                     get_spacing_multiplier(ftnts$font_size)) 
        fs <- paste0("\\fs", rs$font_size * 2)
      }
      
      # Reset column width accumulation
      cwa <- 0
      
      # Calculate total number of rows in this block
      rws <- ceiling(length(ftnts$footnotes) / cols) + alcnt + blcnt
      
      i <- 1
      while (i <= length(ftnts$footnotes)) {    
        
        mxlns <- 0
        
        # Calculate current row
        rw <- ceiling(i / cols)
        
        # Start row
        ret <- append(ret, paste0("\\trowd\\trgaph0", ta))
        
        for (j in seq_len(cols)) {
          
          # Get border specs for this cell
          # b <- get_cell_borders(i + alcnt, 1, 
          #                       length(ftnts$footnotes) + alcnt + blcnt, 
          #                       1, ftnts$borders)
          b <- get_cell_borders(rw + alcnt, j, 
                                rws, 
                                cols, ftnts$borders)
          
          # Not all cells have titles
          if (i > length(ftnts$footnotes)) {
            vl <- ""
          } else { 
            vl <- ftnts$footnotes[[i]]
          }
          
          # Deal with column alignments
          if (cols == 1) {
            calgn <- algn 
          } else if (cols == 2) {
            if (j == 1)
              calgn <- "\\ql"
            else 
              calgn <- "\\qr"
          } else if (cols == 3) {
            if (j == 1)
              calgn <- "\\ql"
            else if (j == 2)
              calgn <- "\\qc"
            else if (j == 3) 
              calgn <- "\\qr"
          }
          
          if (j == 1) 
            cwa <- 0
          
          # RTF cell widths are absolute ending points
          cwa <- cwa + cw
          
          
          # Split footnote strings if they exceed width
          tmp <- split_string_rtf(vl, cwidth, rs$units)
        
          # Track max lines for counting
          if (tmp$lines > mxlns)
            mxlns <- tmp$lines
          
          # Add italics if requested
          if (ftnts$italic)
            txt <- paste0("\\i ", get_page_numbers_rtf(tmp$rtf, FALSE), "\\i0") 
          else 
            txt <- paste0(" ", get_page_numbers_rtf(tmp$rtf, FALSE))
          
          # Concat footnote row
          # ret <- append(ret, paste0("\\trowd\\trgaph0", ta, b, "\\cellx", w, 
          #                           algn, txt, 
          #                           "\\cell\\row\n"))
          
          # Construct cell from constituent parts
          ret <- append(ret, paste0(b, "\\cellx", cwa, 
                                    calgn, fz, txt, fs, "\\cell"))
          
          i <- i + 1
          
        }
        
        # End row
        ret <- append(ret, "\\row\n")
        
        # Track lines
        cnt <- cnt + mxlns
        
      }
      
      if (bl != "")
        ret <- append(ret, bl)
      
      # Do I need this?
      # if (any(ftnts$borders %in% c("outside", "all", "bottom")))
      #   border_flag <- TRUE
      
      dev.off()
      
      
    }
    
  }
  
  
  res <- list(rtf = paste0(ret, collapse = ""),
              lines = cnt, 
              twips = cnt * lh,
              border_flag = border_flag)
  
  return(res)
}

#' @import grDevices
#' @noRd
get_footnotes_rtf_back <- function(ftnlst, content_width, rs, talgn = "center") {
  
  ret <- c()
  cnt <- 0
  twps <- 0
  border_flag <- FALSE
  
  conv <- rs$twip_conversion
  lh <- rs$row_height
  
  ta <- "\\trql"
  if (talgn == "right")
    ta <- "\\trqr"
  else if (talgn %in% c("center", "centre"))
    ta <- "\\trqc"
  
  if (length(ftnlst) > 0) {
    
    for (ftnts in ftnlst) {
      
      if (ftnts$width == "page")
        width <- rs$content_size[["width"]]
      else if (ftnts$width == "content")
        width <- content_width
      else if (is.numeric(ftnts$width))
        width <- ftnts$width
      
      w <- round(width * conv)
      
      
      if (ftnts$align == "center")
        algn <- "\\qc"
      else if (ftnts$align == "right")
        algn <- "\\qr"
      else 
        algn <- "\\ql"
      
      alcnt <- 0
      blcnt <- 0
      border_flag <- FALSE
      
      pdf(NULL)
      par(family = get_font_family(rs$font), ps = rs$font_size)
      
      for (i in seq_along(ftnts$footnotes)) {
        
        
        al <- ""
        if (i == 1) {
          if (any(ftnts$blank_row %in% c("above", "both"))) {
            
            alcnt <- 1
            
            tb <- get_cell_borders(i, 1, length(ftnts$footnotes) + alcnt, 
                                   1, ftnts$borders)
            
            al <- paste0("\\trowd\\trgaph0", ta, tb, "\\cellx", w, 
                         algn, "\\cell\\row\n")
            cnt <- cnt + 1 
            
          }
        }
        
        bl <- ""
        if (i == length(ftnts$footnotes)) {
          if (any(ftnts$blank_row %in% c("below", "both"))) {
            blcnt <- 1
            
            tb <- get_cell_borders(i + alcnt + blcnt, 1, 
                                   length(ftnts$footnotes) + alcnt + blcnt, 
                                   1, ftnts$borders)
            
            bl <- paste0("\\trowd\\trgaph0", ta, tb, "\\cellx", w, 
                         algn, "\\cell\\row\n")
            cnt <- cnt + 1
          }
          if (any(ftnts$borders %in% c("outside", "all", "top")))
            border_flag <- TRUE
        }
        
        b <- get_cell_borders(i + alcnt, 1, 
                              length(ftnts$footnotes) + alcnt + blcnt, 
                              1, ftnts$borders)
        
        
        
        # Split footnote strings if they exceed width
        tmp <- split_string_rtf(ftnts$footnotes[[i]], width, rs$units)
        
        if (al != "")
          ret <- append(ret, al)
        
        if (ftnts$italic)
          txt <- paste0("\\i ", get_page_numbers_rtf(tmp$rtf, FALSE), "\\i0") 
        else 
          txt <- paste0(" ", get_page_numbers_rtf(tmp$rtf, FALSE))
        
        # Concat footnote row
        ret <- append(ret, paste0("\\trowd\\trgaph0", ta, b, "\\cellx", w, 
                                  algn, txt, 
                                  "\\cell\\row\n"))
        if (bl != "")
          ret <- append(ret, bl)
        
        cnt <- cnt + tmp$lines
      }
      dev.off()
      

    }
    
  }
  
  
  res <- list(rtf = paste0(ret, collapse = ""),
              lines = cnt, 
              twips = cnt * lh,
              border_flag = border_flag)
  
  return(res)
}

#' @import grDevices
#' @noRd
get_title_header_rtf <- function(thdrlst, content_width, rs, talgn = "center") {
  
  ret <- c()
  cnt <- 0
  twps <- 0
  border_flag <- FALSE 
  
  conv <- rs$twip_conversion

  lh <- rs$row_height
  
  ta <- "\\trql"
  if (talgn == "right")
    ta <- "\\trqr"
  else if (talgn %in% c("center", "centre"))
    ta <- "\\trqc"
  
  if (length(thdrlst) > 0) {
    
    for (ttlhdr in thdrlst) {
      
      if (ttlhdr$width == "page")
        width <- rs$content_size[["width"]]
      else if (ttlhdr$width == "content")
        width <- content_width
      else if (is.numeric(ttlhdr$width))
        width <- ttlhdr$width
      
      w1 <- round(width * conv)
      w2 <- round(width * .7 * conv)
      
      mx <- max(length(ttlhdr$titles), length(ttlhdr$right))
    
      alcnt <- 0
      blcnt <- 0
      border_flag <- FALSE
      
      pdf(NULL)
      par(family = get_font_family(rs$font), ps = rs$font_size)
      
      for(i in seq_len(mx)) {
        
        
        
        al <- ""
        if (i == 1) {
          if (any(ttlhdr$blank_row %in% c("above", "both"))) {
            
            alcnt <- 1
            
            tb <- get_cell_borders(i, 1, mx + alcnt, 
                                   1, ttlhdr$borders)
            
            al <- paste0("\\trowd\\trgaph0", ta, tb, "\\cellx", w1, 
                         "\\ql\\cell\\row\n")
            cnt <- cnt + 1 
            
          }
        }
        
        bl <- ""
        if (i == mx) {
          if (any(ttlhdr$blank_row %in% c("below", "both"))) {
            blcnt <- 1
            
            tb <- get_cell_borders(i + alcnt + blcnt, 1, 
                                   mx + alcnt + blcnt, 
                                   1, ttlhdr$borders)
            
            bl <- paste0("\\trowd\\trgaph0", ta, tb, "\\cellx", w1, 
                         "\\ql\\cell\\row\n")
            cnt <- cnt + 1
          }
          
          if (any(ttlhdr$borders %in% c("all", "outside", "bottom")))
            border_flag <- TRUE
        }
        
        
      
        if (length(ttlhdr$titles) >= i) {
          # Split strings if they exceed width
          tmp1 <- split_string_rtf(ttlhdr$titles[[i]], width * .7, rs$units)
          ttl <- tmp1$rtf
          tcnt <- tmp1$lines
        } else {
          ttl <- ""
          tcnt <- 1 
        }
        
        if (length(ttlhdr$right) >= i) {
          tmp2 <- split_string_rtf(ttlhdr$right[[i]],
                                   width * .3, rs$units)
          hdr <- get_page_numbers_rtf(tmp2$rtf, FALSE)
          hcnt <- tmp2$lines
        } else {
          hdr <- ""
          hcnt <- 1
        }
        
        b1 <- get_cell_borders(i + alcnt, 1, mx + alcnt + blcnt, 2, ttlhdr$borders)
        b2 <- get_cell_borders(i + alcnt, 2, mx+ alcnt + blcnt, 2, ttlhdr$borders)
        
        
        if (al != "")
          ret <- append(ret, al)
        
        ret <- append(ret, paste0("\\trowd\\trgaph0", ta, b1, "\\cellx", w2, 
                                  b2, "\\cellx", w1,
                                  "\\ql ", ttl, "\\cell\\qr ", 
                                  hdr, "\\cell\\row\n"))
        if (bl != "")
          ret <- append(ret, bl)
        
        if (tcnt > hcnt)
          cnt <- cnt + tcnt
        else 
          cnt <- cnt + hcnt
      }
      
      dev.off()
      
    }

  }
  
  res <- list(rtf = paste0(ret, collapse = ""),
              lines = cnt,
              twips = cnt * lh,
              border_flag = border_flag)
  
  return(res)
}


#' Get page by text strings suitable for printing
#' @import stringi
#' @param titles Page by object
#' @param width The width to set the page by strings to
#' @return A vector of strings
#' @noRd
get_page_by_rtf <- function(pgby, width, value, rs, talgn, pgby_cnt = NULL) {
  
  if (is.null(width)) {
    stop("width cannot be null.") 
    
  }
  
  if (is.null(value))
    value <- get_pgby_value(value, pgby_cnt)
  
  ll <- width
  ret <- c()
  cnt <- 0
  border_flag <- FALSE
  
  ta <- "\\trql"
  if (talgn == "right")
    ta <- "\\trqr"
  else if (talgn %in% c("center", "centre"))
    ta <- "\\trqc"
  
  if (!is.null(pgby)) { 
    
    if (!any(class(pgby) == "page_by"))
      stop("pgby parameter value is not a page_by.")
    
    
    w1 <- round(width * rs$twip_conversion)
    
    algn <- "\\ql"
    if (pgby$align == "right")
      algn <- "\\qr"
    else if (pgby$align %in% c("center", "centre"))
      algn <- "\\qc"
    
    trows <- 1
    brow <- 1
    if (pgby$blank_row %in% c("above", "both")) {
      trows <- trows + 1
      brow <- 2
    }
    if (pgby$blank_row %in% c("below", "both"))
      trows <- trows + 1
    
    if (pgby$blank_row %in% c("above", "both")) {
      
      tb <- get_cell_borders(1, 1, trows, 1, pgby$borders)

      ret[length(ret) + 1] <- paste0("\\trowd\\trgaph0", ta, tb, 
                                     "\\cellx", w1, algn, 
                                  "\\cell\\row\n")
      cnt <- cnt + 1 
    }
    
    tb <- get_cell_borders(brow, 1 , trows, 1, pgby$borders)
    
    pdf(NULL)
    par(family = get_font_family(rs$font), ps = rs$font_size)
    
    # Account for multiple pgby lines
    # tmp <- split_string_rtf(value, width, rs$units)
    # vl <- tmp$rtf
    # cnt <- cnt + tmp$lines
    
    # Add bold
    if (pgby$bold %in% c(TRUE, FALSE)) {
      
      if (substr(pgby$label, nchar(pgby$label), nchar(pgby$label)) != " "){
        sep <- " "
      } else {
        sep <- ""
      }
      
      tmp <- split_string_rtf(paste0(pgby$label, sep, value), width, rs$units)
      vl <- tmp$rtf
      cnt <- cnt + tmp$lines
      
      if (pgby$bold ) {
        page_by_text <- paste0("\\b ", vl, "\\b0")
      } else {
        page_by_text <- vl
      }
      
    } else if (pgby$bold %in% c("value", "label")) {
      
      # Split label
      label_split <- split_string_rtf(pgby$label, width, rs$units)
      cnt <- cnt + label_split$lines
      
      # Use remain width to split value
      remain_width <- width - label_split$widths[length(label_split$widths)]
      value_split <- split_string_rtf(value, remain_width, rs$units)
      
      if (value_split$widths[1] > remain_width) {
        
        # If first width is bigger than remaining width, it means value starts a new line
        value_split <- split_string_rtf(value, width, rs$units)
        cnt <- cnt + value_split$lines
        value_split_txt <- value_split$rtf
        
      } else {
        
        # Otherwise, split with full width if there is a second line
        splt <- strsplit(value_split$rtf, split = "\\line", fixed = TRUE)
        
        if (length(splt[[1]]) > 1) {
          remain_value <- trimws(sub(splt[[1]][1], "", value), which = "left")
          remain_value_split <- split_string_rtf(remain_value, width, rs$units)
          cnt <- cnt + remain_value_split$lines
          value_split_txt <- paste0(splt[[1]][1], "\\line", remain_value_split$rtf)
        } else {
          value_split_txt <- value_split$rtf
        }
        
      }
      
      if (pgby$bold == "label") {
        page_by_text <- paste0("\\b ", label_split$rtf, " \\b0", value_split_txt)
      } else {
        page_by_text <- paste0(label_split$rtf, " \\b ", value_split_txt, "\\b0")
      }
    }
    
    dev.off()
    
    # Construct RTF for pageby value
    ret[length(ret) + 1] <- paste0("\\trowd\\trgaph0", ta, tb, 
                                   "\\cellx", w1, algn, " ",
                                   page_by_text, "\\cell\\row\n")
    

    # cnt <- cnt + get_lines_rtf(paste0( pgby$label, ": ", value), width,
    #                            rs$font, rs$font_size, rs$units)
    
  
    if (pgby$blank_row %in% c("below", "both")) {
      
      tb <- get_cell_borders(trows, 1, trows, 1, pgby$borders)
      
      ret[length(ret) + 1] <- paste0("\\trowd\\trgaph0", ta, tb, 
                                     "\\cellx", w1, algn, 
                                  "\\cell\\row\n")
      cnt <- cnt + 1 
    }
    
    if (any(pgby$borders %in% c("all", "outside", "bottom")))
      border_flag <- TRUE
    
  }
  
  res <- list(rtf = paste0(ret, collapse = ""), 
              lines = cnt, 
              twips = cnt * rs$line_height,
              border_flag = border_flag)
  
  return(res)
}



#' Get page by text strings suitable for printing
#' @import stringi
#' @param titles Page by object
#' @param width The width to set the page by strings to
#' @return A vector of strings
#' @noRd
get_page_by_rtf_back <- function(pgby, width, value, rs, talgn) {
  
  if (is.null(width)) {
    stop("width cannot be null.") 
    
  }
  
  if (is.null(value))
    value <- ""
  
  ll <- width
  ret <- c()
  cnt <- 0
  border_flag <- FALSE
  
  ta <- "\\trql"
  if (talgn == "right")
    ta <- "\\trqr"
  else if (talgn %in% c("center", "centre"))
    ta <- "\\trqc"
  
  if (!is.null(pgby)) { 
    
    if (!any(class(pgby) == "page_by"))
      stop("pgby parameter value is not a page_by.")
    
    
    w1 <- round(width * rs$twip_conversion)
    
    algn <- "\\ql"
    if (pgby$align == "right")
      algn <- "\\qr"
    else if (pgby$align %in% c("center", "centre"))
      algn <- "\\qc"
    
    trows <- 1
    brow <- 1
    if (pgby$blank_row %in% c("above", "both")) {
      trows <- trows + 1
      brow <- 2
    }
    if (pgby$blank_row %in% c("below", "both"))
      trows <- trows + 1
    
    if (pgby$blank_row %in% c("above", "both")) {
      
      tb <- get_cell_borders(1, 1, trows, 1, pgby$borders)
      
      ret[length(ret) + 1] <- paste0("\\trowd\\trgaph0", ta, tb, 
                                     "\\cellx", w1, algn, 
                                     "\\cell\\row\n")
      cnt <- cnt + 1 
    }
    
    tb <- get_cell_borders(brow, 1 , trows, 1, pgby$borders)
    
    #tmp <- split_string_rtf(vl, cwidth, rs$units)
    
    ret[length(ret) + 1] <- paste0("\\trowd\\trgaph0", ta, tb, 
                                   "\\cellx", w1, algn, " ",
                                   pgby$label, value, "\\cell\\row\n")
    
    
    cnt <- cnt + get_lines_rtf(paste0( pgby$label, ": ", value), width,
                               rs$font, rs$font_size, rs$units)
    
    
    if (pgby$blank_row %in% c("below", "both")) {
      
      tb <- get_cell_borders(trows, 1, trows, 1, pgby$borders)
      
      ret[length(ret) + 1] <- paste0("\\trowd\\trgaph0", ta, tb, 
                                     "\\cellx", w1, algn, 
                                     "\\cell\\row\n")
      cnt <- cnt + 1 
    }
    
    if (any(pgby$borders %in% c("all", "outside", "bottom")))
      border_flag <- TRUE
    
  }
  
  res <- list(rtf = paste0(ret, collapse = ""), 
              lines = cnt, 
              twips = cnt * rs$line_height,
              border_flag = border_flag)
  
  return(res)
}


# Utilities ---------------------------------------------------------------


get_cell_borders <- function(row, col, nrow, ncol, brdrs, flag = "", 
                             exclude = NULL, cell_border = NULL) {
  
  t <- ""
  b <- ""
  l <- ""
  r <- ""
  
  
  if ("all" %in% brdrs) {
    t <- "\\clbrdrt\\brdrs"
    b <- "\\clbrdrb\\brdrs"
    l <- "\\clbrdrl\\brdrs"
    r <- "\\clbrdrr\\brdrs"
  } else {
    
    if ("inside" %in% brdrs) {
      
      t <- "\\clbrdrt\\brdrs"
      b <- "\\clbrdrb\\brdrs"
      l <- "\\clbrdrl\\brdrs"
      r <- "\\clbrdrr\\brdrs"
      
      if (col == 1) 
        l <- ""
      
      if (col == ncol)
        r <- ""
      
      if (row == nrow)
        b <- ""
      
      if (row == 1)
        t <- ""
      
    }
    
    # Cell border is border indicator from group_line or cell_style
    if ((row == 1 & any(brdrs %in% c("outside", "top"))) |
        any(cell_border %in% c("outside", "top"))
        ) {
      t <- "\\clbrdrt\\brdrs"
    }
    
    if ((row == nrow & any(brdrs %in% c("bottom", "outside"))) |
        any(cell_border %in% c("bottom", "outside"))
        ) {
      b <- "\\clbrdrb\\brdrs"
    }
    
    if ((col == 1 & any(brdrs %in% c("outside", "left"))) |
        any(cell_border %in% c("outside", "left"))
        ) {
      l <- "\\clbrdrl\\brdrs"
    }
    
    if ((col == ncol & any(brdrs %in% c("outside", "right"))) |
        any(cell_border %in% c("outside", "right"))
        ) {
      r <- "\\clbrdrr\\brdrs"
    }

  }
  
  # Deal with flag
  if (!is.na(flag)) {
    if (flag %in% c("L", "B", "A")) {
      
      if (col == 1 & any(brdrs %in% c("outside", "right", "all")))
        r <- "\\clbrdrr\\brdrs"
      
      if (col != 1)
        l <- ""
    }
  }
  
  if (!is.null(exclude)) {
    if (any(exclude == "top"))
      t <- ""
    if (any(exclude == "bottom"))
      b <- ""
    if (any(exclude == "left"))
      l <- ""
    if (any(exclude == "right"))
      r <- ""
  }
  
  ret <- paste0(t, b, l, r)
  
  return(ret)
  
}

get_page_numbers_rtf <- function(val, tpg = TRUE) {
  
  ret <- val
  
  ret <- gsub("[pg]", "\\chpgn ", ret, fixed = TRUE)
  
  if (tpg)
    ret <- gsub("[tpg]", "{\\field{\\*\\fldinst  NUMPAGES }}", ret, fixed = TRUE)

  return(ret)
}
