Nothing
R/write_report_rtf2.R
In reporter: Creates Statistical Reports
Defines functions
get_spacing_multiplier
page_setup_rtf
update_page_numbers_rtf
write_content_rtf
paginate_content_rtf
get_rtf_document
write_report_rtf2
# Write Report RTF2 -------------------------------------------------------
#' @title
#' Write a RTF2 report to the file system
#'
#' @description
#' This function writes a report_spec object to the file system, using the
#' parameters provided in the object.
#'
#' @param x The report_spec object to write.
#' @return The report spec.
#' @noRd
write_report_rtf2 <- function(rs) {
orig_path <- rs$modified_path
if (file.exists(orig_path))
file.remove(orig_path)
# Establish content and body sizes
rs <- page_setup_rtf(rs)
# Document header is mostly independent of content
hdr <- get_rtf_document(rs)
# Put content in a new variable
ls <- rs$content
# Get content and break it into pages
# Needs to return a list of pages so preview can work
# Page numbers need to be included
bdy <- paginate_content_rtf(rs, ls)
# Get column widths
rs$column_widths <- bdy[["widths"]]
# Deal with preview
if (!is.null(rs$preview)) {
if (rs$preview < length(bdy[[1]]$pages))
bdy[[1]]$pages <- bdy[[1]]$pages[seq(1, rs$preview)]
}
# Write content to file system
# Later we can just return the stream
rs <- write_content_rtf(rs, hdr, bdy, rs$page_template)
# Update page numbers for title headers
update_page_numbers_rtf(orig_path, rs$pages)
return(rs)
}
#' @description Returns header for RTF document. This is independent of content,
#' except for the page header and footer.
#' @noRd
get_rtf_document <- function(rs) {
# Set up vectors
ret <- c()
conv <- rs$twip_conversion
fnt <- rs$font
if (tolower(rs$font) == "times")
fnt <- "Times New Roman"
# Prepare header
ret[length(ret) + 1] <- paste0("{\\rtf1\\ansi\\deff0 {\\fonttbl {\\f0 ", fnt , ";}}")
if (rs$orientation == "landscape") {
#ret[length(ret) + 1] <- "\\landscape\\horzdoc"
ret[length(ret) + 1] <- "\\landscape"
ret[length(ret) + 1] <- paste0("\\paperw", round(rs$page_size[2] * conv),
"\\paperh", round(rs$page_size[1] * conv))
} else {
#ret[length(ret) + 1] <- "\\vertdoc"
ret[length(ret) + 1] <- paste0("\\paperw", round(rs$page_size[1] * conv),
"\\paperh", round(rs$page_size[2] * conv))
}
ret[length(ret) + 1] <- paste0("\\margl", round(rs$margin_left * conv),
"\\margr", round(rs$margin_right * conv),
"\\margt", round(rs$margin_top * conv),
"\\margb", round(rs$margin_bottom * conv),
"\\headery", round(rs$margin_top * conv),
"\\footery", round(rs$margin_bottom * conv))
ph <- get_page_header_rtf(rs)
if (ph$rtf != "")
ret[length(ret) + 1] <- ph$rtf
pf <- get_page_footer_rtf(rs)
if (pf$rtf != "")
ret[length(ret) + 1] <- pf$rtf
# Line spacing values determined by trial and error.
# Needed for LibreOffice. Appear to be ignored in Word.
ret[length(ret) + 1] <- paste0(rs$spacing_multiplier, rs$font_rtf)
return(ret)
}
#' @noRd
paginate_content_rtf <- function(rs, ls) {
ret <- c()
last_object <- FALSE
last_page_lines <- 0
table_widths <- list()
hrf <- has_bottom_footnotes(rs)
# Loop through content objects
for (i in seq_along(ls)) {
pgs <- list() # list of vectors with page rtf lines
lns <- c()
# Set last object flag
if (i == length(ls))
last_object <- TRUE
else
last_object <- FALSE
# Put content and object in variables for convenience
cntnt <- ls[[i]]
obj <- cntnt$object
# Remove blank row if last content object
cbr <- cntnt$blank_row
if (last_object) {
if (all(cbr == "below"))
cbr <- "none"
else if (all(cbr == "all"))
cbr <- "above"
}
# Break each content type into a list of pages
if (any(class(obj) == "table_spec")) {
res <- create_table_pages_rtf(rs, cntnt, last_page_lines)
# Collect multiple pages and line counts
for (j in seq_len(length(res$page_list))) {
pgs[[length(pgs) + 1]] <- res$page_list[[j]]$rtf
lns[[length(lns) + 1]] <- res$page_list[[j]]$lines
}
# Retrieve table widths. These are useful for debugging.
# Assigned to returning report object.
table_widths[[length(table_widths) + 1]] <- res$widths
} else if (any(class(obj) == "text_spec")) {
res <- create_text_pages_rtf(rs, cntnt, last_page_lines, cbr)
for (j in seq_len(length(res$rtf))) {
pgs[[length(pgs) + 1]] <- res$rtf[[j]]
lns[[length(lns) + 1]] <- res$lines[[j]]
}
} else if (any(class(obj) == "plot_spec")) {
# Plots not started rtf2 conversion
res <- create_plot_pages_rtf(rs, cntnt, last_page_lines, tempdir())
for (j in seq_len(length(res$rtf))) {
pgs[[length(pgs) + 1]] <- res$rtf[[j]]
lns[[length(lns) + 1]] <- res$lines[[j]]
}
}
# Store pages and lines with content objects
# The content settings will be used when writing content
ls[[i]]$pages <- pgs
ls[[i]]$lines <- lns
# This section of code is appending blank lines to get
# footnotes at the bottom of the page. The complication
# is when there are multiple pieces of content, and user-defined
# page breaks. So these can't be added earlier in
# the process. In short, these blanks are for in between
# pieces of content. Blanks within a piece of content are
# handled in the create_table_*, create_text_*, and create_plot_*
# functions.
# Capture last page
last_page <- pgs[[length(pgs)]]
# Capture number of lines on the last page
last_page_lines <- lns[[length(lns)]] + last_page_lines
# print(last_page_lines)
if (length(pgs) > 1)
last_page_lines <- lns[[length(lns)]]
# If there is a page break or it's the last object in the
# content list, add the blank lines if needed.
if ((ls[[i]]$page_break | last_object) & hrf) {
# Add extra offsets if table has a lot of borders turned on
# to avoid undesired page wraps
boff <- 0
if (any(class(obj) == "table_spec") &
any(obj$borders %in% c("all", "inside"))) {
boff <- round(last_page_lines * rs$border_height / rs$row_height)
}
blnks <- c()
bl <- rs$body_line_count - last_page_lines - boff
if (bl > 0)
blnks <- rep("\\par", bl)
last_page <- append(last_page, blnks)
last_page_lines <- 0
}
if (cntnt$page_break == TRUE | last_page_lines >= rs$body_line_count)
last_page_lines <- 0
ls[[i]]$pages[[length(pgs)]] <- last_page
}
# Can return something else if needed here
ret <- list(widths = table_widths, pages = ls)
return(ret)
}
#' @title Write out content
#' @description This loop writes out pages created in paginate_content
#' Page template items added to the report (titles/footnotes/title_header)
#' are added in this step. That means these items need to have been accounted
#' for in the previous steps.
#' @noRd
write_content_rtf <- function(rs, hdr, body, pt) {
# Kill existing file
if (file.exists(rs$modified_path))
file.remove(rs$modified_path)
counter <- 0
page <- 0
last_object <- FALSE
last_page <- FALSE
page_open <- FALSE
f <- file(rs$modified_path, open="a", encoding = "native.enc")
writeLines(hdr, con = f, useBytes = TRUE)
for (cont in body$pages) {
# Increment counter
counter <- counter + 1
page <- 0
# Set last_object flag
if (counter == length(body$pages))
last_object <- TRUE
else
last_object <- FALSE
for (pg in cont$pages) {
page <- page + 1
if (page == length(cont$pages))
last_page <- TRUE
else
last_page <- FALSE
#print(page_open)
if (page_open == FALSE) {
if (!is.null(rs$title_hdr) & !is.null(pt$title_hdr$rtf))
writeLines(pt$title_hdr$rtf, con = f, useBytes = TRUE)
if (!is.null(rs$titles) & !is.null(pt$titles$rtf))
writeLines(pt$titles$rtf, con = f, useBytes = TRUE)
}
if (!is.null(pg)) {
writeLines(pg, con = f, useBytes = TRUE)
}
# Set page_open flag based on status of page_break and current objects
if (last_object == FALSE & last_page == TRUE & cont$page_break == FALSE)
page_open <- TRUE
else
page_open <- FALSE
if (page_open == FALSE) {
if (!is.null(rs$footnotes) & !is.null(pt$footnotes$rtf))
writeLines(pt$footnotes$rtf, con = f, useBytes = TRUE)
if (is.null(rs$pages))
rs$pages <- 1
else
rs$pages <- rs$pages + 1
# Add form feed character for text page break
if (last_object == FALSE | last_page == FALSE) {
if (is.null(cont$object$continuous) || cont$object$continuous == FALSE) {
writeLines(rs$page_break_rtf, con = f, useBytes = TRUE)
} else {
if (last_page & cont$page_break == TRUE) {
writeLines(rs$page_break_rtf, con = f, useBytes = TRUE)
}
}
}
}
# if (last_object == TRUE & last_page == TRUE) {
#
# rs$pages <- rs$pages + 1
#
# }
}
}
writeLines("{\\pard\\fs1\\sl0 \\par}}", con = f, useBytes = TRUE)
close(f)
return(rs)
}
update_page_numbers_rtf <- function(path, tpg) {
lns <- readLines(path, encoding = "UTF-8")
lns <- gsub("[tpg]", tpg, lns, fixed = TRUE)
f <- file(path, open = "w+", encoding = "native.enc")
writeLines(lns, con = f, useBytes = TRUE)
close(f)
}
# Setup Functions ---------------------------------------------------------
#' @description Setup page for content
#' @details Calculates available space for content and prepares text lines
#' for page template.
#' @noRd
page_setup_rtf <- function(rs) {
debug <- FALSE
# Content size is the page size minus margins, in units of measure
rs$content_size <- get_content_size(rs)
# A lot of these values are guesses. Need to test.
# Row height and line height were defined independently in case
# they are different. Right now, appear to be the same.
if (rs$font_size == 8) {
rh <- 228 #round(.11 * 1440)
lh <- 228 #round(.1 * 1440)
#pb <- "\\fs1\\sl0\\par\\pard\\fs16\\page\\fs1\\sl0\\par\\pard\\fs16"
pb <- "{\\pard\\pagebb\\fs1\\sl0\\par}\\fs16"
if (tolower(rs$font) == "courier")
gtr <- .15
else
gtr <- .13
cw <- .1
cp <- 40
# sm <- "\\sl-180\\slmult0"
} else if (rs$font_size == 9) {
rh <- 244 #round(.165 * 1440) # 225
lh <- 244 #round(.165 * 1440)
#pb <- "\\page\\line" #fs1\\sl0\\par\\pard\\fs20"
pb <- "{\\pard\\pagebb\\fs1\\sl0\\par}\\fs18"
if (tolower(rs$font) == "courier")
gtr <- .16
else
gtr <- .14
cw <- .11
cp <- 40
#sm <- "\\sl-200\\slmult0"
} else if (rs$font_size == 10) {
rh <- 250 #round(.165 * 1440) # 225
lh <- 250 #round(.165 * 1440)
#pb <- "\\page\\line" #fs1\\sl0\\par\\pard\\fs20"
pb <- "{\\pard\\pagebb\\fs1\\sl0\\par}\\fs20"
if (tolower(rs$font) == "courier")
gtr <- .17
else
gtr <- .15
cw <- .11
cp <- 40
#sm <- "\\sl-225\\slmult0"
} else if (rs$font_size == 11) {
rh <- 250 #round(.165 * 1440) # 225
lh <- 250 #round(.165 * 1440)
#pb <- "\\page\\line" #fs1\\sl0\\par\\pard\\fs20"
pb <- "{\\pard\\pagebb\\fs1\\sl0\\par}\\fs22"
if (tolower(rs$font) == "courier")
gtr <- .18
else
gtr <- .16
cw <- .12
cp <- 40
#sm <- "\\sl-250\\slmult0"
} else if (rs$font_size == 12) {
rh <- 275 #round(.2 * 1440)
lh <- 275 #round(.1875 * 1440) #270
pb <- "{\\pard\\pagebb\\fs1\\sl0\\par}\\fs24"
if (tolower(rs$font) == "courier")
gtr <- .19
else
gtr <- .17
cw <- .12
cp <- 40
#sm <- "\\sl-275\\slmult0"
}
# Get conversion factor to twips
if (rs$units == "inches") {
conv <- 1440
} else {
conv <- 566.9291
}
rs$twip_conversion <- conv
rs$row_height <- rh
rs$line_height <- lh
rs$char_width <- cw
rs$line_size <- rs$content_size[["width"]]
rs$cell_padding <- cp
rs$spacing_multiplier <- get_spacing_multiplier(rs$font_size)
rs$page_break_rtf <- paste0(pb, rs$spacing_multiplier)
rs$border_height <- 15
# Line spacing values determined by trial and error.
# Needed for LibreOffice. Appear to be ignored in Word.
if (rs$font_size == 10) {
rs$font_rtf <- "\\f0\\fs20"
} else if (rs$font_size == 12) {
rs$font_rtf <- "\\f0\\fs24"
} else if (rs$font_size == 11) {
rs$font_rtf <- "\\f0\\fs22"
} else if (rs$font_size == 9) {
rs$font_rtf <- "\\f0\\fs18"
} else if (rs$font_size == 8) {
rs$font_rtf <- "\\f0\\fs16"
}
if (rs$units == "cm")
rs$gutter_width <- ccm(gtr)
else
rs$gutter_width <- gtr
if (is.null(rs$user_line_count)) {
# There is one row above the page footer that is not printable.
# Therefore adjust by 1.
rs$line_count <- floor(rs$content_size[[1]] * conv / rh) - 1
} else
rs$line_count <- rs$user_line_count
if (debug) {
print(paste("Content Height:", rs$content_size[[1]]))
print(paste("Content Width:", rs$content_size[[2]]))
print(paste("Line Count:", rs$line_count))
print(paste("Line Height:", rs$line_height))
print(paste("Gutter Width:", rs$gutter_width))
print(paste("Char Width:", rs$char_width))
}
# Get page template
pt <- page_template_rtf(rs)
rs$page_template <- pt
# Body size in twips
# Small adjustment by one line height
# This gets used to determine lines on a page.
rs$body_size <-
c(height = floor((rs$content_size[[1]] * conv) - pt$page_header$twips - pt$page_footer$twips - lh),
width = floor(rs$content_size[[2]] * conv))
if (debug) {
print(paste("Body Height:", rs$body_size[[1]]))
print(paste("Body Width:", rs$body_size[[2]]))
}
# Get the page template row count
# Include all the rows associated with the page template
rs$page_template_header_count <- sum(pt$page_header$lines, pt$titles$lines,
pt$title_hdr$lines, pt$page_by$lines)
if (debug)
print(paste("Page Template Header Count:", rs$page_template_header_count))
rs$page_template_footer_count <- sum(pt$footnotes$lines, pt$page_footer$lines)
if (debug)
print(paste("Page Template Footer Count:", rs$page_template_footer_count))
rs$page_template_row_count <- rs$page_template_header_count +
rs$page_template_footer_count
if (debug)
print(paste("Page Template Row Count:", rs$page_template_row_count))
# Body line count is the number of rows available for content on each page
rs$body_line_count <- rs$line_count - rs$page_template_row_count
if (debug)
print(paste0("Body Line Count: ", rs$body_line_count))
return(rs)
}
#' @noRd
get_spacing_multiplier <- function(font_size) {
if (font_size == 8) {
sm <- "\\sl-228\\slmult0"
} else if (font_size == 9) {
sm <- "\\sl-244\\slmult0"
} else if (font_size == 10) {
sm <- "\\sl-250\\slmult0"
} else if (font_size == 11) {
sm <- "\\sl-250\\slmult0"
} else if (font_size == 12) {
sm <- "\\sl-275\\slmult0"
} else if (font_size == 13) {
sm <- "\\sl-300\\slmult0"
} else if (font_size == 14) {
sm <- "\\sl-325\\slmult0"
} else {
sm <- "\\sl-250\\slmult0"
}
return(sm)
}
Try the reporter package in your browser
Any scripts or data that you put into this service are public.
reporter documentation built on May 29, 2024, 4:43 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions get_spacing_multiplier page_setup_rtf update_page_numbers_rtf write_content_rtf paginate_content_rtf get_rtf_document write_report_rtf2
# Write Report RTF2 -------------------------------------------------------
#' @title
#' Write a RTF2 report to the file system
#'
#' @description
#' This function writes a report_spec object to the file system, using the
#' parameters provided in the object.
#'
#' @param x The report_spec object to write.
#' @return The report spec.
#' @noRd
write_report_rtf2 <- function(rs) {
orig_path <- rs$modified_path
if (file.exists(orig_path))
file.remove(orig_path)
# Establish content and body sizes
rs <- page_setup_rtf(rs)
# Document header is mostly independent of content
hdr <- get_rtf_document(rs)
# Put content in a new variable
ls <- rs$content
# Get content and break it into pages
# Needs to return a list of pages so preview can work
# Page numbers need to be included
bdy <- paginate_content_rtf(rs, ls)
# Get column widths
rs$column_widths <- bdy[["widths"]]
# Deal with preview
if (!is.null(rs$preview)) {
if (rs$preview < length(bdy[[1]]$pages))
bdy[[1]]$pages <- bdy[[1]]$pages[seq(1, rs$preview)]
}
# Write content to file system
# Later we can just return the stream
rs <- write_content_rtf(rs, hdr, bdy, rs$page_template)
# Update page numbers for title headers
update_page_numbers_rtf(orig_path, rs$pages)
return(rs)
}
#' @description Returns header for RTF document. This is independent of content,
#' except for the page header and footer.
#' @noRd
get_rtf_document <- function(rs) {
# Set up vectors
ret <- c()
conv <- rs$twip_conversion
fnt <- rs$font
if (tolower(rs$font) == "times")
fnt <- "Times New Roman"
# Prepare header
ret[length(ret) + 1] <- paste0("{\\rtf1\\ansi\\deff0 {\\fonttbl {\\f0 ", fnt , ";}}")
if (rs$orientation == "landscape") {
#ret[length(ret) + 1] <- "\\landscape\\horzdoc"
ret[length(ret) + 1] <- "\\landscape"
ret[length(ret) + 1] <- paste0("\\paperw", round(rs$page_size[2] * conv),
"\\paperh", round(rs$page_size[1] * conv))
} else {
#ret[length(ret) + 1] <- "\\vertdoc"
ret[length(ret) + 1] <- paste0("\\paperw", round(rs$page_size[1] * conv),
"\\paperh", round(rs$page_size[2] * conv))
}
ret[length(ret) + 1] <- paste0("\\margl", round(rs$margin_left * conv),
"\\margr", round(rs$margin_right * conv),
"\\margt", round(rs$margin_top * conv),
"\\margb", round(rs$margin_bottom * conv),
"\\headery", round(rs$margin_top * conv),
"\\footery", round(rs$margin_bottom * conv))
ph <- get_page_header_rtf(rs)
if (ph$rtf != "")
ret[length(ret) + 1] <- ph$rtf
pf <- get_page_footer_rtf(rs)
if (pf$rtf != "")
ret[length(ret) + 1] <- pf$rtf
# Line spacing values determined by trial and error.
# Needed for LibreOffice. Appear to be ignored in Word.
ret[length(ret) + 1] <- paste0(rs$spacing_multiplier, rs$font_rtf)
return(ret)
}
#' @noRd
paginate_content_rtf <- function(rs, ls) {
ret <- c()
last_object <- FALSE
last_page_lines <- 0
table_widths <- list()
hrf <- has_bottom_footnotes(rs)
# Loop through content objects
for (i in seq_along(ls)) {
pgs <- list() # list of vectors with page rtf lines
lns <- c()
# Set last object flag
if (i == length(ls))
last_object <- TRUE
else
last_object <- FALSE
# Put content and object in variables for convenience
cntnt <- ls[[i]]
obj <- cntnt$object
# Remove blank row if last content object
cbr <- cntnt$blank_row
if (last_object) {
if (all(cbr == "below"))
cbr <- "none"
else if (all(cbr == "all"))
cbr <- "above"
}
# Break each content type into a list of pages
if (any(class(obj) == "table_spec")) {
res <- create_table_pages_rtf(rs, cntnt, last_page_lines)
# Collect multiple pages and line counts
for (j in seq_len(length(res$page_list))) {
pgs[[length(pgs) + 1]] <- res$page_list[[j]]$rtf
lns[[length(lns) + 1]] <- res$page_list[[j]]$lines
}
# Retrieve table widths. These are useful for debugging.
# Assigned to returning report object.
table_widths[[length(table_widths) + 1]] <- res$widths
} else if (any(class(obj) == "text_spec")) {
res <- create_text_pages_rtf(rs, cntnt, last_page_lines, cbr)
for (j in seq_len(length(res$rtf))) {
pgs[[length(pgs) + 1]] <- res$rtf[[j]]
lns[[length(lns) + 1]] <- res$lines[[j]]
}
} else if (any(class(obj) == "plot_spec")) {
# Plots not started rtf2 conversion
res <- create_plot_pages_rtf(rs, cntnt, last_page_lines, tempdir())
for (j in seq_len(length(res$rtf))) {
pgs[[length(pgs) + 1]] <- res$rtf[[j]]
lns[[length(lns) + 1]] <- res$lines[[j]]
}
}
# Store pages and lines with content objects
# The content settings will be used when writing content
ls[[i]]$pages <- pgs
ls[[i]]$lines <- lns
# This section of code is appending blank lines to get
# footnotes at the bottom of the page. The complication
# is when there are multiple pieces of content, and user-defined
# page breaks. So these can't be added earlier in
# the process. In short, these blanks are for in between
# pieces of content. Blanks within a piece of content are
# handled in the create_table_*, create_text_*, and create_plot_*
# functions.
# Capture last page
last_page <- pgs[[length(pgs)]]
# Capture number of lines on the last page
last_page_lines <- lns[[length(lns)]] + last_page_lines
# print(last_page_lines)
if (length(pgs) > 1)
last_page_lines <- lns[[length(lns)]]
# If there is a page break or it's the last object in the
# content list, add the blank lines if needed.
if ((ls[[i]]$page_break | last_object) & hrf) {
# Add extra offsets if table has a lot of borders turned on
# to avoid undesired page wraps
boff <- 0
if (any(class(obj) == "table_spec") &
any(obj$borders %in% c("all", "inside"))) {
boff <- round(last_page_lines * rs$border_height / rs$row_height)
}
blnks <- c()
bl <- rs$body_line_count - last_page_lines - boff
if (bl > 0)
blnks <- rep("\\par", bl)
last_page <- append(last_page, blnks)
last_page_lines <- 0
}
if (cntnt$page_break == TRUE | last_page_lines >= rs$body_line_count)
last_page_lines <- 0
ls[[i]]$pages[[length(pgs)]] <- last_page
}
# Can return something else if needed here
ret <- list(widths = table_widths, pages = ls)
return(ret)
}
#' @title Write out content
#' @description This loop writes out pages created in paginate_content
#' Page template items added to the report (titles/footnotes/title_header)
#' are added in this step. That means these items need to have been accounted
#' for in the previous steps.
#' @noRd
write_content_rtf <- function(rs, hdr, body, pt) {
# Kill existing file
if (file.exists(rs$modified_path))
file.remove(rs$modified_path)
counter <- 0
page <- 0
last_object <- FALSE
last_page <- FALSE
page_open <- FALSE
f <- file(rs$modified_path, open="a", encoding = "native.enc")
writeLines(hdr, con = f, useBytes = TRUE)
for (cont in body$pages) {
# Increment counter
counter <- counter + 1
page <- 0
# Set last_object flag
if (counter == length(body$pages))
last_object <- TRUE
else
last_object <- FALSE
for (pg in cont$pages) {
page <- page + 1
if (page == length(cont$pages))
last_page <- TRUE
else
last_page <- FALSE
#print(page_open)
if (page_open == FALSE) {
if (!is.null(rs$title_hdr) & !is.null(pt$title_hdr$rtf))
writeLines(pt$title_hdr$rtf, con = f, useBytes = TRUE)
if (!is.null(rs$titles) & !is.null(pt$titles$rtf))
writeLines(pt$titles$rtf, con = f, useBytes = TRUE)
}
if (!is.null(pg)) {
writeLines(pg, con = f, useBytes = TRUE)
}
# Set page_open flag based on status of page_break and current objects
if (last_object == FALSE & last_page == TRUE & cont$page_break == FALSE)
page_open <- TRUE
else
page_open <- FALSE
if (page_open == FALSE) {
if (!is.null(rs$footnotes) & !is.null(pt$footnotes$rtf))
writeLines(pt$footnotes$rtf, con = f, useBytes = TRUE)
if (is.null(rs$pages))
rs$pages <- 1
else
rs$pages <- rs$pages + 1
# Add form feed character for text page break
if (last_object == FALSE | last_page == FALSE) {
if (is.null(cont$object$continuous) || cont$object$continuous == FALSE) {
writeLines(rs$page_break_rtf, con = f, useBytes = TRUE)
} else {
if (last_page & cont$page_break == TRUE) {
writeLines(rs$page_break_rtf, con = f, useBytes = TRUE)
}
}
}
}
# if (last_object == TRUE & last_page == TRUE) {
#
# rs$pages <- rs$pages + 1
#
# }
}
}
writeLines("{\\pard\\fs1\\sl0 \\par}}", con = f, useBytes = TRUE)
close(f)
return(rs)
}
update_page_numbers_rtf <- function(path, tpg) {
lns <- readLines(path, encoding = "UTF-8")
lns <- gsub("[tpg]", tpg, lns, fixed = TRUE)
f <- file(path, open = "w+", encoding = "native.enc")
writeLines(lns, con = f, useBytes = TRUE)
close(f)
}
# Setup Functions ---------------------------------------------------------
#' @description Setup page for content
#' @details Calculates available space for content and prepares text lines
#' for page template.
#' @noRd
page_setup_rtf <- function(rs) {
debug <- FALSE
# Content size is the page size minus margins, in units of measure
rs$content_size <- get_content_size(rs)
# A lot of these values are guesses. Need to test.
# Row height and line height were defined independently in case
# they are different. Right now, appear to be the same.
if (rs$font_size == 8) {
rh <- 228 #round(.11 * 1440)
lh <- 228 #round(.1 * 1440)
#pb <- "\\fs1\\sl0\\par\\pard\\fs16\\page\\fs1\\sl0\\par\\pard\\fs16"
pb <- "{\\pard\\pagebb\\fs1\\sl0\\par}\\fs16"
if (tolower(rs$font) == "courier")
gtr <- .15
else
gtr <- .13
cw <- .1
cp <- 40
# sm <- "\\sl-180\\slmult0"
} else if (rs$font_size == 9) {
rh <- 244 #round(.165 * 1440) # 225
lh <- 244 #round(.165 * 1440)
#pb <- "\\page\\line" #fs1\\sl0\\par\\pard\\fs20"
pb <- "{\\pard\\pagebb\\fs1\\sl0\\par}\\fs18"
if (tolower(rs$font) == "courier")
gtr <- .16
else
gtr <- .14
cw <- .11
cp <- 40
#sm <- "\\sl-200\\slmult0"
} else if (rs$font_size == 10) {
rh <- 250 #round(.165 * 1440) # 225
lh <- 250 #round(.165 * 1440)
#pb <- "\\page\\line" #fs1\\sl0\\par\\pard\\fs20"
pb <- "{\\pard\\pagebb\\fs1\\sl0\\par}\\fs20"
if (tolower(rs$font) == "courier")
gtr <- .17
else
gtr <- .15
cw <- .11
cp <- 40
#sm <- "\\sl-225\\slmult0"
} else if (rs$font_size == 11) {
rh <- 250 #round(.165 * 1440) # 225
lh <- 250 #round(.165 * 1440)
#pb <- "\\page\\line" #fs1\\sl0\\par\\pard\\fs20"
pb <- "{\\pard\\pagebb\\fs1\\sl0\\par}\\fs22"
if (tolower(rs$font) == "courier")
gtr <- .18
else
gtr <- .16
cw <- .12
cp <- 40
#sm <- "\\sl-250\\slmult0"
} else if (rs$font_size == 12) {
rh <- 275 #round(.2 * 1440)
lh <- 275 #round(.1875 * 1440) #270
pb <- "{\\pard\\pagebb\\fs1\\sl0\\par}\\fs24"
if (tolower(rs$font) == "courier")
gtr <- .19
else
gtr <- .17
cw <- .12
cp <- 40
#sm <- "\\sl-275\\slmult0"
}
# Get conversion factor to twips
if (rs$units == "inches") {
conv <- 1440
} else {
conv <- 566.9291
}
rs$twip_conversion <- conv
rs$row_height <- rh
rs$line_height <- lh
rs$char_width <- cw
rs$line_size <- rs$content_size[["width"]]
rs$cell_padding <- cp
rs$spacing_multiplier <- get_spacing_multiplier(rs$font_size)
rs$page_break_rtf <- paste0(pb, rs$spacing_multiplier)
rs$border_height <- 15
# Line spacing values determined by trial and error.
# Needed for LibreOffice. Appear to be ignored in Word.
if (rs$font_size == 10) {
rs$font_rtf <- "\\f0\\fs20"
} else if (rs$font_size == 12) {
rs$font_rtf <- "\\f0\\fs24"
} else if (rs$font_size == 11) {
rs$font_rtf <- "\\f0\\fs22"
} else if (rs$font_size == 9) {
rs$font_rtf <- "\\f0\\fs18"
} else if (rs$font_size == 8) {
rs$font_rtf <- "\\f0\\fs16"
}
if (rs$units == "cm")
rs$gutter_width <- ccm(gtr)
else
rs$gutter_width <- gtr
if (is.null(rs$user_line_count)) {
# There is one row above the page footer that is not printable.
# Therefore adjust by 1.
rs$line_count <- floor(rs$content_size[[1]] * conv / rh) - 1
} else
rs$line_count <- rs$user_line_count
if (debug) {
print(paste("Content Height:", rs$content_size[[1]]))
print(paste("Content Width:", rs$content_size[[2]]))
print(paste("Line Count:", rs$line_count))
print(paste("Line Height:", rs$line_height))
print(paste("Gutter Width:", rs$gutter_width))
print(paste("Char Width:", rs$char_width))
}
# Get page template
pt <- page_template_rtf(rs)
rs$page_template <- pt
# Body size in twips
# Small adjustment by one line height
# This gets used to determine lines on a page.
rs$body_size <-
c(height = floor((rs$content_size[[1]] * conv) - pt$page_header$twips - pt$page_footer$twips - lh),
width = floor(rs$content_size[[2]] * conv))
if (debug) {
print(paste("Body Height:", rs$body_size[[1]]))
print(paste("Body Width:", rs$body_size[[2]]))
}
# Get the page template row count
# Include all the rows associated with the page template
rs$page_template_header_count <- sum(pt$page_header$lines, pt$titles$lines,
pt$title_hdr$lines, pt$page_by$lines)
if (debug)
print(paste("Page Template Header Count:", rs$page_template_header_count))
rs$page_template_footer_count <- sum(pt$footnotes$lines, pt$page_footer$lines)
if (debug)
print(paste("Page Template Footer Count:", rs$page_template_footer_count))
rs$page_template_row_count <- rs$page_template_header_count +
rs$page_template_footer_count
if (debug)
print(paste("Page Template Row Count:", rs$page_template_row_count))
# Body line count is the number of rows available for content on each page
rs$body_line_count <- rs$line_count - rs$page_template_row_count
if (debug)
print(paste0("Body Line Count: ", rs$body_line_count))
return(rs)
}
#' @noRd
get_spacing_multiplier <- function(font_size) {
if (font_size == 8) {
sm <- "\\sl-228\\slmult0"
} else if (font_size == 9) {
sm <- "\\sl-244\\slmult0"
} else if (font_size == 10) {
sm <- "\\sl-250\\slmult0"
} else if (font_size == 11) {
sm <- "\\sl-250\\slmult0"
} else if (font_size == 12) {
sm <- "\\sl-275\\slmult0"
} else if (font_size == 13) {
sm <- "\\sl-300\\slmult0"
} else if (font_size == 14) {
sm <- "\\sl-325\\slmult0"
} else {
sm <- "\\sl-250\\slmult0"
}
return(sm)
}
Try the reporter package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.