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