The R Project SVN R

Rev

Rev 83781 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 83781 Rev 83917
Line 10... Line 10...
10 
        y <- y + unit(rev(seq(n)) - mean(seq(n)), "lines")
 10 
        y <- y + unit(rev(seq(n)) - mean(seq(n)), "lines")
11 
    }
 11 
    }
12 
    grid.text(lines, y=y, gp=gpar(fontfamily="HersheySans"))
 12 
    grid.text(lines, y=y, gp=gpar(fontfamily="HersheySans"))
13 
}
 13 
}
14 
 
 14 
 
- 
 
 15 
devMask <- function(aMask, lMask) {
- 
 
 16 
    support <- dev.capabilities()$masks
- 
 
 17 
    if (is.character(support)) {
- 
 
 18 
        if ("alpha" %in% support) {
- 
 
 19 
            aMask
- 
 
 20 
        } else {
- 
 
 21 
            if ("luminance" %in% support) {
- 
 
 22 
                as.mask(lMask, type="luminance")
- 
 
 23 
            } else {
- 
 
 24 
                FALSE
- 
 
 25 
            }
- 
 
 26 
        }
- 
 
 27 
    } else {
- 
 
 28 
        FALSE
- 
 
 29 
    }
- 
 
 30 
}
- 
 
 31 
 
15 
################################################################################
 32 
################################################################################
16 
## Basic sanity checks
 33 
## Basic sanity checks
17 
 
 34 
 
18 
## Simple group grob (same as a normal grob)
 35 
## Simple group grob (same as a normal grob)
19 
grid.newpage()
 36 
grid.newpage()
Line 40... Line 57...
40 
grid.rect(width=.5, gp=gpar(fill="blue"))
 57 
