| library(grid) |
| |
| ## Tests for grobCoords() |
| |
| check <- function(coords, model) { |
| stopifnot(isTRUE(all.equal(as.numeric(coords$x), model$x)) && |
| isTRUE(all.equal(as.numeric(coords$y), model$y))) |
| } |
| |
| ## Simple primitive |
| coords <- grobCoords(rectGrob(0, 0, 1, 1, |
| just=c("left", "bottom"), |
| default.units="in"), |
| closed=TRUE) |
| check(coords[[1]], list(x=c(0, 0, 1, 1), y=c(0, 1, 1, 0))) |
| |
| ## Primitives that generate more points than grob description |
| coords <- grobCoords(circleGrob(0, 0, r=unit(1, "in")), n=4, |
| closed=TRUE) |
| check(coords[[1]], list(x=c(1, 0, -1, 0), y=c(0, 1, 0, -1))) |
| |
| coords <- grobCoords(xsplineGrob(c(0, 1, 2), c(0, 1, 0), |
| default.units="in"), |
| closed=FALSE) |
| check(coords[[1]], list(x=c(0, 1, 2), y=c(0, 1, 0))) |
| |
| ## grob with 'id' |
| coords <- grobCoords(polylineGrob(1:4, 1:4, |
| id=rep(1:2, each=2), |
| default.units="in"), |
| closed=FALSE) |
| check(coords[[1]], list(x=1:2, y=1:2)) |
| check(coords[[2]], list(x=3:4, y=3:4)) |
| |
| ## grob with 'pathId' |
| coords <- grobCoords(pathGrob(c(0, 0, 3, 3, 1, 1, 2, 2, 4, 4, 7, 7, 5, 5, 6, 6), |
| c(0, 3, 3, 0, 1, 2, 2, 1, 4, 7, 7, 4, 5, 6, 6, 5), |
| id=rep(rep(1:2, each=4), 2), |
| pathId=rep(1:2, each=8), |
| default.units="in"), |
| closed=TRUE) |
| check(coords[[1]], list(x=c(0, 0, 3, 3), y=c(0, 3, 3, 0))) |
| check(coords[[2]], list(x=c(1, 1, 2, 2), y=c(1, 2, 2, 1))) |
| check(coords[[3]], list(x=c(4, 4, 7, 7), y=c(4, 7, 7, 4))) |
| check(coords[[4]], list(x=c(5, 5, 6, 6), y=c(5, 6, 6, 5))) |
| |
| ## Mostly testing makeContent() |
| coords <- grobCoords(bezierGrob(c(0, 1, 2, 3), c(0, 1, 2, 3), |
| default.units="in"), |
| closed=FALSE) |
| coords <- lapply(coords[[1]], function(x) { x[c(1, length(x))] }) |
| check(coords, list(x=c(0, 3), y=c(0, 3))) |
| |
| ## All emptyCoords |
| coords <- grobCoords(textGrob("test")) |
| check(coords, emptyCoords) |
| |
| coords <- grobCoords(moveToGrob()) |
| check(coords, emptyCoords) |
| |
| coords <- grobCoords(lineToGrob()) |
| check(coords, emptyCoords) |
| |
| coords <- grobCoords(nullGrob()) |
| check(coords, emptyCoords) |
| |
| coords <- grobCoords(clipGrob()) |
| check(coords, emptyCoords) |
| |
| coords <- grobCoords(rasterGrob(matrix(1))) |
| check(coords, emptyCoords) |
| |