1
2.terra_environment <- new.env(parent=emptyenv())
3
4
5.create_options <- function() {
6	opt <- methods::new("SpatOptions")
7	opt@ptr <- SpatOptions$new()
8	# check=T does not exist in ancient R
9	tmpdir <- try(tempdir(check = TRUE), silent=TRUE)
10	opt@ptr$tempdir <- normalizePath(tempdir(), winslash="/")
11	.terra_environment$options <- opt
12}
13
14.options_names <- function() {
15	c("progress", "tempdir", "memfrac", "datatype", "filetype", "filenames", "overwrite", "todisk", "names", "verbose", "NAflag", "statistics", "steps", "ncopies", "tolerance") #, "append")
16}
17
18
19.setOptions <- function(x, wopt) {
20
21	nms <- names(wopt)
22
23	g <- which(nms == "gdal")
24	if (length(g) > 0) {
25		gopt <- unlist(wopt[g])
26		wopt <- wopt[-g]
27		nms <- nms[-g]
28		i <- grep("=", gopt)
29		gopt <- gopt[i]
30		gopt <- gsub(" ", "", gopt)
31		x$gdal_options <- gopt
32	}
33
34	s <- nms %in% .options_names()
35
36	if (any(!s)) {
37		bad <- paste(nms[!s], collapse=",")
38		error("write", "unknown option(s): ", bad)
39	}
40
41	if (any(s)) {
42		nms <- nms[s]
43		wopt <- wopt[s]
44		i <- which(nms == "names")
45		if (length(i) > 0) {
46			namevs <- trimws(unlist(strsplit(wopt[[i]], ",")))
47			x[["names"]] <- namevs
48			wopt <- wopt[-i]
49			nms <- nms[-i]
50		}
51
52		for (i in seq_along(nms)) {
53			x[[nms[i]]] <- wopt[[i]]
54		}
55		if ("datatype" %in% nms) {
56			x$datatype_set = TRUE;
57		}
58	}
59
60	x
61}
62
63defaultOptions <- function() {
64	## work around onLoad problem
65	if (is.null(.terra_environment$options)) .create_options()
66	.terra_environment$options@ptr$deepcopy()
67}
68
69spatOptions <- function(filename="", overwrite=FALSE, ..., wopt=NULL) {
70
71	wopt <- c(list(...), wopt)
72
73	## work around onLoad problem
74	if (is.null(.terra_environment$options)) .create_options()
75
76	opt <- .terra_environment$options@ptr$deepcopy()
77
78	filename <- .fullFilename(filename, mustExist=FALSE)
79	if (!is.null(unlist(wopt))) {
80		wopt$filenames <- filename
81		wopt$overwrite <- overwrite[1]
82		opt <- .setOptions(opt, wopt)
83	} else {
84		opt$filenames <- filename
85		opt$overwrite <- overwrite[1]
86	}
87	#messages(opt)
88	#opt$todisk <- TRUE
89	opt
90}
91
92#..getOptions <- function() {
93#	spatOptions("", TRUE, list())
94#}
95
96#..showOptions <- function(opt) {
97#	cat("Options for package 'terra'\n")
98#	cat("memfrac     :" , opt$memfrac, "\n")
99#	cat("tempdir     :" , opt$tempdir, "\n")
100#	cat("datatype    :" , opt$def_datatype, "\n")
101#	cat("filetype    :" , opt$def_filetype, "\n")
102#	cat("progress    :" , opt$progress, "\n")
103#	cat("verbose     :" , opt$verbose, "\n")
104#	if (opt$todisk) {
105#		cat("todisk      :" , opt$todisk, "\n")
106#	}
107#}
108
109.showOptions <- function(opt) {
110	nms <- c("memfrac", "tempdir", "datatype", "progress", "todisk", "verbose", "tolerance")
111	for (n in nms) {
112		v <- eval(parse(text=paste0("opt$", n)))
113		cat(paste0(substr(paste(n, "         "), 1, 10), ": ", v, "\n"))
114	}
115}
116
117
118.default_option_names <- function() {
119	c("datatype", "filetype") #, "verbose")
120}
121
122
123
124terraOptions <- function(...) {
125	dots <- list(...)
126	if (is.null(.terra_environment$options)) .create_options()
127	opt <- .terra_environment$options@ptr
128	if (length(dots) == 0) {
129		.showOptions(opt)
130	} else {
131		nms <- names(dots)
132		d <- nms %in% .default_option_names()
133		dnms <- paste0("def_", nms)
134		for (i in 1:length(nms)) {
135			if (d[i]) {
136				opt[[ dnms[i] ]] <- dots[[ i ]]
137			} else {
138				opt[[ nms[i] ]] <- dots[[ i ]]
139			}
140		}
141		if ("memfrac" %in% nms) {
142			if (dots$memfrac > 0.9) {
143				warn("terraOptions", "memfrac > 0.9")
144			}
145		}
146		.terra_environment$options@ptr <- opt
147	}
148}
149
150