m

Author: rhijmans

R/plot_add.R

@@ -77,23 +77,22 @@ add_box <- function(...) {
 	}
 }
 
+## adapted from graphics::grid 
+g.grid.at <- function (side, n, axp, usr2) {
+	if (is.null(n)) {
+		stopifnot(is.numeric(ax <- axp), length(ax) == 3L)
+		graphics::axTicks(side, axp=ax, usr=usr2, log=FALSE)
+	} else if (!is.na(n) && (n <- as.integer(n)) >= 1L) {
+		at <- seq.int(usr2[1L], usr2[2L], length.out = n + 1L)
+		at[-c(1L, n + 1L)]
+	}
+}
 
 add_grid <- function(nx=NULL, ny=nx, col="lightgray", lty="dotted", lwd=1) {
 
 	p <- unlist(get.clip())
 	reset.clip()
 
-	## adapted from graphics::grid 
-	g.grid.at <- function (side, n, axp, usr2) {
-		if (is.null(n)) {
-			stopifnot(is.numeric(ax <- axp), length(ax) == 3L)
-			graphics::axTicks(side, axp=ax, usr=usr2, log=FALSE)
-		} else if (!is.na(n) && (n <- as.integer(n)) >= 1L) {
-			at <- seq.int(usr2[1L], usr2[2L], length.out = n + 1L)
-			at[-c(1L, n + 1L)]
-		}
-	}
-
     atx <- if (is.null(nx) || (!is.na(nx) && nx >= 1)) 
         g.grid.at(1L, nx, axp=graphics::par("xaxp"), usr2 = p[1:2])
     aty <- if (is.null(ny) || (!is.na(ny) && ny >= 1)) 

R/plot_axes.R

@@ -1,7 +1,7 @@
 
 zebra <- function(cex=1, x=NULL, y=NULL, width=NULL, col=c("black", "white")) {
 
-	clip <- terra:::get.clip()
+	clip <- get.clip()
 	axs <- unlist(clip)[1:4]
 	if (is.null(width)) {
 		width <- rep(min(axs[2]-axs[1], axs[4]-axs[3]) / 100, 2) * cex
@@ -14,10 +14,12 @@ zebra <- function(cex=1, x=NULL, y=NULL, width=NULL, col=c("black", "white")) {
 	}
 
 	if (is.null(x)) {
-		x = graphics:::.grid.at(1L, NULL, log=FALSE, equilogs=TRUE, axp=par("xaxp"), usr2=par("usr")[1:2])
+		x <- g.grid.at(1L, NULL, axp=graphics::par("xaxp"), usr2=graphics::par("usr")[1:2])
+		#x = graphics::.grid.at(1L, NULL, log=FALSE, equilogs=TRUE, axp=par("xaxp"), usr2=par("usr")[1:2])
 	} 
 	if (is.null(y)) {
-		y = graphics:::.grid.at(2L, NULL, log=FALSE, equilogs=TRUE, axp=par("yaxp"), usr2=par("usr")[1:2])
+		y <- g.grid.at(2L, NULL, axp=graphics::par("yaxp"), usr2=graphics::par("usr")[1:2])
+		#y = graphics:::.grid.at(2L, NULL, log=FALSE, equilogs=TRUE, axp=par("yaxp"), usr2=par("usr")[1:2])
 	}
 
 	x <- sort(unique(c(axs[1:2], x)))
@@ -43,7 +45,7 @@ zebra <- function(cex=1, x=NULL, y=NULL, width=NULL, col=c("black", "white")) {
 	e <- c(axs[1] + width[1], axs[2] - width[1], axs[3] + width[2], axs[4] - width[2])
 	lines(ext(e), xpd=TRUE)
 	lines(ext(axs), xpd=TRUE)
-	try(terra:::set.clip(e, clip$geo))
+	try(set.clip(e, clip$geo))
 }
 
 

R/plot_scale.R

@@ -169,8 +169,8 @@ north <- function(xy=NULL, type=1, label="N", angle=0, d, head=0.1, xpd=TRUE, ..
 }
 
 draw_box <- function(xy, d, below, labels, box.col, cex=1, ...){
-	h <- strheight("A", cex=cex)
-	w <- c(strwidth(labels[1], cex=cex), strwidth(labels[length(labels)], cex=cex))
+	h <- graphics::strheight("A", cex=cex)
+	w <- c(graphics::strwidth(labels[1], cex=cex), graphics::strwidth(labels[length(labels)], cex=cex))
 	box.col <- rep(box.col, length.out=2)
 	b <- ifelse(isTRUE(nchar(below) > 1), 3.5, 1.5)
 	e <- c(xy[1]-1.5*w[1], xy[1]+d+w[2], xy[2]-b*h, xy[2]+3*h)
@@ -191,6 +191,7 @@ sbar <- function(d, xy=NULL, type="line", divs=2, below="", lonlat=NULL, labels,
 
 box=FALSE
 box.col=c("white", "black")
+box.adj=c(0,0,0,0)
 
 	stopifnot(type %in% c("line", "bar"))
 	pr <- graphics::par()
@@ -248,14 +249,12 @@ box.col=c("white", "black")
 				lines(rbind(c(xtick[i], xy[2]), c(xtick[i], xy[2]+tadd)), lwd=ceiling(lwd/2), xpd=TRUE, ...)
 			}
 		}
-		tadd <- max(strheight("0", cex=1)/5, tadd)
+		tadd <- max(graphics::strheight("0", cex=1)/5, tadd)
 		if (length(labels) == 1) labels =c("", labels, "")
 		add_text(xy[1]+c(0,dd/2,dd),xy[2]+tadd, labels=labels, xpd=xpd, adj=adj, halo=halo, col=col, ...)
 
 	} else if (type == "bar") {
 		stopifnot(divs > 0)
-
-
 		if (missing(adj)) {
 			adj <- c(0.5, -1)
 		}
@@ -268,6 +267,11 @@ box.col=c("white", "black")
 			if (box) draw_box(xy, dd, below, labels, box.col, ...)	
 
 			half <- xy[1] + dd / 2
+			if (halo) {
+				graphics::polygon(c(xy[1], xy[1], xy[1]+dd, xy[1]+dd), 
+								  c(xy[2], xy[2]+lwd, xy[2]+lwd, xy[2]), col="white", xpd=xpd, border="white", lwd=3)
+			}
+			
 			graphics::polygon(c(xy[1], xy[1], half, half), c(xy[2], xy[2]+lwd, xy[2]+lwd, xy[2]), col=fill[1], xpd=xpd, border=border)
 			graphics::polygon(c(half, half, xy[1]+dd, xy[1]+dd ), c(xy[2], xy[2]+lwd, xy[2]+lwd, xy[2]), col=fill[2], xpd=xpd, border=border)
 
@@ -297,9 +301,9 @@ box.col=c("white", "black")
 	if (below != "") {
 		adj[2] <- -adj[2]
 		if (type == "line") {
-			xy[2] <- xy[2] - strheight("1")/1.5
+			xy[2] <- xy[2] - graphics::strheight("1")/1.5
 		} else {
-			xy[2] <- xy[2] - strheight("1")/4		
+			xy[2] <- xy[2] - graphics::strheight("1")/4		
 		}
 		add_text(xy[1]+(dd/2), xy[2], xpd=xpd, labels=below, adj=adj, halo=halo, col=col, ...)
 	}

man/sbar.Rd

@@ -29,7 +29,7 @@ sbar(d, xy=NULL, type="line", divs=2, below="", lonlat=NULL, labels,
 \item{scaleby}{numeric. If \code{labels} is not provided. The labels are divided by this number. For example, use 1000 to go from m to km}
 \item{halo}{logical. If \code{TRUE} the "line" type scale bar gets a white background}
 \item{col}{the font color for the labels}
-\item{fill}{the fill color for the bar}
+\item{fill}{the fill color(s) for the bar}
 \item{border}{the color of the border around the bar}
 \item{...}{graphical arguments to be passed to other methods }
 }