1
2RS_locator <- function(n, type, id=FALSE, pch=20, ...) {
3# locator that also works in RStudio
4# Berry Boessenkool
5# https://stackoverflow.com/a/65147220/635245
6	on.exit(return(cbind(x, y)))
7	x <- y <- NULL
8	for (i in seq_len(n)) {
9		p <- graphics::locator(1)
10		if (is.null(p)) break # ESC
11		x <- c(x, p$x)
12		y <- c(y, p$y)
13		points(x, y, type=type, pch=pch, ...)
14		if (id) {
15			text(p$x, p$y, labels=i, pos=4, ...)
16		}
17	}
18}
19
20.drawPol <- function(n=1000, id=FALSE, ...) {
21	#xy <- graphics::locator(n=1000, type="l", col=col, lwd=lwd, ...)
22	#xy <- cbind(xy$x, xy$y)
23	xy <- RS_locator(n, "l", id=id, ...)
24	xy <- rbind(xy, xy[1,])
25	graphics::lines(xy[(length(xy[,1])-1):length(xy[,1]),], ...)
26	g <- cbind(1,1,xy,0)
27	vect(g, "polygons")
28}
29
30
31.drawLin <- function(n=1000, ...) {
32	#xy <- graphics::locator(n=1000, type="l", col=col, lwd=lwd, ...)
33	#xy <- cbind(xy$x, xy$y)
34	xy <- RS_locator(n, "l", ...)
35	g <- cbind(1,1,xy)
36	vect(g, "lines")
37}
38
39
40.drawPts <- function(n=1000, ...) {
41	#xy <- graphics::locator(n=1000, type="p", col=col, lwd=lwd, ...)
42	#xy <- cbind(xy$x, xy$y)
43	xy <- RS_locator(n, "p", ...)
44	g <- cbind(1:nrow(xy), 1, xy)
45	vect(g, "points")
46}
47
48.drawExt <- function(...) {
49	loc1 <- graphics::locator(n=1, type="p", pch="+", ...)
50	loc2 <- graphics::locator(n=1, type="p", pch="+", ...)
51	loc <- rbind(unlist(loc1), unlist(loc2))
52	e <- c(min(loc[,'x']), max(loc[,'x']), min(loc[,'y']), max(loc[,'y']))
53	if (e[1] == e[2]) {
54		e[1] <- e[1] - 0.0000001
55		e[2] <- e[2] + 0.0000001
56	}
57	if (e[3] == e[4]) {
58		e[3] <- e[3] - 0.0000001
59		e[4] <- e[4] + 0.0000001
60	}
61	p <- rbind(c(e[1], e[3]), c(e[1], e[4]), c(e[2], e[4]), c(e[2], e[3]), c(e[1], e[3]) )
62	graphics::lines(p, ...)
63	return(ext(e))
64}
65
66setMethod("draw", signature(x="character"),
67    function(x="extent", col="red", lwd=2, id=FALSE, n=1000, ...){
68		x <- match.arg(tolower(x), c("extent", "polygon", "lines", "points"))
69		if (x == "extent") {
70			.drawExt(col=col, lwd=lwd, ...)
71		} else if (x == "polygon") {
72			.drawPol(n, col=col, lwd=lwd, id=id, ...)
73		} else if (x == "lines") {
74			.drawLin(n, col=col, lwd=lwd, id=id, ...)
75		} else if (x == "points" || x == "multipoints" ) {
76			.drawPts(n, col=col, id=id, ...)
77		}
78	}
79)
80
81setMethod("draw", signature(x="missing"),
82    function(x="extent", ...){
83		draw("extent", ...)
84	}
85)
86