1# Author: Robert J. Hijmans
2# Date :  July 2010
3# Version 0.9
4# Licence GPL v3
5
6
7.plotCT <- function(x, maxpixels=500000, ext=NULL, interpolate=FALSE, axes, main, xlab='', ylab='', asp, add=FALSE, addfun=NULL, zlim=NULL, zlimcol=NULL, ...) {
8# plotting with a color table
9
10   if (missing(main)) {
11        main <- ''
12    }
13
14	#sethook <- FALSE
15	if (!add) {
16		graphics::plot.new()
17		if (missing(axes)) {
18			axes <- FALSE
19		}
20		if (!axes) {
21			# if (main != "") { } else {
22			old.par <- graphics::par(no.readonly = TRUE)
23			#graphics::par(plt=c(0,1,0,1))
24			graphics::par(mar=c(0,0,0,0), xaxs='i',yaxs='i')
25
26			#sethook <- TRUE
27		}
28		if (missing(asp)) {
29			if (couldBeLonLat(x)) {
30				ym <- mean(c(x@extent@ymax, x@extent@ymin))
31				asp <- 1/cos((ym * pi)/180)
32			} else {
33				asp <- 1
34			}
35		}
36	}
37	coltab <- colortable(x)
38	x <- sampleRegular(x, maxpixels, ext=ext, asRaster=TRUE, useGDAL=TRUE)
39	z <- getValues(x)
40
41
42	if (!is.null(zlim)) { # not that relevant here, but for consistency....
43		if (is.null(zlimcol)) {
44			z[ z<zlim[1] ] <- zlim[1]
45			z[ z>zlim[2] ] <- zlim[2]
46		} else { #if (is.na(zlimcol)) {
47			z[z<zlim[1] | z>zlim[2]] <- NA
48		}
49	}
50
51
52	if (NCOL(coltab) == 2) {
53		# not implemented
54		z <- as.numeric(cut(z, coltab[,1]))
55		coltab <- as.vector(coltab[,2])
56	}
57
58	z <- z + 1
59	z[is.na(z)] <- 1
60	if (! is.null(coltab) ) {
61		z <- matrix(coltab[z], nrow=nrow(x), ncol=ncol(x), byrow=T)
62		z <- as.raster(z)
63	} else {
64		z <- matrix(z, nrow=nrow(x), ncol=ncol(x), byrow=T)
65		z <- as.raster(z, max=max(z)) #, na.rm=TRUE))
66	}
67
68	requireNamespace("grDevices")
69	bb <- as.vector(extent(x))
70
71
72	if (! add) {
73		plot(c(bb[1], bb[2]), c(bb[3], bb[4]), type = "n", xlab=xlab, ylab=ylab, asp=asp, axes=axes, main=main, ...)
74	}
75	graphics::rasterImage(z, bb[1], bb[3], bb[2], bb[4], interpolate=interpolate, ...)
76
77	if (!is.null(addfun)) {
78		if (is.function(addfun)) {
79			addfun()
80		}
81	}
82
83	#if (sethook) {
84	#	setHook("plot.new", function(...) {
85	#	    graphics::par(old.par)
86	#		setHook("plot.new", function(...) setHook("plot.new", NULL, "replace"))
87	#	}, 	action="replace")
88	#}
89}
90
91
92