550 lines
18 KiB
R
550 lines
18 KiB
R
|
|
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
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
## Basic sanity checks
|
|
|
|
## Simple group grob (same as a normal grob)
|
|
grid.newpage()
|
|
grid.group(rectGrob(width=.5, height=.5, gp=gpar(fill="grey")))
|
|
HersheyLabel("Group = single rect
|
|
half-width, half-height, grey fill
|
|
same as normal rect")
|
|
|
|
|
|
################################################################################
|
|
## Compositing operators
|
|
|
|
source("compositing.R")
|
|
|
|
|
|
################################################################################
|
|
## Isolated groups
|
|
|
|
## Apply mask to isolated group
|
|
grid.newpage()
|
|
pushViewport(viewport(layout=grid.layout(2, 2)))
|
|
pushViewport(viewport(layout.pos.row=1, layout.pos.col=1))
|
|
grid.rect(height=.5, gp=gpar(fill="red"))
|
|
grid.rect(width=.5, gp=gpar(fill="blue"))
|
|
HersheyLabel("no mask
|
|
each shape composite over")
|
|
popViewport()
|
|
pushViewport(viewport(layout.pos.row=1, layout.pos.col=2),
|
|
viewport(mask=devMask(circleGrob(gp=gpar(col=NA,
|
|
fill=rgb(0,0,0,.5))),
|
|
circleGrob(gp=gpar(col=NA,
|
|
fill=grey(.5))))))
|
|
grid.rect(height=.5, gp=gpar(fill="red"))
|
|
grid.rect(width=.5, gp=gpar(fill="blue"))
|
|
popViewport()
|
|
HersheyLabel("mask
|
|
each shape masked then composite over")
|
|
popViewport()
|
|
pushViewport(viewport(layout.pos.row=2, layout.pos.col=1),
|
|
viewport(mask=devMask(circleGrob(gp=gpar(col=NA,
|
|
fill=rgb(0,0,0,.5))),
|
|
circleGrob(gp=gpar(col=NA,
|
|
fill=grey(.5))))))
|
|
grid.group(rectGrob(width=.5, gp=gpar(fill="blue")),
|
|
"over",
|
|
rectGrob(height=.5, gp=gpar(fill="red")))
|
|
popViewport()
|
|
HersheyLabel("mask and group
|
|
each shape composite over in group
|
|
group masked")
|
|
popViewport()
|
|
|
|
|
|
## Grobs that draw more than one shape
|
|
## Circle of small circles, draw over and then compose with alpha mask
|
|
grid.newpage()
|
|
t <- seq(30, 360, 30)
|
|
x <- .5 + .3*cos(pi*t/180)
|
|
y <- .5 + .3*sin(pi*t/180)
|
|
circles <- circleGrob(x, y, r=.1, gp=gpar(fill="black"))
|
|
pushViewport(viewport(layout=grid.layout(2, 2)))
|
|
pushViewport(viewport(layout.pos.row=1, layout.pos.col=1))
|
|
grid.draw(circles)
|
|
HersheyLabel("circle grob")
|
|
popViewport()
|
|
pushViewport(viewport(layout.pos.row=1, layout.pos.col=2,
|
|
mask=devMask(rectGrob(gp=gpar(col=NA,
|
|
fill=rgb(0,0,0,.5))),
|
|
rectGrob(gp=gpar(col=NA,
|
|
fill=grey(.5))))))
|
|
grid.draw(circles)
|
|
HersheyLabel("masked
|
|
circle grob")
|
|
popViewport()
|
|
pushViewport(viewport(layout.pos.row=2, layout.pos.col=1))
|
|
grid.group(circles)
|
|
HersheyLabel("group
|
|
circle grob")
|
|
popViewport()
|
|
pushViewport(viewport(layout.pos.row=2, layout.pos.col=2,
|
|
mask=devMask(rectGrob(gp=gpar(col=NA,
|
|
fill=rgb(0,0,0,.5))),
|
|
rectGrob(gp=gpar(col=NA,
|
|
fill=grey(.5))))))
|
|
grid.group(circles)
|
|
HersheyLabel("masked
|
|
group
|
|
circle grob")
|
|
popViewport()
|
|
|
|
|
|
################################################################################
|
|
## Inheritance of graphics settings
|
|
|
|
## Compositing groups inherit graphics settings from "parent"
|
|
grid.newpage()
|
|
pushViewport(viewport(gp=gpar(fill="pink")))
|
|
grid.rect(x=1/4, width=1/2)
|
|
grid.group(rectGrob(x=3/4, width=1/2))
|
|
HersheyLabel("group inherits current gpar
|
|
(right rect pink)")
|
|
popViewport()
|
|
|
|
## Watch out for alpha level accumulating
|
|
grid.newpage()
|
|
pushViewport(viewport(gp=gpar(fill=rgb(1,0,0,.5))))
|
|
grid.rect(x=1/4, width=1/2)
|
|
grid.group(rectGrob(x=3/4, width=1/2))
|
|
HersheyLabel("group inherits current gpar
|
|
(right rect trans red)
|
|
test with alpha")
|
|
popViewport()
|
|
|
|
|
|
################################################################################
|
|
## gTrees
|
|
|
|
## The trick here is that the rectangle is drawn within a viewport,
|
|
## which means that there is an upViewport() within the drawing
|
|
## of the group, which means 'grid' has to have guards against that
|
|
## upViewport() resetting any mask that is in effect outside the group.
|
|
##
|
|
## This is a proxy for drawing complex things like 'ggplot2' plot gTrees
|
|
## within a group (which also works, I just cannot make it a test within
|
|
## the 'grid' package).
|
|
grid.newpage()
|
|
gt <- gTree(children=gList(rectGrob(vp=viewport()),
|
|
circleGrob(1:2/3, r=.3, gp=gpar(fill="black"))))
|
|
pushViewport(viewport(mask=devMask(rectGrob(gp=gpar(col=NA,
|
|
fill=rgb(0,0,0,.5))),
|
|
rectGrob(gp=gpar(col=NA,
|
|
fill=grey(.5))))))
|
|
grid.group(gt)
|
|
HersheyLabel("group is gTree with child with vp
|
|
group drawn with mask", y=.9)
|
|
HersheyLabel("mask NOT reset within group definition
|
|
(circles NOT masked within group)", y=.1)
|
|
popViewport()
|
|
|
|
|
|
################################################################################
|
|
## Reuse
|
|
|
|
## Use group in smaller viewport (translate and scale)
|
|
grid.newpage()
|
|
grid.group(rectGrob(width=unit(1, "in"), height=unit(1, "in"),
|
|
gp=gpar(fill="grey")),
|
|
name="rectGroup")
|
|
HersheyLabel("draw named group", y=.75)
|
|
pushViewport(viewport(x=.75, y=.25, width=.5, height=.5))
|
|
grid.rect(gp=gpar(fill=NA, lty="dashed"))
|
|
grid.use("rectGroup")
|
|
HersheyLabel("reuse group
|
|
(in smaller viewport)
|
|
shrunk AND thinner border", y=.25)
|
|
popViewport()
|
|
|
|
## Just translate
|
|
grid.newpage()
|
|
grid.define(rectGrob(width=unit(1, "in"), height=unit(1, "in"),
|
|
gp=gpar(fill="grey")),
|
|
name="rectGroup")
|
|
grid.use("rectGroup")
|
|
HersheyLabel("draw named group", y=.75)
|
|
pushViewport(viewport(x=.75, y=.25, width=.5, height=.5))
|
|
grid.rect(gp=gpar(fill=NA, lty="dashed"))
|
|
grid.use("rectGroup", viewportTranslate)
|
|
HersheyLabel("reuse group
|
|
just with translate transform
|
|
(in smaller viewport)
|
|
just shifted", y=.25)
|
|
popViewport()
|
|
|
|
## Just scale
|
|
grid.newpage()
|
|
grid.define(rectGrob(width=unit(1, "in"), height=unit(1, "in"),
|
|
gp=gpar(fill="grey")),
|
|
name="rectGroup")
|
|
grid.use("rectGroup")
|
|
HersheyLabel("draw named group", y=.75)
|
|
pushViewport(viewport(x=.75, y=.25, width=.5, height=.5))
|
|
grid.rect(gp=gpar(fill=NA, lty="dashed"))
|
|
grid.use("rectGroup", viewportScale)
|
|
HersheyLabel("reuse group
|
|
just with scale transform
|
|
(in smaller viewport)
|
|
just scaled", y=.25)
|
|
popViewport()
|
|
|
|
## Just translate BUT viewport x/y is NOT "centre"
|
|
grid.newpage()
|
|
grid.define(rectGrob(width=unit(1, "in"), height=unit(1, "in"),
|
|
gp=gpar(fill="grey")),
|
|
name="rectGroup")
|
|
grid.use("rectGroup")
|
|
HersheyLabel("draw named group", y=.75)
|
|
pushViewport(viewport(x=1, y=0, width=.5, height=.5, just=c("right", "bottom")))
|
|
grid.rect(gp=gpar(fill=NA, lty="dashed"))
|
|
grid.use("rectGroup", viewportTranslate)
|
|
HersheyLabel("reuse group
|
|
just with translate transform
|
|
with vp x/y at bottom-right
|
|
(in smaller viewport)
|
|
shifted to new vp x/y", y=.25)
|
|
popViewport()
|
|
|
|
## Just scale (which ignores the fact that x/y is NOT "centre")
|
|
grid.newpage()
|
|
grid.define(rectGrob(width=unit(1, "in"), height=unit(1, "in"),
|
|
gp=gpar(fill="grey")),
|
|
name="rectGroup")
|
|
grid.use("rectGroup")
|
|
HersheyLabel("draw named group", y=.75)
|
|
pushViewport(viewport(x=1, y=0, width=.5, height=.5, just=c("right", "bottom")))
|
|
grid.rect(gp=gpar(fill=NA, lty="dashed"))
|
|
grid.use("rectGroup", viewportScale)
|
|
HersheyLabel("reuse group
|
|
just with scale transform
|
|
with vp x/y at bottom-right
|
|
(in smaller viewport)
|
|
just scaled
|
|
(new vp x/y ignored)", y=.25)
|
|
popViewport()
|
|
|
|
## Rotation
|
|
grid.newpage()
|
|
grid.define(rectGrob(width=unit(1, "in"), height=unit(1, "in"),
|
|
gp=gpar(fill="grey")),
|
|
name="rectGroup")
|
|
grid.use("rectGroup")
|
|
pushViewport(viewport(angle=15))
|
|
grid.rect(gp=gpar(lty="dashed", fill=NA))
|
|
grid.use("rectGroup")
|
|
popViewport()
|
|
HersheyLabel("reuse group
|
|
rotated viewport
|
|
rotated group", y=.25)
|
|
|
|
## Shear
|
|
grid.newpage()
|
|
grid.define(rectGrob(width=unit(1, "in"), height=unit(1, "in"),
|
|
gp=gpar(fill="grey")),
|
|
name="rectGroup")
|
|
grid.use("rectGroup")
|
|
trans <- function(group, ...) {
|
|
viewportTransform(group, shear=groupShear(.5, 0))
|
|
}
|
|
grid.use("rectGroup", transform=trans)
|
|
HersheyLabel("reuse group
|
|
shear (skewX) transform
|
|
sheared group", y=.25)
|
|
|
|
grid.newpage()
|
|
grid.define(rectGrob(width=unit(1, "in"), height=unit(1, "in"),
|
|
gp=gpar(fill="grey")),
|
|
name="rectGroup")
|
|
grid.use("rectGroup")
|
|
trans <- function(group, ...) {
|
|
viewportTransform(group, shear=groupShear(0, .5))
|
|
}
|
|
grid.use("rectGroup", transform=trans)
|
|
HersheyLabel("reuse group
|
|
shear (skewY) transform
|
|
sheared group", y=.25)
|
|
|
|
grid.newpage()
|
|
pushViewport(viewport(gp=gpar(col=2)))
|
|
grid.define(circleGrob(r=.1), name="c", gp=gpar(lwd=5))
|
|
grid.use("c")
|
|
pushViewport(viewport(x=.25, gp=gpar(col="green")))
|
|
grid.use("c")
|
|
popViewport()
|
|
pushViewport(viewport(x=.75, gp=gpar(col="blue")))
|
|
grid.use("c")
|
|
popViewport()
|
|
popViewport()
|
|
HersheyLabel("define circle (no colour)
|
|
(red from viewport)
|
|
left viewport sets green
|
|
(circle stays red)
|
|
right viewport sets blue
|
|
(cirlce stays red)", y=.25)
|
|
|
|
grid.newpage()
|
|
grid.define(rectGrob(gp=gpar(col=NA, fill=radialGradient())),
|
|
name="gradient")
|
|
grid.use("gradient")
|
|
pushViewport(viewport(y=.1, height=.2))
|
|
grid.rect(gp=gpar(lty="dashed", fill=NA))
|
|
grid.use("gradient")
|
|
popViewport()
|
|
HersheyLabel("group with gradient fill
|
|
reused in viewport with different scale
|
|
distorted gradient", y=.9)
|
|
|
|
################################################################################
|
|
## Combinations (masks in groups, groups in groups, ...)
|
|
|
|
## Text in group
|
|
grid.newpage()
|
|
group <- gTree(children=gList(rectGrob(width=.8, height=.5),
|
|
textGrob("testing", gp=gpar(cex=3))))
|
|
grid.group(group)
|
|
HersheyLabel("group with text", y=.8)
|
|
|
|
## Pattern in group
|
|
grid.newpage()
|
|
grid.group(rectGrob(width=.8, height=.5, gp=gpar(fill=linearGradient())))
|
|
HersheyLabel("group with gradient fill", y=.8)
|
|
|
|
## Clipping path in group
|
|
grid.newpage()
|
|
vp <- viewport(clip=circleGrob())
|
|
grid.group(rectGrob(gp=gpar(fill="grey")), vp=vp)
|
|
HersheyLabel("group with vp
|
|
vp is viewport with clipping path
|
|
result is grey circle")
|
|
|
|
grid.newpage()
|
|
vp <- viewport(clip=circleGrob())
|
|
grid.group(rectGrob(gp=gpar(fill="grey"), vp=vp))
|
|
HersheyLabel("group with grob with vp
|
|
vp is viewport with clipping path
|
|
result is grey circle")
|
|
|
|
## Mask in group
|
|
grid.newpage()
|
|
vp <- viewport(mask=devMask(circleGrob(gp=gpar(fill="black")),
|
|
circleGrob(gp=gpar(col="white", fill="white"))))
|
|
grid.group(rectGrob(gp=gpar(fill="grey")), vp=vp)
|
|
HersheyLabel("group with vp
|
|
vp is viewport with mask
|
|
result is grey circle")
|
|
|
|
grid.newpage()
|
|
vp <- viewport(mask=devMask(circleGrob(gp=gpar(fill="black")),
|
|
circleGrob(gp=gpar(col="white", fill="white"))))
|
|
grid.group(rectGrob(gp=gpar(fill="grey"), vp=vp))
|
|
HersheyLabel("group with grob with vp
|
|
vp is viewport with mask
|
|
result is grey circle")
|
|
|
|
## Path in group
|
|
grid.newpage()
|
|
grid.group(fillGrob(circleGrob(1:2/3, r=.3), gp=gpar(fill="grey")))
|
|
HersheyLabel("group with (filled) path")
|
|
|
|
## Group in group
|
|
grid.newpage()
|
|
gt <- gTree(children=gList(rectGrob(width=.5, gp=gpar(fill=rgb(1,0,0,.5))),
|
|
groupGrob(rectGrob(height=.5,
|
|
gp=gpar(fill=rgb(0,0,1,.5))))))
|
|
grid.group(gt)
|
|
HersheyLabel("group containing group
|
|
both groups semitransparent
|
|
see overlap between groups")
|
|
|
|
grid.newpage()
|
|
rects <- gTree(children=gList(rectGrob(width=unit(5, "mm"),
|
|
height=unit(5, "mm"),
|
|
just=c("left", "bottom"),
|
|
gp=gpar(fill="black")),
|
|
rectGrob(width=unit(5, "mm"),
|
|
height=unit(5, "mm"),
|
|
just=c("right", "top"),
|
|
gp=gpar(fill="black"))))
|
|
pat <- pattern(rects,
|
|
width=unit(1, "cm"), height=unit(1, "cm"),
|
|
extend="repeat")
|
|
grid.rect(gp=gpar(fill=pat))
|
|
gt1 <- gTree(children=gList(rectGrob(width=.5, gp=gpar(fill=2)),
|
|
rectGrob(height=.5, gp=gpar(fill=4))))
|
|
vp <- viewport(mask=devMask(rectGrob(gp=gpar(col=NA, fill=rgb(0,0,0,.7))),
|
|
rectGrob(gp=gpar(col=NA, fill=grey(.7)))))
|
|
g1 <- groupGrob(gt1, vp=vp)
|
|
gt2 <- gTree(children=gList(g1, segmentsGrob(gp=gpar(lwd=100))))
|
|
g2 <- groupGrob(gt2, vp=vp)
|
|
grid.draw(g2)
|
|
grid.rect(width=.8, height=.4, gp=gpar(col=NA, fill=rgb(1,1,1,.7)))
|
|
HersheyLabel("group containing group
|
|
inner group overlapping rects
|
|
inner group drawn with semitransparent mask
|
|
(see through blue rect - no overlap visible)
|
|
outer group thick black line
|
|
outer group drawn with semitransparent mask
|
|
(see through black line - no overlap visible)
|
|
[white rect just background for this label]")
|
|
|
|
## Group used with transform in group used with transform
|
|
grid.newpage()
|
|
vp1 <- viewport(x=.3, y=.2, width=.3, height=.3)
|
|
vp2 <- viewport(x=.5, y=.6, width=.1, height=.3)
|
|
vp3 <- viewport(x=.7, y=.2, width=.3, height=.3)
|
|
pushViewport(vp1)
|
|
grid.rect(gp=gpar(col="grey"))
|
|
grid.define(polygonGrob(c(.2, .5, .8), c(.2, .8, .2),
|
|
gp=gpar(lwd=10, col=2, fill=3)),
|
|
name="p")
|
|
grid.use("p")
|
|
popViewport()
|
|
pushViewport(vp2)
|
|
grid.rect(gp=gpar(col="grey"))
|
|
grid.use("p")
|
|
grid.define(useGrob("p"), name="g")
|
|
popViewport()
|
|
pushViewport(vp3)
|
|
grid.rect(gp=gpar(col="grey"))
|
|
grid.use("g")
|
|
popViewport()
|
|
HersheyLabel("bottom left is group-1 definition
|
|
top is reuse of group-1 with horiz squash
|
|
top is also group-2 definition
|
|
bottom right is reuse of group-2 with horiz stretch", y=.9)
|
|
|
|
grid.newpage()
|
|
vp1 <- viewport(x=.2, y=.2, width=.3, height=.3)
|
|
vp2 <- viewport(x=.3, y=.5, width=.1, height=.2, angle=-30)
|
|
vp3 <- viewport(x=.7, y=.7, width=.5, height=.5)
|
|
pushViewport(vp1)
|
|
grid.rect(gp=gpar(col="grey"))
|
|
grid.define(polygonGrob(c(.2, .5, .8), c(.2, .8, .2),
|
|
gp=gpar(lwd=10, col=2, fill=3)),
|
|
name="r")
|
|
grid.use("r")
|
|
popViewport()
|
|
pushViewport(vp2)
|
|
grid.rect(gp=gpar(lty="dotted"))
|
|
popViewport()
|
|
g <- useGrob("r", vp=vp2)
|
|
grid.draw(g)
|
|
pushViewport(vp3)
|
|
grid.rect()
|
|
pushViewport(vp1)
|
|
grid.rect(gp=gpar(col="grey"))
|
|
popViewport()
|
|
pushViewport(vp2)
|
|
grid.rect(gp=gpar(lty="dotted"))
|
|
popViewport()
|
|
grid.define(g, name="g")
|
|
grid.use("g")
|
|
popViewport()
|
|
pushViewport(viewport(.7, .2, width=.5, height=.3))
|
|
grid.rect()
|
|
grid.use("g")
|
|
popViewport()
|
|
HersheyLabel("bottom-left is group-1 definition
|
|
group-1 reused with horiz. stretch and rotation
|
|
top-right is group-2 definition (based on group-1)
|
|
bottom-right is group-2 reused with vert. squash", y=.85)
|
|
|
|
## Raster in group
|
|
grid.newpage()
|
|
group <- gTree(children=gList(rectGrob(width=.8, height=.5),
|
|
rasterGrob(matrix(c(0:1, 1:0), nrow=2),
|
|
width=.2, height=.2,
|
|
interpolate=FALSE)))
|
|
grid.group(group)
|
|
HersheyLabel("group with raster", y=.8)
|
|
|
|
## Group with rect with gradient fill
|
|
grid.newpage()
|
|
grid.group(rectGrob(width=.5, height=.5,
|
|
gp=gpar(fill=linearGradient())))
|
|
HersheyLabel("group based on rect
|
|
rect has linear gradient", y=.1)
|
|
|
|
## Group with gradient fill
|
|
grid.newpage()
|
|
grid.group(rectGrob(width=.5, height=.5),
|
|
gp=gpar(fill=linearGradient()))
|
|
HersheyLabel("group based on rect
|
|
GROUP has linear gradient", y=.1)
|
|
|
|
## Group with multiple shapes with gradient fill
|
|
grid.newpage()
|
|
grid.group(gTree(children=gList(rectGrob(.25, .25, .5, .5),
|
|
rectGrob(.75, .75, .5, .5))),
|
|
gp=gpar(fill=linearGradient()))
|
|
HersheyLabel("group based on two rects
|
|
GROUP has linear gradient", y=.1)
|
|
|
|
## Subtler problem (need fill captured on definition)
|
|
grid.newpage()
|
|
grid.define(rectGrob(width=.5, height=.5),
|
|
gp=gpar(fill=linearGradient()), name="g")
|
|
grid.use("g")
|
|
HersheyLabel("group based on rect
|
|
GROUP has linear gradient
|
|
group defined then used", y=.1)
|
|
|
|
## Group points/coords include src and dst even if they are not drawn
|
|
## (so linear gradient starts at bottom left of page NOT at centre of page)
|
|
grid.newpage()
|
|
grid.group(circleGrob(.25, .25, .5, gp=gpar(fill="black")),
|
|
"dest.out",
|
|
rectGrob(.75, .75, .5, .5),
|
|
gp=gpar(fill=linearGradient()))
|
|
HersheyLabel("group based on circle and rect
|
|
circle clears rect
|
|
GROUP has linear gradient
|
|
gradient extent is rect AND circle extent", y=.3)
|
|
|
|
## Group with shapes that do NOT start at bottom-left
|
|
grid.newpage()
|
|
grid.group(circleGrob(3:4/5, 3:4/5, r=.1),
|
|
gp=gpar(fill=linearGradient()))
|
|
HersheyLabel("group based on circles
|
|
GROUP has linear gradient
|
|
gradient extent is circle extent", y=.3)
|
|
|
|
################################################################################
|
|
|
|
TODO <- function() {
|
|
|
|
|
|
}
|