1# Author: Robert J. Hijmans
2# Date :  May 2009
3# Version 0.9
4# Licence GPL v3
5
6
7.fileSaveDialog <- function(filetypes="") {
8	if (! requireNamespace("tcltk") ) {
9		stop('you need to install the tcltk library')
10	}
11	if (filetypes == "") {
12		filetypes="{{GeoTIFF} {.tif} } {{grid files} {.grd}}"
13	}
14	tcltk::tclvalue(tcltk::tkgetSaveFile(filetypes=filetypes))
15}
16
17.fileOpenDialog <- function(filetypes="") {
18	if (! requireNamespace("tcltk") ) {
19		stop('you need to install the tcltk library')
20	}
21	if (filetypes == "") {
22		filetypes="{{All Files} *} {{GeoTIFF} {.tif} } {{grid files} {.grd}}"
23	}
24	tcltk::tclvalue(tcltk::tkgetOpenFile(filetypes=filetypes))
25}
26
27
28.old_rasterTmpFile <- function(prefix='raster_tmp_')  {
29	f <- getOption('rasterTmpFile')
30	if (!is.null(f)) {
31		f <- trim(f)
32		if (! f == '' ) {
33			options('rasterTmpFile' = NULL)
34			return(f)
35		}
36	}
37
38	extension <- .defaultExtension(.filetype())
39	d <- tmpDir(create=TRUE)
40#	dir.create(d,  showWarnings = FALSE)
41	f <- paste(round(stats::runif(10)*10), collapse="")
42	d <- paste(d, prefix, f, extension, sep="")
43	if (file.exists(d)) {
44		d <- rasterTmpFile(prefix=prefix)
45	}
46	if (getOption('verbose')) { cat('writing raster to:', d) }
47	return(d)
48}
49
50
51
52
53rasterTmpFile <- function(prefix='r_tmp_')  {
54	f <- getOption('rasterTmpFile')
55	if (!is.null(f)) {
56		f <- trim(f)
57		if (! f == '' ) {
58			options('rasterTmpFile' = NULL)
59			return(f)
60		}
61	}
62
63	extension <- .defaultExtension(.filetype())
64	d <- tmpDir()
65
66	while(TRUE) {
67	# added pid as suggested by Daniel Schlaepfer to avoid overlapping file names when running parallel processes and using set.seed() in each node
68		f <- paste(prefix, gsub(" ", "_", gsub(":", "", as.character(Sys.time()))), "_", Sys.getpid(), "_", paste(sample(0:9,5,replace=TRUE),collapse=''), extension, sep = "")
69		tmpf <- normalizePath(file.path(d, f), winslash = "/", mustWork=FALSE)
70		if (! file.exists(tmpf)) {
71			break
72		}
73	}
74
75	if (getOption('verbose')) {
76		cat('writing raster to:', tmpf)
77	}
78	return(tmpf)
79}
80
81
82.removeTrailingSlash <- function(d) {
83		if (substr(d, nchar(d), nchar(d)) == '/') { d <- substr(d, 1, nchar(d)-1) }
84		if (substr(d, nchar(d), nchar(d)) == '\\') { d <- substr(d, 1, nchar(d)-1) }
85		return(d)
86}
87
88
89removeTmpFiles <- function(h=24) {
90
91# remove files in the temp folder that are > h hours old
92	warnopt <- getOption('warn')
93	on.exit(options('warn'= warnopt))
94
95	tmpdir <- tmpDir(create=FALSE)
96	if (!is.na(tmpdir)) {
97
98		d <- .removeTrailingSlash(tmpdir)
99		f <- list.files(path=d, pattern='r_tmp*', full.names=TRUE, include.dirs=TRUE)
100#		f <- list.files(path=d, pattern='[.]gr[di]', full.names=TRUE, include.dirs=TRUE)
101		fin <- file.info(f)
102		dif <- Sys.time() - fin$mtime
103		dif <- as.numeric(dif, units="hours")
104
105		f <- f[which(dif > h)]
106		unlink(f, recursive=TRUE)
107	}
108	options('warn'=warnopt)
109}
110
111
112
113showTmpFiles <- function() {
114	f <- NULL
115	tmpdir <- tmpDir(create=FALSE)
116	if (!is.na(tmpdir)) {
117		d <- .removeTrailingSlash(tmpdir)
118		if (file.exists(d)) {
119			f <- list.files(d, pattern='r_tmp_')
120			#f <- list.files(d, pattern='\\.gri$')
121			if (length(f) == 0) {
122				cat('--- none ---\n')
123			} else {
124				ff <- f
125				extension(ff) <- ''
126				ff <- paste(unique(ff), '\n', sep='')
127				cat(ff)
128			}
129		} else {
130			cat('--- none ---\n')
131		}
132	} else {
133		cat('--- none ---\n')
134	}
135	invisible(f)
136}
137
138