1#
2plot.SpatialPolygons <- function(x, col, border = par("fg"), add=FALSE,
3	xlim=NULL, ylim=NULL, xpd = NULL, density = NULL, angle = 45,
4	pbg=NULL, axes = FALSE, lty = par("lty"), ..., setParUsrBB=FALSE,
5        usePolypath=NULL, rule=NULL, bgMap = NULL) {
6
7	if (is.null(pbg))
8		pbg = par("bg") # transparent!
9	if (!is(x, "SpatialPolygons"))
10		stop("Not a SpatialPolygons object")
11        if (is.null(usePolypath)) usePolypath <- get_Polypath()
12        if (is.null(rule)) rule <- get_PolypathRule()
13
14	if (! add)
15		plot(as(x, "Spatial"), xlim=xlim, ylim=ylim, axes = axes,
16			..., setParUsrBB=setParUsrBB, bgMap = bgMap)
17
18	n <- length(slot(x, "polygons"))
19	if (length(border) != n)
20		border <- rep(border, n, n)
21	polys <- slot(x, "polygons")
22	pO <- slot(x, "plotOrder")
23	if (!is.null(density)) {
24		if (missing(col)) col <- par("fg")
25		if (length(col) != n) col <- rep(col, n, n)
26		if (length(density) != n)
27			density <- rep(density, n, n)
28		if (length(angle) != n)
29			angle <- rep(angle, n, n)
30		for (j in pO)
31			.polygonRingHoles(polys[[j]], border = border[j],
32			xpd = xpd, density = density[j], angle = angle[j],
33			col = col[j], pbg = pbg, lty=lty, ...)
34	} else {
35		if (missing(col)) col <- NA
36		if (length(col) != n) col <- rep(col, n, n)
37		for (j in pO)
38			.polygonRingHoles(polys[[j]], col=col[j],
39			border=border[j], xpd = xpd, pbg = pbg, lty=lty, ...,
40                        usePolypath=usePolypath, rule=rule)
41	}
42}
43
44setMethod("plot", signature(x = "SpatialPolygons", y = "missing"),
45	function(x, y, ...) plot.SpatialPolygons(x, ...))
46
47.polygonRingHoles <- function(Sr, col=NA, border=NULL, xpd=NULL, density=NULL,
48	angle=45, pbg, lty = par("lty"), ..., usePolypath=NULL,
49        rule=NULL) {
50	if (!is(Sr, "Polygons"))
51		stop("Not an Polygons object")
52        if (is.null(usePolypath)) usePolypath <- get_Polypath()
53        if (is.null(rule)) rule <- get_PolypathRule()
54	if (!is.null(density)) hatch <- TRUE
55	else hatch <- FALSE
56	pO <- slot(Sr, "plotOrder")
57	polys <- slot(Sr, "Polygons")
58
59	if (hatch) {
60	        for (i in pO) {
61			if (!slot(polys[[i]], "hole"))
62				.polygon(slot(polys[[i]], "coords"),
63					border = border, xpd = xpd,
64					density = density, angle = angle,
65					col=col, hatch=TRUE, lty=lty, ...)
66			else .polygon(slot(polys[[i]], "coords"),
67					border = border, xpd = xpd, col=pbg,
68					density = NULL, lty=lty, ...)
69		}
70        } else if (exists("polypath") && usePolypath) {
71            Srl <- as(Sr, "Lines")
72            crds <- coordinates(Srl)
73            if (length(crds) == 1) mcrds <- crds[[1]]
74            else {
75                NAr <- as.double(c(NA, NA))
76                crds1 <- lapply(crds, function(x) rbind(x, NAr))
77                mcrds <- do.call(rbind, crds1)
78                mcrds <- mcrds[-nrow(mcrds),]
79                rownames(mcrds) <- NULL
80            }
81            polypath(x=mcrds[,1], y=mcrds[,2], border=border, col=col,
82                lty=lty, rule=rule, xpd=xpd, ...)
83	} else {
84	        for (i in pO) {
85			if (!slot(polys[[i]], "hole"))
86				.polygon(slot(polys[[i]], "coords"),
87					border = border, xpd = xpd,
88					col=col, lty=lty, ...)
89			else .polygon(slot(polys[[i]], "coords"),
90				border = border, xpd = xpd, col=pbg, lty=lty,
91                                ...)
92		}
93	}
94}
95
96
97.polygon = function(x, y = NULL, density = NULL, angle = 45,
98	border = NULL, col = NA, lty = NULL, xpd = NULL, hatch=NA, ...) {
99	if (is.na(hatch)) polygon(x = x, y = y, border = border,
100		col = col, lty = lty, xpd = xpd, ...)
101	else polygon(x = x, y = y, density = density, angle = angle,
102		border = border, lty = lty, xpd = xpd, col=col, ...)
103}
104
105
106