The R Project SVN R

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)))

## Text returns a bounding box if closed is TRUE
coords <- grobCoords(textGrob("test", 0, 0, just=c("left", "bottom")),
                     closed=TRUE)
w <- convertWidth(stringWidth("test"), "in", valueOnly=TRUE)
h <- convertHeight(stringHeight("test"), "in", valueOnly=TRUE)
check(coords[[1]], list(x=c(0, 0, w, w), y=c(0, h, h, 0)))
      
coords <- grobCoords(textGrob("test"), closed=FALSE)
check(coords, emptyCoords)

## All 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)