context("richtext-grob") test_that("grobheight and grobwidth work", { # width is the same for textGrob and richtext_grob g <- textGrob("test") g2 <- richtext_grob("test") w <- convertWidth(grobWidth(g), "pt", valueOnly = TRUE) w2 <- convertWidth(grobWidth(g2), "pt", valueOnly = TRUE) expect_equal(w, w2) # height is slightly larger for richtext_grob, b/c descent is considered h <- convertHeight(grobHeight(g), "pt", valueOnly = TRUE) h2 <- convertHeight(grobHeight(g2), "pt", valueOnly = TRUE) expect_lt(h, h2) # width and height are flipped after rotating 90 degrees g <- textGrob("test", rot = 90) g2 <- richtext_grob("test", rot = 90) w <- convertWidth(grobWidth(g), "pt", valueOnly = TRUE) w2 <- convertWidth(grobWidth(g2), "pt", valueOnly = TRUE) expect_lt(w, w2) # height is slightly larger for richtext_grob, b/c descent is considered h <- convertHeight(grobHeight(g), "pt", valueOnly = TRUE) h2 <- convertHeight(grobHeight(g2), "pt", valueOnly = TRUE) expect_equal(h, h2) # position of multiple labels is taken into account g <- textGrob("test", x = unit(0, "pt"), y = unit(80, "pt")) g2 <- textGrob(c("test", "test"), x = unit(c(0, 50), "pt"), y = unit(c(80, 40), "pt")) w <- convertWidth(grobWidth(g), "pt", valueOnly = TRUE) w2 <- convertWidth(grobWidth(g2), "pt", valueOnly = TRUE) expect_equal(w + 50, w2) h <- convertHeight(grobHeight(g), "pt", valueOnly = TRUE) h2 <- convertHeight(grobHeight(g2), "pt", valueOnly = TRUE) expect_equal(h + 40, h2) # multiple labels, w rotation g <- textGrob("test", x = unit(0, "pt"), y = unit(80, "pt"), rot = 45) g2 <- textGrob(c("test", "test"), x = unit(c(0, 50), "pt"), y = unit(c(80, 40), "pt"), rot = 45) w <- convertWidth(grobWidth(g), "pt", valueOnly = TRUE) w2 <- convertWidth(grobWidth(g2), "pt", valueOnly = TRUE) expect_equal(w + 50, w2) h <- convertHeight(grobHeight(g), "pt", valueOnly = TRUE) h2 <- convertHeight(grobHeight(g2), "pt", valueOnly = TRUE) expect_equal(h + 40, h2) # grob height and width are identical with and without debug info text <- c( "Some text **in bold.**
(centered)", "Linebreaks
Linebreaks
Linebreaks", "*x*2 + 5*x* + *C*i
*a* = 5" ) x <- c(.4, .3, .8) y <- c(.8, .5, .3) rot <- c(0, -45, 45) halign <- c(0.5, 0, 1) valign <- c(0.5, 1, 0) g1 <- richtext_grob( text, x, y, halign = halign, valign = valign, rot = rot, padding = unit(c(6, 6, 4, 6), "pt"), r = unit(c(0, 4, 8), "pt"), debug = FALSE ) g2 <- richtext_grob( text, x, y, halign = halign, valign = valign, rot = rot, padding = unit(c(6, 6, 4, 6), "pt"), r = unit(c(0, 4, 8), "pt"), debug = TRUE ) w1 <- convertWidth(grobWidth(g1), "pt", valueOnly = TRUE) w2 <- convertWidth(grobWidth(g2), "pt", valueOnly = TRUE) expect_equal(w1, w2) h1 <- convertHeight(grobHeight(g1), "pt", valueOnly = TRUE) h2 <- convertHeight(grobHeight(g2), "pt", valueOnly = TRUE) expect_equal(h1, h2) }) test_that("misc. tests", { # empty strings work expect_silent(richtext_grob("")) expect_silent(richtext_grob(" ")) # NAs work expect_silent(richtext_grob(c(" ", "abc", NA))) }) test_that("visual tests", { draw_labels <- function() { function() { text <- c( "**Various text boxes in different stylings**", "Some text **in bold.**
(centered)", "Linebreaks
Linebreaks
Linebreaks", "*x*2 + 5*x* + *C*i
*a* = 5" ) x <- c(0, .4, .3, .8) y <- c(1, .8, .5, .3) rot <- c(0, 0, -45, 45) gp = gpar(col = c("black", "red")) box_gp = gpar(col = "black", fill = c(NA, "cornsilk", NA, "lightblue1"), lty = c(0, 1, 1, 1)) hjust <- c(0, 0.5, 0, 1) vjust <- c(1, 0.5, 1, 0) g <- richtext_grob( text, x, y, hjust = hjust, vjust = vjust, rot = rot, padding = unit(c(6, 6, 4, 6), "pt"), r = unit(c(0, 0, 4, 8), "pt"), gp = gp, box_gp = box_gp ) grid.draw(g) grid.points(x, y, default.units = "npc", pch = 19, size = unit(5, "pt")) invisible() } } expect_doppelganger("Various text boxes", draw_labels()) draw_labels_debug <- function() { function() { text <- c( "Some text **in bold.**
(centered)", "Linebreaks
Linebreaks
Linebreaks", "*x*2 + 5*x* + *C*i
*a* = 5" ) x <- c(.4, .3, .8) y <- c(.8, .5, .3) rot <- c(0, -45, 45) gp = gpar(col = c("black", "red", "black")) box_gp = gpar(col = "black", fill = c("cornsilk", NA, "lightblue1"), lty = c(1, 1, 1)) hjust <- c(0.5, 0, 1) vjust <- c(0.5, 1, 0) g <- richtext_grob( text, x, y, hjust = hjust, vjust = vjust, rot = rot, padding = unit(c(6, 6, 4, 6), "pt"), r = unit(c(0, 4, 8), "pt"), gp = gp, box_gp = box_gp, debug = TRUE ) grid.draw(g) grid.points(x, y, default.units = "npc", pch = 19, size = unit(5, "pt")) invisible() } } expect_doppelganger("Various text boxes w/ debug", draw_labels_debug()) draw_aligned_heights <- function() { function() { text <- c( "Some text **in bold.**
(centered)", "Linebreaks
Linebreaks
Linebreaks", "*x*2 + 5*x* + *C*i
*a* = 5" ) x <- c(.4, .3, .8) y <- c(.8, .5, .3) rot <- c(0, -45, 45) gp = gpar() box_gp = gpar(col = "black", fill = c("cornsilk", NA, "lightblue1")) hjust <- c(0.5, 0, 1) vjust <- c(0.5, 1, 0) g <- richtext_grob( text, x, y, halign = 0.5, valign = 0.5, hjust = hjust, vjust = vjust, rot = rot, align_heights = TRUE, padding = unit(c(6, 6, 4, 6), "pt"), r = unit(c(0, 4, 8), "pt"), gp = gp, box_gp = box_gp ) grid.draw(g) grid.text("Box heights aligned, content centered", gp = gpar(fontface = "bold"), 0.02, 1, hjust = 0, vjust = 1.2) grid.points(x, y, default.units = "npc", pch = 19, size = unit(5, "pt")) invisible() } } expect_doppelganger("Aligned heights", draw_aligned_heights()) draw_aligned_widths <- function() { function() { text <- c( "Some text **in bold.**
(centered)", "Linebreaks
Linebreaks
Linebreaks", "*x*2 + 5*x* + *C*i
*a* = 5" ) x <- c(.4, .3, .8) y <- c(.8, .5, .3) rot <- c(0, -45, 45) gp = gpar() box_gp = gpar(col = "black", fill = c("cornsilk", NA, "lightblue1")) hjust <- c(0.5, 0, 1) vjust <- c(0.5, 1, 0) g <- richtext_grob( text, x, y, halign = 0.5, valign = 0.5, hjust = hjust, vjust = vjust, rot = rot, align_widths = TRUE, padding = unit(c(6, 6, 4, 6), "pt"), r = unit(c(0, 4, 8), "pt"), gp = gp, box_gp = box_gp ) grid.draw(g) grid.text("Box widths aligned, content centered", gp = gpar(fontface = "bold"), 0.02, 1, hjust = 0, vjust = 1.2) grid.points(x, y, default.units = "npc", pch = 19, size = unit(5, "pt")) invisible() } } expect_doppelganger("Aligned widths", draw_aligned_widths()) })