Nothing
#' @title shinygui_saveopts
#' @description Helper function used to retrieve options from shiny widgets
#' @noRd
# retrieve inputs from shiny widgets ----
shinygui_saveopts <- function(input, prod_opt_list, rv) {
#nocov start
opts <- list()
opts$selcat <- input$selcat
opts$selprod <- input$selprod
# retrieve product options
opts$prod_version <- input$selver
opts$sensor <- input$selplat
opts$bandsel <- if(is.null(input$sel_layers)) {
NA
} else {
input$sel_layers
}
opts$quality_bandsel <- if(is.null(input$sel_qual)) {
NA
} else {
input$sel_qual
}
opts$indexes_bandsel <- if(is.null(input$sel_ind)) {
NA
} else {
input$sel_ind
}
if (all(is.na(c(opts$bandsel, opts$quality_bandsel ,opts$indexes_bandsel)))) {
return("Please select at least one product layer, quality layer or spectral index!")
}
# Retrieve download method and authentication ----
opts$download_server <- input$down_meth
opts$user <- input$user
opts$password <- input$password
if (opts$download_server == "http" & any((c(opts$user, opts$password) == ""))) {
return("Please provide your earthdata username and password!")
}
opts$downloader <- input$downloader
opts$download_range <- input$download_range
#
# # Retrieve dates ----
opts$start_date <- gsub("-", ".", input$proc_dates[1])
opts$end_date <- gsub("-", ".", input$proc_dates[2])
opts$spatmeth <- input$spatmeth
# # Retrieve Tiles options ----
if (input$spatmeth == "tiles") {
opts$start_x <- input$xmintile
opts$end_x <- input$xmaxtile
opts$start_y <- input$ymintile
opts$end_y <- input$ymaxtile
opts$bbox <- c(NA, NA, NA, NA)
} else {
tiles <- tiles_from_bbox(rv$outbbox, input$outprojtxt)
opts$start_x <- tiles["xmintile"]
opts$end_x <- tiles["xmaxtile"]
opts$start_y <- tiles["ymintile"]
opts$end_y <- tiles["ymaxtile"]
opts$bbox <- as.numeric(rv$outbbox)
}
# Retrieve spatial file ----
if (input$spatmeth == "file") {
opts$spafile <- input$spafiletxt
} else {
opts$spafile <- NA
}
# Retrieve drawn extent ----
if (input$spatmeth == "map") {
opts$drawnext <- geojsonio::geojson_json(
st_transform(rv$drawn_extent, 4326),
pretty = TRUE
)
} else {
opts$drawnext <- NA
}
# # Retrieve projection options ----
opts$out_projsel <- input$out_projsel
opts$output_proj <- input$outprojtxt
opts$out_res_sel <- input$outressel
opts$out_res <- input$outres
opts$resampling <- input$resampmeth
# # Retrieve reprocess, delete and nodata ----
opts$reprocess <- ifelse(input$reprocess == "No", FALSE, TRUE)
opts$delete_hdf <- ifelse(input$delete_hdf == "No", FALSE, TRUE)
opts$nodata_change <- ifelse(input$nodata == "No", FALSE, TRUE)
opts$scale_val <- ifelse(input$scaleoff == "No", FALSE, TRUE)
# Retrieve format, virtual and compression
opts$out_format <- input$out_format
opts$ts_format <- input$time_series
opts$compress <- input$compress
# Retrieve Folder options
opts$out_folder <- input$out_folder_txt
opts$out_folder_mod <- input$out_hdffolder_txt
if (any(c(opts$out_folder, opts$out_folder_mod) == "")) {
return("Please provide output folder names")
}
if (opts$out_folder_mod == "$tempdir"){
opts$out_folder_mod <- file.path(tempdir(), "MODIStsp/HDF")
dir.create(dirname(opts$out_folder_mod), showWarnings = FALSE)
dir.create(opts$out_folder_mod, showWarnings = FALSE)
}
# #- Perform checks on options consistency ---------------
#
# # check that the selected product is available on the selected server
# #
http <- prod_opt_list[[opts$selprod]][[opts$prod_version]]$http
#
if (opts$sensor == "Both") {
http <- c(http["Terra"][[1]], http["Aqua"][[1]])
} else {
if (opts$sensor == "Combined") {
http <- http[[1]]
} else {
http <- http[opts$sensor][[1]]
if (opts$download_server == "http" &
http == "Not Available" &
opts$sensor == "Aqua") {
return("The selected product is only available for the Terra sensor. Please switch sensor!")
}
}
}
opts$MODIStspVersion <- as.character(packageVersion("MODIStsp"))
return(opts)
#nocov end
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.