grid.rect(width=.5, gp=gpar(fill="blue"))
41 
HersheyLabel("no mask
 58 
HersheyLabel("no mask
42 
each shape composite over")
 59 
each shape composite over")
43 
popViewport()
 60 
popViewport()
44 
pushViewport(viewport(layout.pos.row=1, layout.pos.col=2),
 61 
pushViewport(viewport(layout.pos.row=1, layout.pos.col=2),
45 
             viewport(mask=circleGrob(gp=gpar(col=NA, fill=rgb(0,0,0,.5)))))
 62 
             viewport(mask=devMask(circleGrob(gp=gpar(col=NA,
- 
 
 63 
                                                      fill=rgb(0,0,0,.5))),
- 
 
 64 
                                   circleGrob(gp=gpar(col=NA,
- 
 
 65 
                                                      fill=grey(.5))))))
46 
grid.rect(height=.5, gp=gpar(fill="red"))
 66 
grid.rect(height=.5, gp=gpar(fill="red"))
47 
grid.rect(width=.5, gp=gpar(fill="blue"))
 67 
grid.rect(width=.5, gp=gpar(fill="blue"))
48 
popViewport()
 68 
popViewport()
49 
HersheyLabel("mask
 69 
HersheyLabel("mask
50 
each shape masked then composite over")
 70 
each shape masked then composite over")
51 
popViewport()
 71 
popViewport()
52 
pushViewport(viewport(layout.pos.row=2, layout.pos.col=1),
 72 
pushViewport(viewport(layout.pos.row=2, layout.pos.col=1),
53 
             viewport(mask=circleGrob(gp=gpar(col=NA, fill=rgb(0,0,0,.5)))))
 73 
             viewport(mask=devMask(circleGrob(gp=gpar(col=NA,
- 
 
 74 
                                                      fill=rgb(0,0,0,.5))),
- 
 
 75 
                                   circleGrob(gp=gpar(col=NA,
- 
 
 76 
                                                      fill=grey(.5))))))
54 
grid.group(rectGrob(width=.5, gp=gpar(fill="blue")),
 77 
grid.group(rectGrob(width=.5, gp=gpar(fill="blue")),
55 
               "over",
 78 
               "over",
56 
               rectGrob(height=.5, gp=gpar(fill="red")))
 79 
               rectGrob(height=.5, gp=gpar(fill="red")))
57 
popViewport()
 80 
popViewport()
58 
HersheyLabel("mask and group
 81 
HersheyLabel("mask and group
Line 72... Line 95...
72 
pushViewport(viewport(layout.pos.row=1, layout.pos.col=1))
 95 
pushViewport(viewport(layout.pos.row=1, layout.pos.col=1))
73 
grid.draw(circles)
 96 
grid.draw(circles)
74 
HersheyLabel("circle grob")
 97 
HersheyLabel("circle grob")
75 
popViewport()
 98 
popViewport()
76 
pushViewport(viewport(layout.pos.row=1, layout.pos.col=2,
 99 
pushViewport(viewport(layout.pos.row=1, layout.pos.col=2,
- 
 
 100 
                      mask=devMask(rectGrob(gp=gpar(col=NA,
77 
                      mask=rectGrob(gp=gpar(col=NA, fill=rgb(0,0,0,.5)))))
 101 
                                                    fill=rgb(0,0,0,.5))),
- 
 
 102 
                                   rectGrob(gp=gpar(col=NA,
- 
 
 103 
                                                    fill=grey(.5))))))
78 
grid.draw(circles)
 104 
grid.draw(circles)
79 
HersheyLabel("masked
 105 
HersheyLabel("masked
80 
circle grob")
 106 
circle grob")
81 
popViewport()
 107 
popViewport()
82 
pushViewport(viewport(layout.pos.row=2, layout.pos.col=1))
 108 
pushViewport(viewport(layout.pos.row=2, layout.pos.col=1))
83 
grid.group(circles)
 109 
grid.group(circles)
84 
HersheyLabel("group
 110 
HersheyLabel("group
85 
circle grob")
 111 
circle grob")
86 
popViewport()
 112 
popViewport()
87 
pushViewport(viewport(layout.pos.row=2, layout.pos.col=2,
 113 
pushViewport(viewport(layout.pos.row=2, layout.pos.col=2,
- 
 
 114 
                      mask=devMask(rectGrob(gp=gpar(col=NA,
88 
                      mask=rectGrob(gp=gpar(col=NA, fill=rgb(0,0,0,.5)))))
 115 
                                                    fill=rgb(0,0,0,.5))),
- 
 
 116 
                                   rectGrob(gp=gpar(col=NA,
- 
 
 117 
                                                    fill=grey(.5))))))
89 
grid.group(circles)
 118 
grid.group(circles)
90 
HersheyLabel("masked
 119 
HersheyLabel("masked
91 
group
 120 
group
92 
circle grob")
 121 
circle grob")
93 
popViewport()
 122 
popViewport()
Line 128... Line 157...
128 
## within a group (which also works, I just cannot make it a test within
 157 
## within a group (which also works, I just cannot make it a test within
129 
## the 'grid' package).
 158 
## the 'grid' package).
130 
grid.newpage()
 159 
grid.newpage()
131 
gt <- gTree(children=gList(rectGrob(vp=viewport()),
 160 
gt <- gTree(children=gList(rectGrob(vp=viewport()),
132 
                           circleGrob(1:2/3, r=.3, gp=gpar(fill="black"))))
 161 
                           circleGrob(1:2/3, r=.3, gp=gpar(fill="black"))))
133 
pushViewport(viewport(mask=rectGrob(gp=gpar(col=NA, fill=rgb(0,0,0,.5)))))
 162 
pushViewport(viewport(mask=devMask(rectGrob(gp=gpar(col=NA,
- 
 
 163 
                                                    fill=rgb(0,0,0,.5))),
- 
 
 164 
                                   rectGrob(gp=gpar(col=NA,
- 
 
 165 
                                                    fill=grey(.5))))))
134 
grid.group(gt)
 166 
grid.group(gt)
135 
HersheyLabel("group is gTree with child with vp
 167 
HersheyLabel("group is gTree with child with vp
136 
group drawn with mask", y=.9)
 168 
group drawn with mask", y=.9)
137 
HersheyLabel("mask NOT reset within group definition
 169 
HersheyLabel("mask NOT reset within group definition
138 
(circles NOT masked within group)", y=.1)
 170 
(circles NOT masked within group)", y=.1)
Line 324... Line 356...
324 
vp is viewport with clipping path
 356 
vp is viewport with clipping path
325 
result is grey circle")
 357 
result is grey circle")
326
358
327 
## Mask in group
 359 
## Mask in group
328 
grid.newpage()
 360 
grid.newpage()
329 
vp <- viewport(mask=circleGrob(gp=gpar(fill="black")))
 361 
vp <- viewport(mask=devMask(circleGrob(gp=gpar(fill="black")),
- 
 
 362 
                            circleGrob(gp=gpar(col="white", fill="white"))))
330 
grid.group(rectGrob(gp=gpar(fill="grey")), vp=vp)
 363 
grid.group(rectGrob(gp=gpar(fill="grey")), vp=vp)
331 
HersheyLabel("group with vp
 364 
HersheyLabel("group with vp
332 
vp is viewport with mask
 365 
vp is viewport with mask
333 
result is grey circle")
 366 
result is grey circle")
334 
 
 367 
 
335 
grid.newpage()
 368 
grid.newpage()
336 
vp <- viewport(mask=circleGrob(gp=gpar(fill="black")))
 369 
vp <- viewport(mask=devMask(circleGrob(gp=gpar(fill="black")),
- 
 
 370 
                            circleGrob(gp=gpar(col="white", fill="white"))))
337 
grid.group(rectGrob(gp=gpar(fill="grey"), vp=vp))
 371 
grid.group(rectGrob(gp=gpar(fill="grey"), vp=vp))
338 
HersheyLabel("group with grob with vp
 372 
HersheyLabel("group with grob with vp
339 
vp is viewport with mask
 373 
vp is viewport with mask
340 
result is grey circle")
 374 
result is grey circle")
341
375
Line 367... Line 401...
367 
               width=unit(1, "cm"), height=unit(1, "cm"),
 401 
               width=unit(1, "cm"), height=unit(1, "cm"),
368 
               extend="repeat")
 402 
               extend="repeat")
369 
grid.rect(gp=gpar(fill=pat))
 403 
grid.rect(gp=gpar(fill=pat))
370 
gt1 <- gTree(children=gList(rectGrob(width=.5, gp=gpar(fill=2)),
 404 
gt1 <- gTree(children=gList(rectGrob(width=.5, gp=gpar(fill=2)),
371 
                            rectGrob(height=.5, gp=gpar(fill=4))))
 405 
                            rectGrob(height=.5, gp=gpar(fill=4))))
372 
vp <- viewport(mask=rectGrob(gp=gpar(col=NA, fill=rgb(0,0,0,.7))))
 406 
vp <- viewport(mask=devMask(rectGrob(gp=gpar(col=NA, fill=rgb(0,0,0,.7))),
- 
 
 407 
                            rectGrob(gp=gpar(col=NA, fill=grey(.7)))))
373 
g1 <- groupGrob(gt1, vp=vp)
 408 
g1 <- groupGrob(gt1, vp=vp)
374 
gt2 <- gTree(children=gList(g1, segmentsGrob(gp=gpar(lwd=100))))
 409 
gt2 <- gTree(children=gList(g1, segmentsGrob(gp=gpar(lwd=100))))
375 
g2 <- groupGrob(gt2, vp=vp)
 410 
g2 <- groupGrob(gt2, vp=vp)
376 
grid.draw(g2)
 411 
grid.draw(g2)
377 
grid.rect(width=.8, height=.4, gp=gpar(col=NA, fill=rgb(1,1,1,.7)))
 412 
grid.rect(width=.8, height=.4, gp=gpar(col=NA, fill=rgb(1,1,1,.7)))