test_that("textpathGrobs can be created", { grid.newpage() # Default empty textpathGrob expect_silent(textpathGrob()) # Single point-like expect_silent(textpathGrob(label = "Hello")) # Single path-like expect_silent(textpathGrob(label = "Hello", x = 0:1, y = 0:1, id = c(1, 1))) # Multiple point-like expect_silent(textpathGrob(label = c("Hello", "World"), x = c(1, 2), y = c(1, 2), id = c(1, 2))) # Multiple path-like expect_silent(textpathGrob(label = c("Hello", "World"), x = c(0, 1, 1.5, 2), y = c(0, 1, 2, 1), id = c(1, 1, 2, 2))) # Mixed points and paths expect_silent(textpathGrob(label = c("Hello", "World", "lorem", "ipsum"), x = c(0, 1, 1.5, 2, 3, 4), y = c(0, 1, 2, 1, 3, 4), id = c(1, 1, 2, 2, 3, 4))) # Mixed points and paths with angles and polar parameters expect_silent(makeContent(textpathGrob(label = c("He", "Wo", "lorem", "ipsu"), x = c(0, 1, 1.5, 2, 3, 4), y = c(0, 1, 2, 1, 3, 4), id = c(1, 1, 2, 2, 3, 4), gp_path = gpar(lty = 1), angle = 0, polar_params = list(x = .5, y = .5, theta = "x")))) # Mixed points and paths with angles and unit polar parameters expect_silent({ a <- textpathGrob(label = c("Hello", "World", "lorem", "ipsu"), x = c(0, 1, 1.5, 2, 3, 4), y = c(0, 1, 2, 1, 3, 4), id = c(1, 1, 2, 2, 3, 4), gp_path = gpar(lty = 1), angle = 0, polar_params = list(x = unit(.5, "in"), y = unit(.5, "in"), theta = "x")); makeContent(a) }) # Plotmath expression with point-like path expect_silent(textpathGrob(label = expression(paste("y = ", x^2)))) # Plotmath expressions with paths expect_silent(textpathGrob(label = c(expression(paste("y = ", x^2)), expression(paste("x = ", y^2))), x = c(0, 1, 0, 1), y = c(0, 1, 0, 0.5), id = c(1, 1, 2, 2))) # Error should be thrown with invalid input expect_error(textpathGrob(label = c("Hello", "World", "lorem", "ipsum"), x = c(0, 1, 1.5, 2, 3, 4), y = c(0, 1, 2, 1, 3, 4), id = c(1, 1, 2, 3, 4), angle = 0, polar_params = list(x = .5, y = .5, theta = "x")), "not of the same length") # Textpath grobs without a textpath member produce a zeroGrob b <- textpathGrob("b") b$textpath <- NULL res <- makeContent(b) expect_equal(class(res), c("zeroGrob", "grob", "gDesc")) }) test_that("We can correctly pathify points", { data <- data.frame(x = 0.75, y = 0.2, id = 1) # linear pathify linear <- pathify(data, hjust = 0.5, angle = 45, width = 1) # Polar pathify polar <- pathify(data, hjust = 0.5, angle = 45, width = 1, polar_x = 0.5, polar_y = 0.5, thet = "y") expect_equal(nrow(linear), 100L) expect_equal(nrow(polar), 100L) expect_true(abs(polar$x[1] - 0.2290784) < 1e-6) expect_true(abs(linear$x[1] - 0.3964466) < 1e-6) }) test_that("We can remove strings the path is too short to support", { x <- unit(c(1, 1.5), "in") y <- unit(c(1, 1), "in") z <- "There is no way this label should fit in half an inch" g1 <- textpathGrob(z, x, y, id = c(1, 1), remove_long = TRUE) p1 <- makeContent(g1) g2 <- textpathGrob(z, x, y, id = c(1, 1), remove_long = FALSE) p2 <- makeContent(g2) expect_equal(class(p1$children[[1]])[1], "polyline") expect_equal(class(p2$children[[1]])[1], "text") }) test_that("We can add to default gpar", { expect_equal(gp_fill_defaults(gpar(size = 5))$size, 5L) expect_equal(gp_fill_defaults(gpar(size = 5), smell = 6)$smell, 6L) }) # Rich text --------------------------------------------------------------- test_that("label can be missing", { case <- textpathGrob(x = c(0, 1), y = c(0, 1), id = c(1, 1), rich = TRUE) ctrl <- textpathGrob(x = c(0, 1), y = c(0, 1), id = c(1, 1), rich = TRUE, label = "ABC") expect_null(case$textpath) expect_type(ctrl$textpath, "list") case <- makeContent(case) ctrl <- makeContent(ctrl) expect_s3_class(case, "zeroGrob") expect_s3_class(ctrl, "gTree") test <- textpathGrob( x = c(0, 1), y = c(0, 1), id = c(1, 1), label = "ABC", polar_params = list(x = 0.5, y = 0.5), rich = TRUE ) ppar <- test$textpath$params$polar_params expect_equal(convertUnit(ppar$x, "npc", valueOnly = TRUE), 0.5) expect_equal(convertUnit(ppar$y, "npc", valueOnly = TRUE), 0.5) expect_equal(test$textpath$label[[1]]$glyph, c("A", "B", "C")) expect_equal(test$textpath$gp_text$font, c(3, 1, 2)) }) test_that("richt text parsing works as expected", { gp <- gp_fill_defaults(gpar(), fontface = "plain") label <- "italicbold" test <- parse_richtext(label, gpar()) expect_equal(test$text, c("italic", "bold")) expect_equal(test$font, c(3, 2)) label <- "my text here" test <- substitute(parse_richtext(label, gpar())) expect_error(eval(test), "limited number of tags") lab <- "Test" test <- parse_richtext(lab, gp) expect_equal(test$fontfamily, "mono") expect_equal(test$fontsize, 15) expect_equal(test$col, "blue") }) test_that("fontfaces are combined correctly", { # Note 1 = plain, 2 = bold, 3 = italic, 4 = bold.italic label <- "ABCD" test <- parse_richtext(label, gpar(fontface = "plain")) expect_equal(test$font, c(3, 1, 2, 4)) test <- parse_richtext(label, gpar(fontface = "italic")) expect_equal(test$font, c(3, 3, 4, 4)) test <- parse_richtext(label, gpar(fontface = "bold")) expect_equal(test$font, c(4, 2, 2, 4)) test <- parse_richtext(label, gpar(fontface = "bold.italic")) expect_equal(test$font, c(4, 4, 4, 4)) }) test_that("unit vjust works", { case <- textpathGrob(x = c(0, 1), y = c(0, 1), id = c(1, 1), rich = TRUE, label = "ABC", vjust = unit(1, "cm")) ctrl <- textpathGrob(x = c(0, 1), y = c(0, 1), id = c(1, 1), rich = TRUE, label = "ABC", vjust = 0) case <- attr(case$textpath$label[[1]], "offset") ctrl <- attr(ctrl$textpath$label[[1]], "offset") expect_s3_class(case, "unit") expect_type(ctrl, "double") }) # These tests are mostly to hit the coverage test_that("setup_context fills defaults", { ctxt <- setup_context() expect_s3_class(ctxt$gp, "gpar") expect_type(ctxt$yoff, "double") }) test_that("css is parsed", { test <- parse_css("''") expect_equal(test, list()) test <- parse_css("") expect_null(test) test <- parse_css("font-family:mono") expect_equal(test, list(`font-family` = "mono")) test <- parse_css("color:blue;font-family:mono") expect_equal(test, list(color = "blue", `font-family` = "mono")) u <- c("1px", "1in", "1cm", "1mm") u <- lapply(u, function(i) convert_css_unit_pt(i)) expect_equal(u, list(0.75, 72, 28.3, 2.8), tolerance = 0.1) err <- substitute(convert_css_unit_pt("1nonsense")) expect_error(eval(err), "Cannot convert") err <- substitute(convert_css_unit_pt("")) expect_error(eval(err), "valid CSS unit") })