library(grid)

HersheyLabel <- function(x, y=unit(.5, "npc")) {
    lines <- strsplit(x, "\n")[[1]]
    if (!is.unit(y))
        y <- unit(y, "npc")
    n <- length(lines)
    if (n > 1) {
        y <- y + unit(rev(seq(n)) - mean(seq(n)), "lines")
    }
    grid.text(lines, y=y, gp=gpar(fontfamily="HersheySans"))
}

devMask <- function(aMask, lMask) {
    support <- dev.capabilities()$masks
    if (is.character(support)) {
        if ("alpha" %in% support) {
            aMask
        } else {
            if ("luminance" %in% support) {
                as.mask(lMask, type="luminance")
            } else {
                FALSE
            }
        }
    } else {
        FALSE
    }
}

################################################################################
## Gradients

## Simple linear gradient on grob
grid.newpage()
grid.rect(gp=gpar(fill=linearGradient()))
HersheyLabel("default linear gradient
black bottom-left to white top-right")

## Test linearGradient() arguments
grid.newpage()
grid.rect(gp=gpar(fill=linearGradient(c("red", "yellow", "red"),
                                      c(0, .5, 1),
                                      x1=.5, y1=unit(1, "in"), 
                                      x2=.5, y2=1,
                                      extend="none")))
HersheyLabel("vertical linear gradient
1 inch from bottom
red-yellow-red")

## Gradient relative to grob
grid.newpage()
grid.rect(width=.5, height=.5,
          gp=gpar(fill=linearGradient()))
HersheyLabel("gradient on rect
black bottom-left to white top-right OF RECT")

## Gradient on viewport
grid.newpage()
pushViewport(viewport(gp=gpar(fill=linearGradient())))
grid.rect()
HersheyLabel("default linear gradient on viewport
black bottom-left to white top-right")

## Gradient relative to viewport
grid.newpage()
pushViewport(viewport(gp=gpar(fill=linearGradient())))
grid.rect(width=.5, height=.5)
HersheyLabel("linear gradient on viewport
viewport whole page
rect half height/width
darker grey (not black) bottom-left OF RECT
lighter grey (not white) top-right OF RECT")

grid.newpage()
pushViewport(viewport(width=.5, height=.5, gp=gpar(fill=linearGradient())))
grid.rect()
HersheyLabel("linear gradient on viewport
viewport half height/width
rect whole viewport
black bottom-left to white top-right OF RECT")

## Inherited gradient on viewport
## (should be relative to first, larger viewport)
grid.newpage()
pushViewport(viewport(gp=gpar(fill=linearGradient())))
pushViewport(viewport(width=.5, height=.5))
grid.rect()
HersheyLabel("gradient on viewport
viewport whole page
nested viewport half height/width
rect whole viewport
darker grey (not black) bottom-left OF RECT
lighter grey (not white) top-right OF RECT")

## Restore of gradient (just like any other gpar)
grid.newpage()
pushViewport(viewport(gp=gpar(fill=linearGradient())))
grid.rect(x=.2, width=.2, height=.5)
pushViewport(viewport(gp=gpar(fill="green")))
grid.rect(x=.5, width=.2, height=.5)
popViewport()
grid.rect(x=.8, width=.2, height=.5)
HersheyLabel("gradient on viewport
viewport whole page
rect left third (gradient from whole page)
nested viewport whole page
nested viewport green fill
rect centre (green)
pop to first viewport
rect right third (gradient from whole page)")

## Translucent gradient
grid.newpage()
grid.text("Reveal", gp=gpar(fontfamily="HersheySans",
                            fontface="bold", cex=3))
grid.rect(gp=gpar(fill=linearGradient(c("white", "transparent"),
                                      x1=.4, x2=.6, y1=.5, y2=.5)))
HersheyLabel("gradient from white to transparent
over text", y=.1)

## Radial gradient
grid.newpage()
grid.rect(gp=gpar(fill=radialGradient()))
HersheyLabel("default radial gradient
black centre to white radius", y=.1)

## Test radialGradient() arguments
grid.newpage()
grid.rect(gp=gpar(fill=radialGradient(c("white", "black"),
                                      cx1=.8, cy1=.8)))    
HersheyLabel("radial gradient
white to black
start centre top-right")

## Gradient on a gTree
grid.newpage()
grid.draw(gTree(children=gList(rectGrob(gp=gpar(fill=linearGradient())))))
HersheyLabel("gTree with rect child
gradient on rect
black bottom-left to white top-right")

grid.newpage()
grid.draw(gTree(children=gList(rectGrob()), gp=gpar(fill=linearGradient())))
HersheyLabel("gTree with rect child
gradient on gTree
black bottom-left to white top-right")

## Rotated gradient
grid.newpage()
pushViewport(viewport(width=.5, height=.5, angle=45,
                      gp=gpar(fill=linearGradient())))
grid.rect()
HersheyLabel("rotated gradient
black bottom-left to white top-right OF RECT")

######################################
## Tests of replaying graphics engine display list

## Resize graphics device
grid.newpage()
grid.rect(gp=gpar(fill=linearGradient()))
HersheyLabel("default gradient
(for resizing)
black bottom-left to white top-right")

grid.newpage()
pushViewport(viewport(gp=gpar(fill=linearGradient())))
grid.rect()
HersheyLabel("gradient on viewport
(for resizing)
black bottom-left to white top-right")

## Copy to new graphics device
grid.newpage()
grid.rect(gp=gpar(fill=linearGradient()))
x <- recordPlot()
HersheyLabel("default gradient
for recordPlot()
black bottom-left to white top-right")
replayPlot(x)
HersheyLabel("default gradient
from replayPlot()
black bottom-left to white top-right")
## (Resize that as well if you like)

grid.newpage()
pushViewport(viewport(gp=gpar(fill=linearGradient())))
grid.rect()
x <- recordPlot()
HersheyLabel("gradient on viewport
for recordPlot()
black bottom-left to white top-right")
replayPlot(x)
HersheyLabel("gradient on viewport
from replayPlot()
black bottom-left to white top-right")

## Replay on new device with gradient already defined
## (watch out for recorded grob using existing gradient)
grid.newpage()
grid.rect(gp=gpar(fill=linearGradient()))
x <- recordPlot()
HersheyLabel("default gradient
for recordPlot()
black bottom-left to white top-right")
grid.newpage()
grid.rect(gp=gpar(fill=linearGradient(c("white", "red"))))
HersheyLabel("new rect with new gradient")
replayPlot(x)
HersheyLabel("default gradient
from replayPlot()
AFTER white-red gradient
(should be default gradient)")

## Similar to previous, except involving viewports
grid.newpage()
pushViewport(viewport(gp=gpar(fill=linearGradient())))
grid.rect()
x <- recordPlot()
HersheyLabel("gradient on viewport
for recordPlot()")
grid.newpage()
pushViewport(viewport(gp=gpar(fill=linearGradient(c("white", "red")))))
grid.rect()
HersheyLabel("new viewport with new gradient")
replayPlot(x)
HersheyLabel("gradient on viewport
from replayPlot()
AFTER white-red gradient
(should be default gradient)")

######################################
## Test of 'grid' display list

grid.newpage()
grid.rect(name="r")
HersheyLabel("empty rect")
grid.edit("r", gp=gpar(fill=linearGradient()))
HersheyLabel("edited rect
to add gradient", y=.1)

grid.newpage()
grid.rect(gp=gpar(fill=linearGradient()))
HersheyLabel("rect with gradient
(for grab)")
x <- grid.grab()
grid.newpage()
grid.draw(x)
HersheyLabel("default gradient
from grid.grab()")

grid.newpage()
pushViewport(viewport(width=.5, height=.5, gp=gpar(fill=linearGradient())))
grid.rect()
HersheyLabel("gradient on viewport
viewport half height/width
for grid.grab")
x <- grid.grab()
grid.newpage()
grid.draw(x)
HersheyLabel("gradient on viewport
viewport half height/width
from grid.grab")

######################################
## Tests of "efficiency"
## (are patterns being resolved only as necessary)

## 
trace(grid:::resolveFill.GridPattern, print=FALSE,
      function(...) cat("*** RESOLVE:  Viewport pattern resolved\n"))
trace(grid:::resolveFill.GridGrobPattern, print=FALSE,
      function(...) cat("*** RESOLVE:  Grob pattern resolved\n"))

## ONCE for rect grob
traceHead <- "ONE resolve for rect grob with gradient"
grid.newpage()
traceOutput <- capture.output(grid.rect(gp=gpar(fill=linearGradient())))
HersheyLabel("default gradient
for tracing", y=.9)
HersheyLabel(paste(traceHead, paste(traceOutput, collapse="\n"), sep="\n"))


## ONCE for multiple rects from single grob
traceHead <- "ONE resolve for multiple rects from rect grob with gradient"
grid.newpage()
traceOutput <- capture.output(grid.rect(x=1:5/6, y=1:5/6, width=1/8, height=1/8,
                                        gp=gpar(fill=linearGradient())))
HersheyLabel("gradient on five rects
for tracing", y=.9)
HersheyLabel(paste(traceHead, paste(traceOutput, collapse="\n"), sep="\n"))

## ONCE for viewport with rect
traceHead <- "ONE resolve for rect grob in viewport with gradient"
grid.newpage()
traceOutput <- capture.output({
    pushViewport(viewport(width=.5, height=.5, gp=gpar(fill=linearGradient())))
    grid.rect()
})
HersheyLabel("gradient on viewport
viewport half height/width
for tracing", y=.8)
HersheyLabel(paste(traceHead, paste(traceOutput, collapse="\n"), sep="\n"))

## ONCE for viewport with rect, revisiting multiple times
traceHead <- "ONE resolve for rect grob in viewport with gradient\nplus nested viewport\nplus viewport revisited"
grid.newpage()
traceOutput <- capture.output({
    pushViewport(viewport(width=.5, height=.5, gp=gpar(fill=linearGradient()),
                          name="vp"))
    grid.rect(gp=gpar(lwd=8))
    pushViewport(viewport(width=.5, height=.5))
    grid.rect()
    upViewport()
    grid.rect(gp=gpar(col="red", lwd=4))
    upViewport()
    downViewport("vp")
    grid.rect(gp=gpar(col="blue", lwd=2))
})
HersheyLabel("gradient on viewport
viewport half width/height
rect (thick black border)
nested viewport (inherits gradient)
rect (medium red border)
navigate to original viewport
rect (thin blue border)", y=.9)
HersheyLabel(paste(traceHead, paste(traceOutput, collapse="\n"), sep="\n"))

untrace(grid:::resolveFill.GridPattern)
untrace(grid:::resolveFill.GridGrobPattern)

################################################################################
## Grob-based patterns

## Simple circle grob as pattern in rect
grid.newpage()
grid.rect(gp=gpar(fill=pattern(circleGrob(gp=gpar(fill="grey")))))
HersheyLabel("single grey filled circle pattern")

## Multiple circles as pattern in rect
grid.newpage()
pat <- circleGrob(1:3/4, r=unit(1, "cm"))
grid.rect(gp=gpar(fill=pattern(pat)))
HersheyLabel("three unfilled circles pattern")

## Pattern on rect scales with rect
grid.newpage()
grid.rect(width=.5, height=.8, gp=gpar(fill=pattern(pat)))
HersheyLabel("pattern on rect scales with rect")

## Pattern on viewport
grid.newpage()
pushViewport(viewport(gp=gpar(fill=pattern(pat))))
grid.rect()
HersheyLabel("pattern on viewport
applied to rect")

## Pattern on viewport stays fixed for rect
grid.newpage()
pushViewport(viewport(gp=gpar(fill=pattern(pat))))
grid.rect(width=.5, height=.8)
HersheyLabel("pattern on viewport
applied to rect
pattern does not scale with rect")

## Patterns have colour
grid.newpage()
pat <- circleGrob(1:3/4, r=unit(1, "cm"),
                  gp=gpar(fill=c("red", "green", "blue")))
grid.rect(gp=gpar(fill=pattern(pat)))
HersheyLabel("pattern with colour")

## Pattern with gradient
grid.newpage()
pat <- circleGrob(1:3/4, r=unit(1, "cm"),
                  gp=gpar(fill=linearGradient()))
grid.rect(gp=gpar(fill=pattern(pat)))
HersheyLabel("pattern with gradient")

## Pattern with a clipping path
grid.newpage()
pat <- circleGrob(1:3/4, r=unit(1, "cm"),
                  vp=viewport(clip=rectGrob(height=unit(1, "cm"))),
                  gp=gpar(fill=linearGradient()))
grid.rect(gp=gpar(fill=pattern(pat)))
HersheyLabel("pattern with clipping path
and gradient")

## Tiling patterns
grid.newpage()
grob <- circleGrob(r=unit(2, "mm"),
                   gp=gpar(col=NA, fill="grey"))
pat <- pattern(grob,
               width=unit(5, "mm"),
               height=unit(5, "mm"),
               extend="repeat")
grid.rect(gp=gpar(fill=pat))
HersheyLabel("pattern that tiles page")

grid.newpage()
pushViewport(viewport(gp=gpar(fill=pat)))
grid.rect(width=.5)
HersheyLabel("pattern that fills viewport
but only drawn within rectangle
pattern relative to viewport")

grid.newpage()
grob <- circleGrob(x=0, y=0, r=unit(2, "mm"),
                   gp=gpar(col=NA, fill="grey"))
pat <- pattern(grob,
               x=0, y=0, 
               width=unit(5, "mm"),
               height=unit(5, "mm"),
               extend="repeat")
grid.rect(width=.5, gp=gpar(fill=pat))
HersheyLabel("pattern as big as the viewport
but only drawn within rectangle
pattern relative to rectangle
(starts at bottom left of rectangle)")

## More tests
grid.newpage()
grid.circle(gp=gpar(fill=linearGradient(y1=.5, y2=.5)))
HersheyLabel("circle with horizontal gradient
black left to white right")

grid.newpage()
grid.polygon(c(.2, .8, .7, .5, .3),
             c(.8, .8, .2, .4, .2),
             gp=gpar(fill=linearGradient(y1=.5, y2=.5)))
HersheyLabel("polygon with horizontal gradient
black left to white right")

grid.newpage()
grid.path(c(.2, .8, .3, .5, .7),
          c(.8, .8, .2, .4, .2),
          gp=gpar(fill=linearGradient(y1=.5, y2=.5)))
HersheyLabel("path with horizontal gradient
black left to white right")

grid.newpage()
grid.text("Reveal", gp=gpar(fontfamily="HersheySans",
                            fontface="bold", cex=3))
grid.rect(gp=gpar(col=NA,
                  fill=radialGradient(c("white", "transparent"),
                                      r2=.3)))
HersheyLabel("text with semitransparent radial gradient
centre of text should be dissolved", y=.2)

grid.newpage()
pat <-
    pattern(circleGrob(gp=gpar(col=NA, fill="grey"),
                       vp=viewport(width=.2, height=.2,
                                   mask=devMask(rectGrob(x=c(1, 3)/4,
                                                         width=.3,
                                                         gp=gpar(fill="black")),
                                                rectGrob(x=c(1, 3)/4,
                                                         width=.3,
                                                         gp=gpar(col="white",
                                                                 fill="white"))))),
            width=1/4, height=1/4,
            extend="repeat")
grid.rect(width=.5, height=.5, gp=gpar(fill=pat))
HersheyLabel("rect in centre with pattern fill
pattern is circle drawn in smaller viewport
pattern is masked by two tall thin rects
pattern repeats", y=.15)

grid.newpage()
pat1 <-
    pattern(circleGrob(r=.1, gp=gpar(col="black", fill="grey")),
            width=.2, height=.2,
            extend="repeat")
pat2 <-
    pattern(circleGrob(r=1/4, gp=gpar(col="black", fill=pat1)),
            width=1/2, height=1/2,
            extend="repeat")
grid.rect(width=.5, height=.5, gp=gpar(fill=pat2))
HersheyLabel("rect in centre with pattern fill
pattern is small circle with pattern fill
nested pattern is smaller circle (grey)
both patterns repeat", y=.15)

######################################
## Test for expanding pattern resources
grid.newpage()
for (i in 1:21) {
    grid.rect(gp=gpar(fill=linearGradient()))
    HersheyLabel(paste0("rect ", i, " with gradient
pattern released every time"))
}

grid.newpage()
for (i in 1:65) {
    pushViewport(viewport(gp=gpar(fill=linearGradient())))
    grid.rect()
    HersheyLabel(paste0("viewport ", i, " with gradient
new pattern every time"))
}

grid.newpage()
for (i in 1:21) {
    grid.rect(gp=gpar(fill=linearGradient()))
    HersheyLabel(paste0("rect ", i, " with gradient
AFTER grid.newpage()
pattern released every time"))
}

####################################
## Additional tests

## gTree with gradient fill
grid.newpage()
gt <- gTree(children=gList(circleGrob(1:2/3, r=.1)),
            gp=gpar(fill=linearGradient(y1=.5, y2=.5)))
grid.draw(gt)
HersheyLabel("gTree with circles as children
gTree has gradient fill
gradient relative to circle bounds
(black at left to white at right)", y=.8)

## gTree with gradient fill with gTree 
grid.newpage()
gt <- gTree(children=gList(gTree(children=gList(circleGrob(1:2/3, r=.1)))),
            gp=gpar(fill=linearGradient(y1=.5, y2=.5)))
grid.draw(gt)
HersheyLabel("gTree with gTree as child
inner gTree has circles as children
outer gTree has gradient fill
gradient relative to circle bounds
(black at left to white at right)", y=.8)

## Pattern including text
grid.newpage()
pat <- pattern(textGrob("test"),
               width=1.2*stringWidth("test"),
               height=unit(1, "lines"),
               extend="repeat")
grid.circle(r=.3, gp=gpar(fill=pat))
HersheyLabel("circle filled with pattern
pattern based on (repeating) text", y=.9)

## Text (path) filled with pattern
grid.newpage()
rects <- gTree(children=gList(rectGrob(width=unit(2, "mm"),
                                       height=unit(2, "mm"),
                                       just=c("left", "bottom"),
                                       gp=gpar(fill="black")),
                              rectGrob(width=unit(2, "mm"),
                                       height=unit(2, "mm"),
                                       just=c("right", "top"),
                                       gp=gpar(fill="black"))))
checkerBoard <- pattern(rects,
                        width=unit(4, "mm"), height=unit(4, "mm"),
                        extend="repeat")
grid.fill(textGrob("test", gp=gpar(fontface="bold", cex=10)),
          gp=gpar(fill=checkerBoard))
HersheyLabel("stroked path based on text
filled with checkerboard pattern", y=.8)
    
## Pattern including raster
grid.newpage()
rg <- rasterGrob(matrix(c(0:1, 1:0), nrow=2),
                 width=unit(1, "cm"), height=unit(1, "cm"),
                 interpolate=FALSE)
pat <- pattern(rg, 
               width=unit(1, "cm"), height=unit(1, "cm"),
               extend="repeat")
grid.circle(r=.2, gp=gpar(fill=pat))
HersheyLabel("circle filled with pattern
pattern is based on raster (checkerboard)", y=.8)

## Radial gradient where start circle and final circle overlap
grid.newpage()
x1 <- .7
y1 <- .7
r1 <- .2
x2 <- .4
y2 <- .4
r2 <- .4
grid.circle(x1, y1, r=r1, gp=gpar(col="green", fill=NA, lwd=2))
grid.circle(x2, y2, r=r2, gp=gpar(col="red", fill=NA, lwd=2))
grid.rect(gp=gpar(fill=radialGradient(rgb(0:1, 1:0, 0, .5),
                                      cx1=x1, cy1=y1, r1=r1,
                                      cx2=x2, cy2=y2, r2=r2)))
HersheyLabel("radial gradient with overlapping start and final circles
gradient is from semitransparent green
to semitransparent red
start circle is green
final circle is red")

## Text (path) filled with pattern
grid.newpage()
grid.fill(textGrob("test", gp=gpar(fontface="bold", cex=10)),
          gp=gpar(fill=linearGradient(2:3)))
HersheyLabel("stroked path based on text
filled with linear gradient", y=.8)
    
################################################################################
## Points

## Points filled with gradient
grid.newpage()
grid.points(1:9/10, 1:9/10, default.units="npc",
            pch=21, gp=gpar(fill=linearGradient()))
HersheyLabel("points (pch=21)
filled with linear gradient
(gradient based on ALL points)", y=.8)

## Points filled with gradient (point not filled)
grid.newpage()
grid.points(1:9/10, 1:9/10, default.units="npc",
            pch=1, gp=gpar(fill=linearGradient()))
HersheyLabel("points (pch=1)
filled with linear gradient
(fill ignored)", y=.8)

## Individual points filled with gradient (gradient recycled)
grid.newpage()
grid.points(1:3/4, 1:3/4, default.units="npc",
            pch=21, gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("points (pch=21)
filled with linear gradient
(gradient based on EACH point)", y=.8)

## Individual points filled with individual gradients
grid.newpage()
gradients <- lapply(2:4, function(x) linearGradient(c(x, "white"), group=FALSE))
grid.points(1:3/4, 1:3/4, default.units="npc",
            pch=21, gp=gpar(fill=gradients))
HersheyLabel("points (pch=21)
filled with linear gradient
(different gradient for EACH point)", y=.8)

## points inheriting single gradient
grid.newpage()
pushViewport(viewport(gp=gpar(fill=linearGradient())))
grid.points(1:2, 1:2, default.units="in", pch=21)
HersheyLabel("points (pch=21)
filled with linear gradient
gradient inherited from viewport
(so gradient relative to viewport)")

## points inheriting multiple gradients
grid.newpage()
pushViewport(viewport(gp=gpar(fill=list(linearGradient(1:2),
                                        radialGradient(3:4)))))
grid.points(1:2, 1:2, default.units="in", pch=21)
HersheyLabel("points (pch=21)
filled with multiple linear gradients
gradients inherited from viewport
(so gradients relative to viewport)")

## points recycling inherited multiple gradients
grid.newpage()
pushViewport(viewport(gp=gpar(fill=list(linearGradient(1:2),
                                        radialGradient(3:4)))))
grid.points(1:9/10, 1:9/10, default.units="npc", pch=21)
HersheyLabel("points (pch=21)
filled with linear gradients
gradients inherited from viewport
(so gradient relative to viewport)
more points than gradients
(so gradients recycled)")

## points recycling inherited multiple gradients with group=FALSE
## so pattern just passed through and resolved relative to points grob
grid.newpage()
pushViewport(viewport(gp=gpar(fill=list(linearGradient(1:2, group=FALSE),
                                        radialGradient(3:4, group=FALSE)))))
grid.points(1:9/10, 1:9/10, default.units="npc", pch=21)
HersheyLabel("points (pch=21)
filled with linear gradients
group=FALSE
gradients inherited from viewport
(but unresolved so resolved on EACH point)
more points than gradients
(so gradients recycled)")

## Using tracing to check that fills are not being resolved more than necessary
trace(grid:::resolveFill.GridPattern, print=FALSE,
      function(...) cat("*** RESOLVE:  Viewport pattern resolved\n"))
trace(grid:::resolveFill.GridPatternList, print=FALSE,
      function(...) cat("*** RESOLVE:  Viewport pattern list resolved\n"))
trace(grid:::resolveFill.GridGrobPattern, print=FALSE,
      function(...) cat("*** RESOLVE:  Grob pattern resolved\n"))
trace(grid:::resolveFill.GridGrobPatternList, print=FALSE,
      function(...) cat("*** RESOLVE:  Grob pattern list resolved\n"))
doTrace <- function(head, f) {
    traceOutput <- capture.output(f())    
    HersheyLabel(paste(head, paste(traceOutput, collapse="\n"), sep="\n"))
}

grid.newpage()
doTrace("points grob (pch=21)\nwith gradient\nONE resolve",
        function() {
            grid.points(1:9/10, 1:9/10, default.units="npc",
                        pch=21,
                        gp=gpar(fill=linearGradient()))
        })

grid.newpage()
doTrace("points grob (pch=1)\nwith gradient\nONE resolve\n(even though unused)",
        function() {
            grid.points(1:9/10, 1:9/10, default.units="npc",
                        pch=1, gp=gpar(fill=linearGradient()))
        })

grid.newpage()
doTrace("points grob (pch=21)\nwith gradient (group=FALSE)\nTHREE resolves\n(resolve per point)",
        function() {
            grid.points(1:3/4, 1:3/4, default.units="npc",
                        pch=21, gp=gpar(fill=linearGradient(group=FALSE)))
        })

grid.newpage()
gradients <- lapply(2:4, function(x) linearGradient(c(x, "white"), group=FALSE))
doTrace("points grob (pch=21)\nwith gradient list (group=FALSE)\nONE resolve\n(all gradients resolved at once)",
        function() {
            grid.points(1:3/4, 1:3/4, default.units="npc",
                        pch=21, gp=gpar(fill=gradients))
        })

grid.newpage()
doTrace("points grob (pch=21)\nwith inherited gradient\nONE resolve\n(gradient resolved when vp pushed)",
        function() {
            pushViewport(viewport(gp=gpar(fill=linearGradient())))
            grid.points(1:2, 1:2, default.units="in", pch=21)
        })

grid.newpage()
doTrace("points grob (pch=21)\nwith inherited gradient list\nTWO resolves\n(gradient list resolved when vp pushed\nAND gradient list resolved when points drawn\n[no-op because already resolved])",
        function() {
            pushViewport(viewport(gp=gpar(fill=list(linearGradient(1:2),
                                                    radialGradient(3:4)))))
            grid.points(1:2, 1:2, default.units="in", pch=21)
        })

grid.newpage()
doTrace("points grob (pch=21)\nwith inherited gradient list\nAND recycling of gradients\nTWO resolves\n(gradient list resolved when vp pushed\nAND gradient list resolved when points drawn\n[no-op because already resolved])",
        function() {
            pushViewport(viewport(gp=gpar(fill=list(linearGradient(1:2),
                                                    radialGradient(3:4)))))
            grid.points(1:9/10, 1:9/10, default.units="npc", pch=21)
        })

## Individual points filled with individual gradients
## *some* group = TRUE and *some* group = FALSE
grid.newpage()
gradients <- lapply(2:4, function(x) linearGradient(c(x, "white"),
                                                    group = x %% 2))
grid.points(1:3/4, 1:3/4, default.units="npc",
            pch=21, gp=gpar(fill=gradients))
HersheyLabel("points (pch=21)
filled with linear gradient
(different gradient for EACH point)
first and third resolved on individual points
second resolved on ALL points", y=.8)

## Points filled with pattern (recycled), multiple pch
grid.newpage()
grid.points(1:3/4, 1:3/4, default.units="npc",
            pch=21:23, gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("points (pch=21:23)
single gradient (group=FALSE)
each different point gets its own gradient", y=.8)

################################################################################
## Rects
grid.newpage()
grid.rect(x=1:3/4, y=1:3/4, width=.2, height=.2,
          gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("single gradient fill
group = FALSE", y=.8)

grid.newpage()
grid.rect(x=1:3/4, y=1:3/4, width=.2, height=.2,
          gp=gpar(fill=list(linearGradient(group=FALSE),
                            radialGradient(group=FALSE),
                            linearGradient())))
HersheyLabel("list of gradient fills
linear (group=FALSE)
radial (group=FALSE)
linear (group=TRUE)", y=.8)

################################################################################
## Circles
grid.newpage()
grid.circle(x=1:3/4, y=1:3/4, r=.1,
            gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("single gradient fill
group = FALSE", y=.8)

grid.newpage()
grid.circle(x=1:3/4, y=1:3/4, r=.1,
            gp=gpar(fill=list(linearGradient(group=FALSE),
                              radialGradient(group=FALSE),
                              linearGradient())))
HersheyLabel("list of gradient fills
linear (group=FALSE)
radial (group=FALSE)
linear (group=TRUE)", y=.8)

################################################################################
## Polygons
grid.newpage()
grid.polygon(x=c(.2, .4, .3,
                 .4, .6, .5,
                 .6, .8, .7),
             y=c(.2, .2, .4,
                 .4, .4, .6,
                 .6, .6, .8),
             id=rep(1:3, each=3),
             gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("single gradient fill
group = FALSE", y=.8)

grid.newpage()
grid.polygon(x=c(.2, .4, .3,
                 .4, .6, .5,
                 .6, .8, .7),
             y=c(.2, .2, .4,
                 .4, .4, .6,
                 .6, .6, .8),
             id=rep(1:3, each=3),
             gp=gpar(fill=list(linearGradient(group=FALSE),
                               radialGradient(group=FALSE),
                               linearGradient())))
HersheyLabel("list of gradient fills
linear (group=FALSE)
radial (group=FALSE)
linear (group=TRUE)", y=.8)

################################################################################
## Segments
grid.newpage()
grid.segments(x0=c(.2, .4, .6),
              y0=c(.2, .5, .8),
              x1=c(.4, .6, .8),
              y1=c(.2, .5, .8),
              gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("single gradient fill
group = FALSE", y=.8)

grid.newpage()
grid.segments(x0=c(.2, .4, .6),
              y0=c(.2, .5, .8),
              x1=c(.4, .6, .8),
              y1=c(.2, .5, .8),
             gp=gpar(fill=list(linearGradient(group=FALSE),
                               radialGradient(group=FALSE),
                               linearGradient())))
HersheyLabel("list of gradient fills
linear (group=FALSE)
radial (group=FALSE)
linear (group=TRUE)", y=.8)

################################################################################
## Xsplines
grid.newpage()
grid.xspline(x=c(.2, .4, .3,
                 .4, .6, .5,
                 .6, .8, .7),
             y=c(.2, .2, .4,
                 .4, .4, .6,
                 .6, .6, .8),
             id=rep(1:3, each=3),
             shape=-1, open=FALSE,
             gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("single gradient fill
group = FALSE", y=.8)

grid.newpage()
grid.xspline(x=c(.2, .4, .3,
                 .4, .6, .5,
                 .6, .8, .7),
             y=c(.2, .2, .4,
                 .4, .4, .6,
                 .6, .6, .8),
             id=rep(1:3, each=3),
             shape=-1, open=FALSE,
             gp=gpar(fill=list(linearGradient(group=FALSE),
                               radialGradient(group=FALSE),
                               linearGradient())))
HersheyLabel("list of gradient fills
linear (group=FALSE)
radial (group=FALSE)
linear (group=TRUE)", y=.8)

################################################################################
## Lines
##
## NOTE that polylines are handled by same underlying C code
grid.newpage()
grid.lines(x=c(.2, .4, .3),
           y=c(.2, .2, .4),
           gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("single gradient fill
group = FALSE", y=.8)

grid.newpage()
grid.lines(x=c(.2, .4, .3),
           y=c(.2, .2, .4),
           gp=gpar(fill=list(linearGradient(group=FALSE),
                             radialGradient(group=FALSE),
                             linearGradient())))
HersheyLabel("list of gradient fills
linear (group=FALSE)
radial (group=FALSE)
linear (group=TRUE)", y=.8)

################################################################################
## MoveTo/LineTo
grid.newpage()
grid.move.to(x=.2, y=.2)
grid.line.to(x=.4, y=.4,
             gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("single gradient fill
group = FALSE", y=.8)

grid.newpage()
grid.move.to(x=.2, y=.2)
grid.line.to(x=.4, y=.4,
             gp=gpar(fill=list(linearGradient(group=FALSE),
                               radialGradient(group=FALSE),
                               linearGradient())))
HersheyLabel("list of gradient fills
linear (group=FALSE)
radial (group=FALSE)
linear (group=TRUE)", y=.8)

################################################################################
## Paths

## Pattern fill on single path consisting of distinct shapes
grid.newpage()
grid.path(c(.2, .2, .4, .4, .6, .6, .8, .8),
          c(.2, .4, .4, .2, .6, .8, .8, .6),
          id=rep(1:2, each=4),
          gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("single gradient fill
group = FALSE
single path", y=.8)

## Pattern fill on multiple paths, each consisting of distinct shapes
grid.newpage()
grid.path(c(.2, .2, .4, .4,
            .25, .25, .35, .35,
            .6, .6, .8, .8,
            .65, .65, .75, .75),
          c(.2, .4, .4, .2,
            .25, .35, .35, .25,
            .6, .8, .8, .6,
            .65, .75, .75, .65),
          rule="evenodd",
          id=rep(1:4, each=4),
          pathId=rep(1:2, each=8),
          gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("single gradient fill
group = FALSE
multiple paths", y=.8)

## Same thing, list of patterns
grid.newpage()
grid.path(c(.2, .2, .4, .4,
            .25, .25, .35, .35,
            .6, .6, .8, .8,
            .65, .65, .75, .75),
          c(.2, .4, .4, .2,
            .25, .35, .35, .25,
            .6, .8, .8, .6,
            .65, .75, .75, .65),
          rule="evenodd",
          id=rep(1:4, each=4),
          pathId=rep(1:2, each=8),
          gp=gpar(fill=list(linearGradient(group=FALSE),
                            radialGradient(group=FALSE))))
HersheyLabel("mulitple gradient fills
group = FALSE
multiple paths", y=.8)

################################################################################
## Raster
grid.newpage()
grid.raster(matrix(1:4/5, ncol=2),
            interpolate=FALSE,
            width=.5, height=.5,
            gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("single gradient fill
group = FALSE", y=.8)

grid.newpage()
grid.raster(matrix(1:4/5, ncol=2),
            interpolate=FALSE,
            width=.5, height=.5,
            gp=gpar(fill=list(linearGradient(group=FALSE),
                              radialGradient(group=FALSE),
                              linearGradient())))
HersheyLabel("list of gradient fills
linear (group=FALSE)
radial (group=FALSE)
linear (group=TRUE)", y=.8)

################################################################################
## Text
grid.newpage()
grid.text(letters[1:3], x=1:3/4, y=1:3/4, 
          gp=gpar(fontfamily="HersheySans",
                  fill=linearGradient(group=FALSE)))
HersheyLabel("single gradient fill
group = FALSE", y=.8)

grid.newpage()
grid.text(letters[1:3], x=1:3/4, y=1:3/4, 
          gp=gpar(fontfamily="HersheySans",
                  fill=list(linearGradient(group=FALSE),
                            radialGradient(group=FALSE),
                            linearGradient())))
HersheyLabel("list of gradient fills
linear (group=FALSE)
radial (group=FALSE)
linear (group=TRUE)", y=.8)

################################################################################
## Arrows
grid.newpage()
grid.segments(x0=c(.2, .4, .6),
              y0=c(.2, .5, .8),
              x1=c(.4, .6, .8),
              y1=c(.2, .5, .8),
              arrow=arrow(type="closed"),
              gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("Lines with (closed) arrows
gradient fill disallowed on arrow", y=.8)

grid.newpage()
grid.xspline(x=c(.2, .4, .3,
                 .4, .6, .5,
                 .6, .8, .7),
             y=c(.2, .2, .4,
                 .4, .4, .6,
                 .6, .6, .8),
             id=rep(1:3, each=3),
             shape=-1,
             arrow=arrow(type="closed"),
             gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("Lines with (closed) arrows
gradient fill disallowed on arrow", y=.8)

grid.newpage()
grid.lines(x=c(.2, .4, .3),
           y=c(.2, .2, .4),
           arrow=arrow(type="closed"),
           gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("Lines with (closed) arrows
gradient fill disallowed on arrow", y=.8)

grid.newpage()
grid.move.to(x=.2, y=.2)
grid.line.to(x=.4, y=.4,
             arrow=arrow(type="closed"),
             gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("Lines with (closed) arrows
gradient fill disallowed on arrow", y=.8)

################################################################################
## Test more complex coords from more complex grobs (gTrees)

################################################################################
## grobCoords() also used when resolving patterns to generate a bbox
## for temporary viewport (so the pattern is resolved relative to the
## grob bbox).  Hence ...
##
## grid/R/patterns.R
library(grid)

## Test gTree with pattern fill
## Children are distinct rectangles, pattern is resolved on gTree
## so relative to bbox around both rectangles
gt <- gTree(children=gList(rectGrob(1/3, width=.2, height=.2),
                           rectGrob(2/3, width=.2, height=.2)),
            gp=gpar(fill=linearGradient()))
grid.newpage()
grid.draw(gt)
HersheyLabel("gTree with two rects
fill resolved on bbox of both rects", y=.8)

## Test gTree with pattern fill with children that push vp
## (to test that the resolution happens in the gTree context
##  NOT the child's vp context)
## Both rects should be filled with gradient that fills whole page
gt <- gTree(children=gList(rectGrob(),
                           rectGrob(vp=viewport(width=.5, height=.5))),
            gp=gpar(fill=linearGradient()))
grid.newpage()
grid.draw(gt)
HersheyLabel("gTree with two rects
one rect has vp
fill resolved on gTree
both rects same fill")

## Test gTree with pattern fill with children with pattern fill
## Left rect gets its own gradient;  right rect gets gradient
## relative to both rects
gt <- gTree(children=gList(rectGrob(1/3, width=.2, height=.2,
                                    gp=gpar(fill=linearGradient())),
                           rectGrob(2/3, width=.2, height=.2)),
            gp=gpar(fill=linearGradient()))
grid.newpage()
grid.draw(gt)
HersheyLabel("gTree with pattern fill
one rect also has pattern fill
one rect has gTree pattern fill
(resolved on both rects)
one rect has its own pattern fill", y=.8)

## Test gTree with pattern fill with gTree as child
## (same result as first gTree test)
gt <- gTree(children=gList(gTree(children=gList(rectGrob(1/3,
                                                         width=.2,
                                                         height=.2),
                                                rectGrob(2/3,
                                                         width=.2,
                                                         height=.2)))),
            gp=gpar(fill=linearGradient()))
grid.newpage()
grid.draw(gt)
HersheyLabel("gTree with pattern fill
child is gTree with children
pattern resolved on parent gTree" ,y=.8)

## Test gTree with gTree with pattern fill as child
## (same result as first gTree test)
gt <- gTree(children=gList(gTree(children=gList(rectGrob(1/3,
                                                         width=.2,
                                                         height=.2),
                                                rectGrob(2/3,
                                                         width=.2,
                                                         height=.2)),
                                 gp=gpar(fill=linearGradient()))))
grid.newpage()
grid.draw(gt)
HersheyLabel("gTree child gTree
child gTree has pattern fill
pattern resolved on child gTree" ,y=.8)

## Test gTree with pattern fill with group = FALSE
## (so pattern fill is resolved separately on each child)
gt <- gTree(children=gList(rectGrob(1/3, width=.2, height=.2),
                           rectGrob(2/3, width=.2, height=.2)),
            gp=gpar(fill=linearGradient(group=FALSE)))
grid.newpage()
grid.draw(gt)
HersheyLabel("gTree with pattern fill
with group=FALSE
pattern resolved on each child rect", y=.8)

################################################################################
## groups and (stroked and filled) paths generate gTrees to calculate
## grobCoords(), so they are affected.  Hence ...
##
## grid/R/group.R
## grid/R/path.R
library(grid)
r1 <- rectGrob(x=0, y=0, width=.5, height=.5, just=c("left", "bottom"))
r2 <- rectGrob(x=1, y=1, width=.75, height=.75, just=c("right", "top"),
               gp=gpar(fill="black"))

## Path with hole filled with pattern
grid.newpage()
grid.fill(gTree(children=gList(r1, r2)),
          rule="evenodd",
          gp=gpar(fill=linearGradient()))
HersheyLabel("path from two rects
pattern fill resolved on bbox of both rects", y=.8)

## Remove r2 from r1 with "group" and fill with gradient
## (bbox is from BOTH rects, hence whole page)
grid.newpage()
grid.group(r2, "dest.out", r1, gp=gpar(fill=linearGradient()))
HersheyLabel("group of two rects
big rect takes bite out of small rect
pattern fill resolved on bbox of both rects", y=.8)

## NOTE that setting 'gp' on group use has no effect on group
## (graphical parameter settings were fixed at group definition)
grid.newpage()
grid.define(r1, name="r1")
pushViewport(viewport(x=1, y=1))
grid.use("r1", gp=gpar(fill=linearGradient()))
upViewport()
HersheyLabel("group use with pattern fill
pattern IGNORED", y=.2)

## BUT if put the fill on the grob in the group it works ?
grid.newpage()
grid.define(editGrob(r1, gp=gpar(fill=linearGradient())), name="r1")
pushViewport(viewport(x=1, y=1))
grid.use("r1")
upViewport()
HersheyLabel("group use imposes transformation
rect within group has pattern fill
pattern resolved on rect on use", y=.2)
## ... even with scaling (as well as translation) transformation
grid.newpage()
grid.define(editGrob(r1, gp=gpar(fill=linearGradient())), name="r1")
pushViewport(viewport(x=1, y=1, width=.5, height=.5))
grid.use("r1")
upViewport()
HersheyLabel("group use imposes transformation AND scaling
rect within group has pattern fill
pattern resolved on rect on use", y=.2)

################################################################################
## Tests of gTree with LIST of patterns

## gTree with LIST of patterns, group = TRUE
## Test gTree with pattern fill with group = FALSE
## (so pattern fill is resolved separately on each child)
gt <- gTree(children=gList(rectGrob(1:2/3, 1/3, width=.2, height=.2),
                           rectGrob(1:2/3, 2/3, width=.2, height=.2)),
            gp=gpar(fill=list(linearGradient(), radialGradient())))
grid.newpage()
grid.draw(gt)
HersheyLabel("gTree with LIST of pattern fills
with group=TRUE
patterns resolved on gTree
each SHAPE within each child gets different pattern", y=.8)

## gTree with LIST of patterns, group = FALSE
gt <- gTree(children=gList(rectGrob(1:2/3, 1/3, width=.2, height=.2),
                           rectGrob(1:2/3, 2/3, width=.2, height=.2)),
            gp=gpar(fill=list(linearGradient(group=FALSE),
                              radialGradient(group=FALSE))))
grid.newpage()
grid.draw(gt)
HersheyLabel("gTree with LIST of pattern fills
with group=FALSE
patterns resolved on children
each SHAPE within each child RESOLVES different pattern", y=.8)

## gTree with LIST of patterns, group = mix of TRUE/FALSE
gt <- gTree(children=gList(rectGrob(1:2/3, 1/3, width=.2, height=.2),
                           rectGrob(1:2/3, 2/3, width=.2, height=.2)),
            gp=gpar(fill=list(linearGradient(group=TRUE),
                              radialGradient(group=FALSE))))
grid.newpage()
grid.draw(gt)
HersheyLabel("gTree with LIST of pattern fills
with group=TRUE and FALSE
patterns resolved on gTree AND children
each SHAPE within each child gets OR resolves different pattern", y=.8)

## gTree with LIST of patterns, group = TRUE
## but NO children that have a fill!
gt <- gTree(children=gList(segmentsGrob(0, 0:1, 1, 1:0)),
            gp=gpar(fill=list(linearGradient(),
                              radialGradient())))
grid.newpage()
grid.draw(gt)
HersheyLabel("gTree with LIST of pattern fills
with group=TRUE
BUT no children that have a fill
patterns resolved on gTree
no (pattern) fill", y=.8)

## gTree with LIST of patterns, group = FALSE
## but NO children that have a fill!
gt <- gTree(children=gList(segmentsGrob(0, 0:1, 1, 1:0)),
            gp=gpar(fill=list(linearGradient(group=FALSE),
                              radialGradient(group=FALSE))))
grid.newpage()
grid.draw(gt)
HersheyLabel("gTree with LIST of pattern fills
with group=FALSE
BUT no children that have a fill
patterns resolved on children
no (pattern) fill", y=.8)

## gTree with LIST of patterns, group = mix of TRUE/FALSE
## and MIX of children that have a fill!
## (all combinations of group and child-has-fill)
gt <- gTree(children=gList(segmentsGrob(0, 0:1, 1, 1:0),
                           rectGrob(1:2/3, 2/3, width=.2, height=.2)),
            gp=gpar(fill=list(linearGradient(group=TRUE),
                              radialGradient(group=FALSE))))
grid.newpage()
grid.draw(gt)
HersheyLabel("gTree with LIST of pattern fills
with group=FALSE
BUT no children that have a fill
patterns resolved on children
no (pattern) fill", y=.8)

################################################################################
## More groups and (stroked and filled) paths 
library(grid)
r1 <- rectGrob(x=0, y=0, width=.5, height=.5, just=c("left", "bottom"))
r2 <- rectGrob(x=1, y=1, width=.75, height=.75, just=c("right", "top"),
               gp=gpar(fill="black"))

## Path with hole filled with pattern, group = FALSE
## Path is a "single shape" so result should be same as group = TRUE
grid.newpage()
grid.fill(gTree(children=gList(r1, r2)),
          rule="evenodd",
          gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("path from two rects
group = FALSE
pattern fill resolved on bbox of both rects", y=.8)

## Remove r2 from r1 with "group" and fill with gradient, group = FALSE
## Gradient should be applied to individual rects
grid.newpage()
grid.group(r2, "dest.out", r1, gp=gpar(fill=linearGradient(group=FALSE)))
HersheyLabel("group of two rects
group = FALSE
big rect takes bite out of small rect
pattern fill resolved on each rect", y=.8)

## fill on the grob in the group
grid.newpage()
grid.define(r2, "dest.out",
            editGrob(r1, gp=gpar(fill=linearGradient())),
            name="r1")
pushViewport(viewport(x=1, y=1))
grid.use("r1")
upViewport()
HersheyLabel("group use imposes transformation
rect within group has pattern fill
pattern resolved on rect on use", y=.2)
## ... even with scaling (as well as translation) transformation
grid.newpage()
grid.define(r2, "dest.out",
            editGrob(r1, gp=gpar(fill=linearGradient())),
            name="r1")
pushViewport(viewport(x=1, y=1, width=.5, height=.5))
grid.use("r1")
upViewport()
HersheyLabel("group use imposes transformation AND scaling
rect within group has pattern fill
pattern resolved on rect on use", y=.2)

## fill on the grob in the group, group = FALSE
grid.newpage()
grid.define(r2, "dest.out",
            editGrob(r1, gp=gpar(fill=linearGradient(group=FALSE))),
            name="gt")
pushViewport(viewport(x=1, y=1))
grid.use("gt")
upViewport()
HersheyLabel("group use imposes transformation
rect within group has pattern fill
group = FALSE (no effect)
pattern resolved on rect on use", y=.2)
## ... even with scaling (as well as translation) transformation, group=FALSE
grid.newpage()
grid.define(r2, "dest.out",
            editGrob(r1, gp=gpar(fill=linearGradient(group=FALSE))),
            name="gt")
pushViewport(viewport(x=1, y=1, width=.5, height=.5))
grid.use("gt")
upViewport()
HersheyLabel("group use imposes transformation AND scaling
rect within group has pattern fill
group = FALSE (no effect)
pattern resolved on rect on use", y=.2)

## Test gTree with pattern fill with children that push vp, group = FALSE
## SO child with vp should get different fill
gt <- gTree(children=gList(rectGrob(),
                           rectGrob(vp=viewport(width=.5, height=.5))),
            gp=gpar(fill=linearGradient(group=FALSE)))
grid.newpage()
grid.draw(gt)
HersheyLabel("gTree with two rects
one rect has vp
fill resolved on each rect
rects get different fill")

## gTree with group as child, fill resolved on gTree bbox
## (so needs group bbox)
grid.newpage()
group <- groupGrob(r1)
gt <- gTree(children=gList(r2, group),
            gp=gpar(fill=linearGradient()))
grid.draw(gt)
HersheyLabel("gTree has group as child
gTree has pattern fill
pattern resolved on gTree", y=.2)

## gTree with group USE as child, fill resolved on gTree bbox
## (so needs group USE bbox)
grid.newpage()
r3 <- rectGrob(width=.5, height=.5)
group <- grid.define(r1, name="r")
use <- useGrob("r", vp=viewport(1, 1))
gt <- gTree(children=gList(r3, use),
            gp=gpar(fill=linearGradient()))
grid.rect(.25, .25, .75, .75, just=c("left", "bottom"),
          gp=gpar(col=NA, fill=linearGradient()))
grid.draw(gt)
HersheyLabel("gTree has group USE as child
gTree has pattern fill
pattern resolved on gTree
(rect behind shows correct gradient)", y=.2)

## Check grobCoords() from transform with skew produces same outline
grid.newpage()
c <- circleGrob(r=c(.3, .4))
pts <- grobCoords(c, closed=TRUE)
p <- pathGrob(c(pts[[1]]$x, pts[[2]]$x),
              c(pts[[1]]$y, pts[[2]]$y),
              default.units="in",
              id=rep(1:2, each=100),
              rule="evenodd",
              gp=gpar(fill="grey"))
grid.draw(p)
grid.define(p, name="path")
use <- useGrob("path",
               transform=function(group, ...)
                   viewportTransform(group,
                                     shear=groupShear(.5),
                                     ...))
newPts <- grobCoords(use, closed=TRUE)
newPath <- circleGrob(c(newPts[[1]][[1]][[1]]$x, newPts[[1]][[1]][[2]]$x),
                      c(newPts[[1]][[1]][[1]]$y, newPts[[1]][[1]][[2]]$y),
                      default.units="in",
                      r=unit(.5, "mm"),
                      gp=gpar(col="red", fill="red"))
grid.draw(use)
grid.draw(newPath)