/
rtf_page.R
231 lines (209 loc) · 8.22 KB
/
rtf_page.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
# Copyright (c) 2022 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. All rights reserved.
#
# This file is part of the r2rtf program.
#
# r2rtf is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#' Add RTF File Page Information
#'
#' @param tbl A data frame.
#' @param orientation Orientation in 'portrait' or 'landscape'.
#' @param width A numeric value of page width in inches.
#' @param height A numeric value of page width in inches.
#' @param margin A numeric vector of length 6 for page margin. The value set left, right, top, bottom, header and footer
#' margin in order. Default value depends on the page orientation and set by `r2rtf:::set_margin("wma", orientation)`
#' @param nrow Number of rows in each page.
#' @param border_first First top border type of the whole table.
#' All possible input can be found in `r2rtf:::border_type()$name`.
#' @param border_last Last bottom border type of the whole table.
#' All possible input can be found in `r2rtf:::border_type()$name`.
#' @param border_color_first First top border color type of the whole table. Default is NULL for black.
#' All possible input can be found in `grDevices::colors()`.
#' @param border_color_last Last bottom border color type of the whole table. Default is NULL for black.
#' All possible input can be found in `grDevices::colors()`.
#' @param col_width A numeric value of total column width in inch. Default is `width - ifelse(orientation == "portrait", 2, 2.5)`
#' @param use_color A logical value to use color in the output.
#'
#' @section Specification:
#' \if{latex}{
#' \itemize{
#'
#' \item Check if all argument types and values are valid inputs.
#' \item Add attributes to `tbl` based on the inputs.
#' \item Register the use of color in page attributes.
#' \item Return to `tbl` with page attributes.
#' }
#' }
#' \if{html}{The contents of this section are shown in PDF user manual only.}
#'
#' @return the same data frame \code{tbl} with additional attributes for page features
#'
#' @examples
#' library(dplyr) # required to run examples
#' data(r2rtf_tbl1)
#' r2rtf_tbl1 %>%
#' rtf_page() %>%
#' attr("page")
#' @export
rtf_page <- function(tbl,
orientation = "portrait",
width = ifelse(orientation == "portrait", 8.5, 11),
height = ifelse(orientation == "portrait", 11, 8.5),
margin = set_margin("wma", orientation),
nrow = ifelse(orientation == "portrait", 40, 24),
border_first = "double",
border_last = "double",
border_color_first = NULL,
border_color_last = NULL,
col_width = width - ifelse(orientation == "portrait", 2.25, 2.5),
use_color = FALSE) {
# Check argument type
check_args(width, type = c("integer", "numeric"), length = 1)
check_args(height, type = c("integer", "numeric"), length = 1)
check_args(orientation, type = c("character"), length = 1)
check_args(margin, type = c("integer", "numeric"), length = 6)
check_args(nrow, type = c("integer", "numeric"), length = 1)
check_args(col_width, type = c("integer", "numeric"), length = 1)
# Convert tbl to a data frame, each column is a character
if (any(class(tbl) %in% "data.frame")) tbl <- as.data.frame(tbl, stringsAsFactors = FALSE)
# Check argument values
stopifnot(width > 0)
stopifnot(height > 0)
stopifnot(all(margin > 0))
match.arg(orientation, c("portrait", "landscape"))
stopifnot(nrow > 0)
stopifnot(col_width > 0)
# Add attributes
attr(tbl, "page")$width <- width
attr(tbl, "page")$height <- height
attr(tbl, "page")$orientation <- orientation
attr(tbl, "page")$margin <- margin
attr(tbl, "page")$nrow <- nrow
attr(tbl, "page")$col_width <- col_width
attr(tbl, "page")$border_first <- border_first
attr(tbl, "page")$border_last <- border_last
attr(tbl, "page")$border_color_first <- border_color_first
attr(tbl, "page")$border_color_last <- border_color_last
attr(tbl, "page")$page_title <- "all"
attr(tbl, "page")$page_footnote <- "last"
attr(tbl, "page")$page_source <- "last"
# Register Color Use
color <- list(border_color_first, border_color_last)
if (!all(unlist(color) %in% c("black", ""))) {
attr(tbl, "page")$use_color <- TRUE
} else {
attr(tbl, "page")$use_color <- FALSE
}
if (use_color) {
attr(tbl, "page")$use_color <- TRUE
}
tbl
}
#' Add RTF Page Header Information
#'
#' @param text A character string.
#' @inheritParams rtf_footnote
#'
#' @export
rtf_page_header <- function(tbl,
text = "Page \\pagenumber of \\pagefield",
text_font = 1,
text_format = NULL,
text_font_size = 12,
text_color = NULL,
text_background_color = NULL,
text_justification = "r",
text_indent_first = 0,
text_indent_left = 0,
text_indent_right = 0,
text_space = 1,
text_space_before = 15,
text_space_after = 15,
text_convert = TRUE) {
# Convert tbl to a data frame, each column is a character
if (any(class(tbl) %in% "data.frame")) tbl <- as.data.frame(tbl, stringsAsFactors = FALSE)
text <- obj_rtf_text(text,
text_font,
text_format,
text_font_size,
text_color,
text_background_color,
text_justification,
text_indent_first,
text_indent_left,
text_indent_right,
text_space,
text_space_before,
text_space_after,
text_new_page = NULL,
text_hyphenation = NULL,
text_convert = text_convert
)
attr(tbl, "rtf_page_header") <- text
# Set Default Page Attributes
if (is.null(attr(tbl, "page"))) {
tbl <- rtf_page(tbl)
}
# Register Color Use
if (attr(text, "use_color")) attr(tbl, "page")$use_color <- TRUE
tbl
}
#' Add RTF Page Footer Information
#'
#' @param text A character string.
#' @inheritParams rtf_footnote
#'
#' @export
rtf_page_footer <- function(tbl,
text,
text_font = 1,
text_format = NULL,
text_font_size = 12,
text_color = NULL,
text_background_color = NULL,
text_justification = "c",
text_indent_first = 0,
text_indent_left = 0,
text_indent_right = 0,
text_space = 1,
text_space_before = 15,
text_space_after = 15,
text_convert = TRUE) {
# Convert tbl to a data frame, each column is a character
if (any(class(tbl) %in% "data.frame")) tbl <- as.data.frame(tbl, stringsAsFactors = FALSE)
text <- obj_rtf_text(text,
text_font,
text_format,
text_font_size,
text_color,
text_background_color,
text_justification,
text_indent_first,
text_indent_left,
text_indent_right,
text_space,
text_space_before,
text_space_after,
text_new_page = NULL,
text_hyphenation = NULL,
text_convert = text_convert
)
attr(tbl, "rtf_page_footer") <- text
# Set Default Page Attributes
if (is.null(attr(tbl, "page"))) {
tbl <- rtf_page(tbl)
}
# Register Color Use
if (attr(text, "use_color")) attr(tbl, "page")$use_color <- TRUE
tbl
}