-
Notifications
You must be signed in to change notification settings - Fork 20
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Isolate side effects in graphics functions #228
Changes from all commits
f1e68a7
63fd9ca
30d2577
4d2d85e
c2bf1bc
a080eb0
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change | ||||||||||||||||||||||||||||||||||||||||||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
|
@@ -53,7 +53,7 @@ rtf_strwidth <- function(tbl) { | |||||||||||||||||||||||||||||||||||||||||||||||||||||||
} | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
# Font size | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
text_cex <- attr(tbl, "text_font_size") / graphics::par("ps") | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
text_cex <- attr(tbl, "text_font_size") / safe_par("ps") | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
# Font format | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
# text format 1 (plain/normal), 2 (bold), 3 (italic), 4 (bold-italic) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
@@ -107,7 +107,8 @@ rtf_strwidth <- function(tbl) { | |||||||||||||||||||||||||||||||||||||||||||||||||||||||
grDevices::windowsFonts("Courier" = grDevices::windowsFont("Courier New")) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
} | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
x$width <- graphics::strwidth(x$text, | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
x$width <- safe_strwidth( | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
x$text, | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
units = "inches", | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
cex = x$cex[1], | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
font = x$font[1], | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
@@ -131,3 +132,37 @@ rtf_strwidth <- function(tbl) { | |||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
width | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
} | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
#' Safe version of `graphics::par()` with side effects isolated | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
#' | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
#' @noRd | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
safe_par <- function(...) with_bmp(graphics::par(...)) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
#' Safe version of `graphics::strwidth()` with side effects isolated | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
#' | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
#' @noRd | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
safe_strwidth <- function(text, ...) with_bmp(graphics::strwidth(text, ...)) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
#' Evaluate expression within a BMP device and close it on exit | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
#' | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
#' See why: <https://github.com/Merck/r2rtf/issues/227> | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
#' | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
#' @noRd | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
with_bmp <- function(expr) { | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
expr <- substitute(expr) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
grDevices::bmp(file_null()) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
on.exit( | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
{ | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
current <- grDevices::dev.cur() | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
if (current > 1) { | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
prev <- grDevices::dev.prev(current) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
grDevices::dev.off(current) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
if (prev != current) grDevices::dev.set(prev) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
} | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
}, | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
add = TRUE | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
eval(expr, envir = parent.frame()) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Comment on lines
+152
to
+165
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I don't think you need
Suggested change
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
} | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
file_null <- function() if (.Platform$OS.type == "windows") "nul:" else "/dev/null" | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Could we use "tempfile" to avoid a OS dependent logic? There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I guess writing to the null device is often faster than a real file. |
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,9 @@ | ||
test_that("Running graphics functions within with_bmp() does not affect graphics device", { | ||
dev_cur <- grDevices::dev.cur() | ||
|
||
with_bmp(par("mar")) | ||
safe_par("font") | ||
safe_strwidth("Hello world!", units = "inches", cex = 1, font = 1, family = "sans") | ||
|
||
expect_equal(grDevices::dev.cur(), dev_cur) | ||
}) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Just for my understanding. Why would bmp() device used instead of pdf()