test_that("label can be missing", {
case <- textpathGrob(x = c(0, 1), y = c(0, 1), id = c(1, 1), as_label = TRUE)
ctrl <- textpathGrob(x = c(0, 1), y = c(0, 1), id = c(1, 1), label = "ABC",
as_label = TRUE)
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 that polar parameters are converted
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), as_label = 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)
})
test_that("straight and curved setting produce similar boxes", {
pth <- textpathGrob(
"ABC",
x = c(0, 1),
y = c(0, 1),
id = c(1, 1),
gp_box = gpar(fill = "white"),
as_label = TRUE
)
pth <- makeContent(pth)
box1 <- pth$children[[2]]
pth <- textpathGrob(
"ABC",
x = c(0, 1),
y = c(0, 1),
id = c(1, 1),
gp_box = gpar(fill = "white"),
straight = TRUE,
as_label = TRUE
)
pth <- makeContent(pth)
box2 <- pth$children[[2]]
x1 <- as_inch(box1$x)
x2 <- as_inch(box2$x)
expect_lt(sum(abs(x1 - x2)), 2)
y1 <- as_inch(box1$y)
y2 <- as_inch(box2$y)
expect_lt(sum(abs(y1 - y2)), 2)
})
test_that("radius is shrunk when needed", {
pth <- textpathGrob(
"ABC",
x = c(2.5, 7.5),
y = c(5, 5),
id = c(1, 1),
gp_box = gpar(fill = "white"),
default.units = "in",
label.r = unit(0.1, "inch"),
label.padding = unit(0, "inch"),
as_label = TRUE
)
attr(pth$textpath$label[[1]], "metrics")$height <- 0.2
pth <- makeContent(pth)
box1 <- pth$children[[2]]
pth <- textpathGrob(
"ABC",
x = c(2.5, 7.5),
y = c(5, 5),
id = c(1, 1),
gp_box = gpar(fill = "white"),
default.units = "in",
label.r = unit(1, "inch"),
label.padding = unit(0, "inch"),
as_label = TRUE
)
attr(pth$textpath$label[[1]], "metrics")$height <- 0.2
pth <- makeContent(pth)
box2 <- pth$children[[2]]
expect_equal(as_inch(box1$x), as_inch(box2$x), tolerance = 1e-4)
expect_equal(as_inch(box1$y), as_inch(box2$y), tolerance = 1e-4)
})
test_that("straight richtext is similar to richtext on straight path", {
labels <- c(
"ABC",
"D\nE
F"
)
x <- c(0, 1, 0, 1)
y <- c(0, 1, 1, 0)
id <- c(1, 1, 2, 2)
ctrl <- textpathGrob(x = x, y = y, id = id,
label = labels, rich = TRUE,
default.units = "inch", as_label = TRUE)
case <- textpathGrob(x = x, y = y, id = id,
label = labels, rich = TRUE, straight = TRUE,
default.units = "inch", as_label = TRUE)
ctrl <- makeContent(ctrl)$children[[2]]
case <- makeContent(case)$children[[2]]
expect_equal(ctrl$gp, case$gp)
expect_equal(ctrl$x, case$x, tolerance = 0.05)
expect_equal(ctrl$y, case$y, tolerance = 0.05)
expect_equal(ctrl$label, case$label)
})
test_that("We can set blank lines", {
gp <- data_to_path_gp(data.frame(linetype = NA))
expect_equal(gp$lty, 0)
})
test_that("We can remove labels too long for the path to support", {
grob <- textpathGrob(label = "A label that is too long for its path",
x = c(0.45, 0.55), y = c(0.5, 0.5), id = c(1, 1),
default.units = "npc", remove_long = TRUE,
as_label = TRUE)
grob <- makeContent(grob)
expect_equal(class(grob$children[[1]])[1], "polyline")
})