SpatialInterpPanelCmd <- function(){
listOpenFiles <- openFile_ttkcomboList()
if(WindowsOS()){
largeur0 <- 20
largeur1 <- 32
largeur2 <- 34
largeur3 <- 14
largeur4 <- 20
largeur5 <- 11
largeur6 <- 30
largeur7 <- 38
}else{
largeur0 <- 23
largeur1 <- 32
largeur2 <- 33
largeur3 <- 14
largeur4 <- 20
largeur5 <- 11
largeur6 <- 30
largeur7 <- 38
}
###################
date.range <- list(start.year = 2021, start.mon = 1, start.dek = 1,
start.pen = 1, start.day = 1,
start.hour = 0, start.min = 0,
end.year = 2021, end.mon = 1, end.dek = 1,
end.pen = 1, end.day = 1,
end.hour = 0, end.min = 0)
GeneralParameters <- list(intstep = "daily", minhour = 1,
cdtstation = "", date.range = date.range, outdir = "",
grid = list(from = 'ncdf', ncfile = "",
bbox = c(.cdtData$Config$region, reslon = 0.1, reslat = 0.1)),
interp = list(method = "idw", nmin = 8, nmax = 16,
maxdist = 3.5, use.block = TRUE, minstn = 10,
vgm.model = c("Sph", "Exp", "Gau", "Pen"),
demfile = "",
auxvar = list(dem = TRUE, slope = FALSE, aspect = FALSE,
lon = FALSE, lat = FALSE)
),
negative = list(set = FALSE, value = 0),
blank = list(blank = FALSE, shpf = ""),
date = list(year = 2021, mon = 1, day = 1,
hour = 1, min = 0, other = ""))
pointSizeI <- 1.0
.cdtData$EnvData$dataMapOp <- list(presetCol = list(color = 'tim.colors', reverse = FALSE),
userCol = list(custom = FALSE, color = NULL),
userLvl = list(custom = FALSE, levels = NULL, equidist = FALSE),
title = list(user = FALSE, title = ''),
colkeyLab = list(user = FALSE, label = ''),
pointCol = 'black',
pointSize = pointSizeI)
.cdtData$EnvData$SHPOp <- list(col = "black", lwd = 1.5)
###################
xml.dlg <- file.path(.cdtDir$dirLocal, "languages", "cdtSpatialInterp_leftCmd.xml")
lang.dlg <- cdtLanguageParse(xml.dlg, .cdtData$Config$lang.iso)
.cdtData$EnvData$message <- lang.dlg[['message']]
###################
.cdtEnv$tcl$main$cmd.frame <- tkframe(.cdtEnv$tcl$main$panel.left)
tknote.cmd <- bwNoteBook(.cdtEnv$tcl$main$cmd.frame)
cmd.tab1 <- bwAddTab(tknote.cmd, text = lang.dlg[['tab_title']][['1']])
cmd.tab2 <- bwAddTab(tknote.cmd, text = lang.dlg[['tab_title']][['2']])
cmd.tab3 <- bwAddTab(tknote.cmd, text = lang.dlg[['tab_title']][['3']])
bwRaiseTab(tknote.cmd, cmd.tab1)
tkgrid.columnconfigure(cmd.tab1, 0, weight = 1)
tkgrid.columnconfigure(cmd.tab2, 0, weight = 1)
tkgrid.columnconfigure(cmd.tab3, 0, weight = 1)
tkgrid.rowconfigure(cmd.tab1, 0, weight = 1)
tkgrid.rowconfigure(cmd.tab2, 0, weight = 1)
tkgrid.rowconfigure(cmd.tab3, 0, weight = 1)
#######################################################################################################
date.time.selection <- function(intstep, frTS1){
if(intstep == 'others'){
txt.other <- tklabel(frTS1, text = lang.dlg[['label']][['1']])
cb.other <<- ttkcombobox(frTS1, values = "", textvariable = date.other, width = largeur6)
tkgrid(txt.other, row = 0, column = 0, sticky = 'we', pady = 1, padx = 1)
tkgrid(cb.other, row = 1, column = 0, sticky = 'we', pady = 1, padx = 1)
}else{
txtdek <- switch(intstep,
'dekadal' = lang.dlg[['label']][['4']],
'pentad' = lang.dlg[['label']][['5']],
lang.dlg[['label']][['6']])
day.txtVar <- tclVar(txtdek)
stateday <- if(intstep == 'monthly') 'disabled' else 'normal'
statehour <- if(intstep %in% c('minute', 'hourly')) 'normal' else 'disabled'
statemin <- if(intstep == 'minute') 'normal' else 'disabled'
txt.yrs <- tklabel(frTS1, text = lang.dlg[['label']][['2']])
txt.mon <- tklabel(frTS1, text = lang.dlg[['label']][['3']])
txt.day <- tklabel(frTS1, text = tclvalue(day.txtVar), textvariable = day.txtVar)
txt.hrs <- tklabel(frTS1, text = lang.dlg[['label']][['7']])
txt.min <- tklabel(frTS1, text = lang.dlg[['label']][['8']])
en.yrs <- tkentry(frTS1, width = 5, textvariable = date.year, justify = "center")
en.mon <- tkentry(frTS1, width = 5, textvariable = date.mon, justify = "center")
en.day <- tkentry(frTS1, width = 5, textvariable = date.day, justify = "center", state = stateday)
en.hrs <- tkentry(frTS1, width = 5, textvariable = date.hour, justify = "center", state = statehour)
en.min <- tkentry(frTS1, width = 5, textvariable = date.min, justify = "center", state = statemin)
##############
tkgrid(txt.yrs, row = 0, column = 0, sticky = 'we', pady = 1, padx = 1)
tkgrid(txt.mon, row = 0, column = 1, sticky = 'we', pady = 1, padx = 1)
tkgrid(txt.day, row = 0, column = 2, sticky = 'we', pady = 1, padx = 1)
tkgrid(txt.hrs, row = 0, column = 3, sticky = 'we', pady = 1, padx = 1)
tkgrid(txt.min, row = 0, column = 4, sticky = 'we', pady = 1, padx = 1)
tkgrid(en.yrs, row = 1, column = 0, sticky = 'we', pady = 1, padx = 1)
tkgrid(en.mon, row = 1, column = 1, sticky = 'we', pady = 1, padx = 1)
tkgrid(en.day, row = 1, column = 2, sticky = 'we', pady = 1, padx = 1)
tkgrid(en.hrs, row = 1, column = 3, sticky = 'we', pady = 1, padx = 1)
tkgrid(en.min, row = 1, column = 4, sticky = 'we', pady = 1, padx = 1)
}
}
format.dates.times <- function(intstep, yrs, mon, dpk, hrs, min){
switch(intstep,
"minute" = paste(yrs, mon, dpk, hrs, min, sep = '-'),
"hourly" = paste(yrs, mon, dpk, hrs, sep = '-'),
"daily" = paste(yrs, mon, dpk, sep = '-'),
"pentad" = local({
if(is.na(dpk) | dpk < 1 | dpk > 6){
msg <- lang.dlg[['message']][['1']]
Insert.Messages.Out(msg, TRUE, "e")
return(NULL)
}
paste(yrs, mon, dpk, sep = '-')
}),
"dekadal" = local({
if(is.na(dpk) | dpk < 1 | dpk > 3){
msg <- lang.dlg[['message']][['2']]
Insert.Messages.Out(msg, TRUE, "e")
return(NULL)
}
paste(yrs, mon, dpk, sep = '-')
}),
"monthly" = paste(yrs, mon, 1, sep = '-')
)
}
set.dates.times <- function(incr, intstep){
yrs <- as.numeric(trimws(tclvalue(date.year)))
mon <- as.numeric(trimws(tclvalue(date.mon)))
dpk <- as.numeric(trimws(tclvalue(date.day)))
hrs <- as.numeric(trimws(tclvalue(date.hour)))
min <- as.numeric(trimws(tclvalue(date.min)))
todaty <- format.dates.times(intstep, yrs, mon, dpk, hrs, min)
if(is.null(todaty)) return(NULL)
daty <- try(switch(intstep,
"minute" = as.POSIXct(todaty, format = "%Y-%m-%d-%H-%M"),
"hourly" = as.POSIXct(todaty, format = "%Y-%m-%d-%H"),
as.Date(todaty)
), silent = TRUE)
if(inherits(daty, "try-error") | is.na(daty)){
msg <- paste(lang.dlg[['message']][['3']], todaty)
Insert.Messages.Out(msg, TRUE, "e")
return(NULL)
}
minhour <- as.numeric(trimws(tclvalue(minhour.tclVar)))
daty <- switch(intstep,
"minute" = daty + incr * minhour * 60,
"hourly" = daty + incr * minhour * 3600,
"daily" = daty + incr,
"pentad" = addPentads(daty, incr),
"dekadal" = addDekads(daty, incr),
"monthly" = addMonths(daty, incr)
)
return(daty)
}
#######################################################################################################
#Tab1
subfr1 <- bwTabScrollableFrame(cmd.tab1)
#######################
frameCDTdata <- ttklabelframe(subfr1, text = lang.dlg[['label']][['9']], relief = 'groove')
timeSteps <- tclVar()
CbperiodVAL <- .cdtEnv$tcl$lang$global[['combobox']][['1']][c(1:6, 10)]
periodVAL <- c('minute', 'hourly', 'daily', 'pentad', 'dekadal', 'monthly', 'others')
tclvalue(timeSteps) <- CbperiodVAL[periodVAL %in% GeneralParameters$intstep]
input.file <- tclVar(GeneralParameters$cdtstation)
retminhr <- set.hour.minute(GeneralParameters$intstep, GeneralParameters$minhour)
minhour.tclVar <- tclVar(retminhr$val)
txt.cdtdata1 <- tklabel(frameCDTdata, text = lang.dlg[['label']][['10']], anchor = 'w', justify = 'left')
cb.cdtdata1 <- ttkcombobox(frameCDTdata, values = CbperiodVAL, textvariable = timeSteps, width = largeur0)
cb.minhour <- ttkcombobox(frameCDTdata, values = retminhr$cb, textvariable = minhour.tclVar, state = retminhr$state, width = 2)
txt.cdtdata2 <- tklabel(frameCDTdata, text = lang.dlg[['label']][['11']], anchor = 'w', justify = 'left')
cb.cdtdata2 <- ttkcombobox(frameCDTdata, values = unlist(listOpenFiles), textvariable = input.file, width = largeur1)
bt.cdtdata <- tkbutton(frameCDTdata, text = "...")
############
tkgrid(txt.cdtdata1, row = 0, column = 0, sticky = 'we', rowspan = 1, columnspan = 2, padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(cb.cdtdata1, row = 0, column = 2, sticky = 'we', rowspan = 1, columnspan = 6, padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(cb.minhour, row = 0, column = 8, sticky = 'we', rowspan = 1, columnspan = 2, padx = 0, pady = 1, ipadx = 1, ipady = 1)
tkgrid(txt.cdtdata2, row = 1, column = 0, sticky = 'we', rowspan = 1, columnspan = 10, padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(cb.cdtdata2, row = 2, column = 0, sticky = 'we', rowspan = 1, columnspan = 9, padx = 0, pady = 1, ipadx = 1, ipady = 1)
tkgrid(bt.cdtdata, row = 2, column = 9, sticky = 'we', rowspan = 1, columnspan = 1, padx = 0, pady = 1, ipadx = 1, ipady = 1)
############
tkconfigure(bt.cdtdata, command = function(){
dat.opfiles <- getOpenFiles(.cdtEnv$tcl$main$win)
if(!is.null(dat.opfiles)){
update.OpenFiles('ascii', dat.opfiles)
listOpenFiles[[length(listOpenFiles) + 1]] <<- dat.opfiles[[1]]
tclvalue(input.file) <- dat.opfiles[[1]]
lapply(list(cb.cdtdata2, cb.blankgrid, cb.addshp), tkconfigure, values = unlist(listOpenFiles))
}
})
############
tkbind(cb.cdtdata1, "<<ComboboxSelected>>", function(){
tkdestroy(frTS1)
frTS1 <<- tkframe(frTS0)
intstep <- periodVAL[CbperiodVAL %in% trimws(tclvalue(timeSteps))]
date.time.selection(intstep, frTS1)
tkgrid(frTS1, row = 0, column = 1, sticky = 'we', pady = 1, rowspan = 2, columnspan = 1)
##############
minhour <- as.numeric(trimws(tclvalue(minhour.tclVar)))
retminhr <- set.hour.minute(intstep, minhour)
tkconfigure(cb.minhour, values = retminhr$cb, state = retminhr$state)
tclvalue(minhour.tclVar) <- retminhr$val
##############
statedate <- if(intstep == "others") "disabled" else "normal"
tkconfigure(btDateRange, state = statedate)
})
##############################################
statedate <- if(GeneralParameters$intstep == "others") "disabled" else "normal"
btDateRange <- ttkbutton(subfr1, text = lang.dlg[['button']][['1']], state = statedate)
btInterpMthd <- ttkbutton(subfr1, text = lang.dlg[['button']][['2']])
btGridInterp <- ttkbutton(subfr1, text = lang.dlg[['button']][['3']])
helpWidget(btDateRange, lang.dlg[['tooltip']][['1']], lang.dlg[['status']][['1']])
helpWidget(btInterpMthd, lang.dlg[['tooltip']][['2']], lang.dlg[['status']][['2']])
helpWidget(btGridInterp, lang.dlg[['tooltip']][['3']], lang.dlg[['status']][['3']])
############
tkconfigure(btDateRange, command = function(){
intstep <- periodVAL[CbperiodVAL %in% trimws(tclvalue(timeSteps))]
GeneralParameters[["date.range"]] <<- getInfoDateRange(.cdtEnv$tcl$main$win,
GeneralParameters[["date.range"]],
intstep)
})
tkconfigure(btInterpMthd, command = function(){
GeneralParameters[["interp"]] <<- getInterpolationPars2(.cdtEnv$tcl$main$win,
GeneralParameters[["interp"]])
})
tkconfigure(btGridInterp, command = function(){
GeneralParameters[["grid"]] <<- createGridInterpolation(.cdtEnv$tcl$main$win,
GeneralParameters[["grid"]],
group = 2)
})
##############################################
frameNegVal <- tkframe(subfr1)
set.neg.value <- tclVar(GeneralParameters$negative$set)
val.neg.value <- tclVar(GeneralParameters$negative$value)
statenegval <- if(GeneralParameters$negative$set) "normal" else "disabled"
chk.negval <- tkcheckbutton(frameNegVal, variable = set.neg.value, text = lang.dlg[['checkbutton']][['1']], anchor = 'w', justify = 'left')
en.negval <- tkentry(frameNegVal, textvariable = val.neg.value, width = 4, state = statenegval)
tkgrid(chk.negval, row = 0, column = 0, sticky = 'we', pady = 1, ipadx = 1, ipady = 1)
tkgrid(en.negval, row = 0, column = 1, sticky = 'w', pady = 1, ipadx = 1, ipady = 1)
tkbind(chk.negval, "<Button-1>", function(){
if(tclvalue(interpData) == '0'){
statenegval <- if(tclvalue(set.neg.value) == "0") 'normal' else 'disabled'
}else statenegval <- 'disabled'
tkconfigure(en.negval, state = statenegval)
})
##############################################
frameBlank <- tkframe(subfr1, relief = 'groove', borderwidth = 2)
blankGrid <- tclVar(GeneralParameters$blank$blank)
file.blankShp <- tclVar(GeneralParameters$blank$shpf)
stateSHP <- if(GeneralParameters$blank$blank) "normal" else "disabled"
chk.blankgrid <- tkcheckbutton(frameBlank, variable = blankGrid, text = lang.dlg[['checkbutton']][['2']], anchor = 'w', justify = 'left')
cb.blankgrid <- ttkcombobox(frameBlank, values = unlist(listOpenFiles), textvariable = file.blankShp, width = largeur1, state = stateSHP)
bt.blankgrid <- tkbutton(frameBlank, text = "...", state = stateSHP)
########
tkgrid(chk.blankgrid, row = 0, column = 0, sticky = 'we', rowspan = 1, columnspan = 6, padx = 1, pady = 1)
tkgrid(cb.blankgrid, row = 1, column = 0, sticky = 'we', rowspan = 1, columnspan = 5, padx = 1, pady = 1)
tkgrid(bt.blankgrid, row = 1, column = 7, sticky = 'we', rowspan = 1, columnspan = 1, padx = 0, pady = 1)
########
tkconfigure(bt.blankgrid, command = function(){
shp.opfiles <- getOpenShp(.cdtEnv$tcl$main$win)
if(!is.null(shp.opfiles)){
update.OpenFiles('shp', shp.opfiles)
tclvalue(file.blankShp) <- shp.opfiles[[1]]
listOpenFiles[[length(listOpenFiles) + 1]] <<- shp.opfiles[[1]]
lapply(list(cb.cdtdata2, cb.blankgrid, cb.addshp), tkconfigure, values = unlist(listOpenFiles))
}
})
tkbind(chk.blankgrid, "<Button-1>", function(){
if(tclvalue(interpData) == '0'){
stateSHP <- if(tclvalue(blankGrid) == "1") "disabled" else "normal"
}else stateSHP <- "disabled"
tkconfigure(cb.blankgrid, state = stateSHP)
tkconfigure(bt.blankgrid, state = stateSHP)
})
##############################################
frameDirSav <- tkframe(subfr1, relief = 'groove', borderwidth = 2)
dir.save <- tclVar(GeneralParameters$outdir)
txt.dir.save <- tklabel(frameDirSav, text = lang.dlg[['label']][['12']], anchor = 'w', justify = 'left')
en.dir.save <- tkentry(frameDirSav, textvariable = dir.save, width = largeur2)
bt.dir.save <- tkbutton(frameDirSav, text = "...")
######
tkconfigure(bt.dir.save, command = function(){
fileORdir2Save(dir.save, isFile = FALSE)
})
######
tkgrid(txt.dir.save, row = 0, column = 0, sticky = 'we', rowspan = 1, columnspan = 5, padx = 1, pady = 0, ipadx = 1, ipady = 1)
tkgrid(en.dir.save, row = 1, column = 0, sticky = 'we', rowspan = 1, columnspan = 4, padx = 0, pady = 0, ipadx = 1, ipady = 1)
tkgrid(bt.dir.save, row = 1, column = 4, sticky = 'we', rowspan = 1, columnspan = 1, padx = 0, pady = 0, ipadx = 1, ipady = 1)
helpWidget(en.dir.save, lang.dlg[['tooltip']][['4']], lang.dlg[['status']][['4']])
helpWidget(bt.dir.save, lang.dlg[['tooltip']][['5']], lang.dlg[['status']][['5']])
##############################################
btInterpolate <- ttkbutton(subfr1, text = lang.dlg[['button']][['4']])
tkconfigure(btInterpolate, command = function(){
GeneralParameters$intstep <- periodVAL[CbperiodVAL %in% trimws(tclvalue(timeSteps))]
GeneralParameters$negative$set <- switch(tclvalue(set.neg.value), '0' = FALSE, '1' = TRUE)
GeneralParameters$negative$value <- as.numeric(trimws(tclvalue(val.neg.value)))
GeneralParameters$cdtstation <- trimws(tclvalue(input.file))
GeneralParameters$outdir <- trimws(tclvalue(dir.save))
GeneralParameters$blank$blank <- switch(tclvalue(blankGrid), '0' = FALSE, '1' = TRUE)
GeneralParameters$blank$shpf <- trimws(tclvalue(file.blankShp))
# assign('GeneralParameters', GeneralParameters, envir = .GlobalEnv)
Insert.Messages.Out(lang.dlg[['message']][['4']], TRUE, "i")
tkconfigure(.cdtEnv$tcl$main$win, cursor = 'watch')
tcl('update')
ret <- tryCatch(
{
interpStationsProcs(GeneralParameters)
},
warning = function(w) warningFun(w),
error = function(e) errorFun(e),
finally = {
tkconfigure(.cdtEnv$tcl$main$win, cursor = '')
tcl('update')
}
)
if(!is.null(ret)){
if(ret %in% c(-1, 0)){
Insert.Messages.Out(lang.dlg[['message']][['5']], TRUE, "s")
if(GeneralParameters$intstep == "others"){
tkconfigure(cb.other, values = .cdtData$EnvData$stnData$dates)
tclvalue(date.other) <- .cdtData$EnvData$stnData$dates[1]
}else{
daty <- .cdtData$EnvData$last.date
tclvalue(date.year) <- as.numeric(format(daty, '%Y'))
tclvalue(date.mon) <- as.numeric(format(daty, '%m'))
tclvalue(date.day) <- as.numeric(format(daty, '%d'))
tclvalue(date.hour) <- as.numeric(format(daty, '%H'))
tclvalue(date.min) <- as.numeric(format(daty, '%M'))
}
}else if(ret == 1){
Insert.Messages.Out(lang.dlg[['message']][['6']], TRUE, "w")
}else Insert.Messages.Out(lang.dlg[['message']][['7']], TRUE, "e")
}else Insert.Messages.Out(lang.dlg[['message']][['7']], TRUE, "e")
})
##############################################
tkgrid(frameCDTdata, row = 0, column = 0, sticky = 'we', padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(btDateRange, row = 1, column = 0, sticky = 'we', padx = 1, pady = 2, ipadx = 1, ipady = 1)
tkgrid(btInterpMthd, row = 2, column = 0, sticky = 'we', padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(btGridInterp, row = 3, column = 0, sticky = 'we', padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(frameNegVal, row = 4, column = 0, sticky = 'we', padx = 1, pady = 3, ipadx = 1, ipady = 1)
tkgrid(frameBlank, row = 5, column = 0, sticky = 'we', padx = 1, pady = 3, ipadx = 1, ipady = 1)
tkgrid(frameDirSav, row = 6, column = 0, sticky = 'we', padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(btInterpolate, row = 7, column = 0, sticky = 'we', padx = 1, pady = 10, ipadx = 1, ipady = 1)
#######################################################################################################
#Tab2
subfr2 <- bwTabScrollableFrame(cmd.tab2)
##############################################
frameINTRP <- ttklabelframe(subfr2, text = lang.dlg[['label']][['13']], relief = 'groove')
interpData <- tclVar(0)
file.interpData <- tclVar()
stateIntD <- if(tclvalue(interpData) == "1") "normal" else "disabled"
chk.IntD <- tkcheckbutton(frameINTRP, variable = interpData, text = lang.dlg[['checkbutton']][['3']], anchor = 'w', justify = 'left')
en.IntD <- tkentry(frameINTRP, textvariable = file.interpData, width = largeur7, state = stateIntD)
bt.IntD <- ttkbutton(frameINTRP, text = .cdtEnv$tcl$lang$global[['button']][['6']], state = stateIntD)
tkgrid(chk.IntD, row = 0, column = 0, sticky = 'we', rowspan = 1, columnspan = 4, padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(bt.IntD, row = 0, column = 4, sticky = 'e', rowspan = 1, columnspan = 1, padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(en.IntD, row = 1, column = 0, sticky = 'we', rowspan = 1, columnspan = 5, padx = 1, pady = 1, ipadx = 1, ipady = 1)
##############
tkconfigure(bt.IntD, command = function(){
path.Interp <- tclvalue(tkgetOpenFile(initialdir = getwd(), filetypes = .cdtEnv$tcl$data$filetypes6))
if(path.Interp == "") return(NULL)
tclvalue(file.interpData) <- path.Interp
path.Interp <- trimws(tclvalue(file.interpData))
if(file.exists(path.Interp)){
interp.data <- try(readRDS(path.Interp), silent = TRUE)
if(inherits(interp.data, "try-error")){
Insert.Messages.Out(lang.dlg[['message']][['8']], TRUE, 'e')
Insert.Messages.Out(gsub('[\r\n]', '', interp.data[1]), TRUE, 'e')
return(NULL)
}
.cdtData$EnvData$stnData <- interp.data$stn
.cdtData$EnvData$ncdfOUT <- file.path(dirname(path.Interp), 'DATA_NetCDF')
.cdtData$EnvData$first.date <- interp.data$first.date
.cdtData$EnvData$last.date <- interp.data$last.date
if(interp.data$params$intstep == "others"){
tkconfigure(cb.other, values = .cdtData$EnvData$stnData$dates)
tclvalue(date.other) <- .cdtData$EnvData$stnData$dates[1]
}else{
daty <- .cdtData$EnvData$last.date
tclvalue(date.year) <- as.numeric(format(daty, '%Y'))
tclvalue(date.mon) <- as.numeric(format(daty, '%m'))
tclvalue(date.day) <- as.numeric(format(daty, '%d'))
tclvalue(date.hour) <- as.numeric(format(daty, '%H'))
tclvalue(date.min) <- as.numeric(format(daty, '%M'))
}
tclvalue(timeSteps) <- CbperiodVAL[periodVAL %in% interp.data$params$intstep]
retminhr <- set.hour.minute(interp.data$params$intstep, interp.data$params$minhour)
tclvalue(minhour.tclVar) <- retminhr$val
tkconfigure(cb.minhour, values = retminhr$cb)
}
})
tkbind(chk.IntD, "<Button-1>", function(){
stateIntD <- if(tclvalue(interpData) == '1') 'disabled' else 'normal'
tkconfigure(bt.IntD, state = stateIntD)
tkconfigure(en.IntD, state = stateIntD)
stateDataIn <- if(tclvalue(interpData) == '1') 'normal' else 'disabled'
tcl(tknote.cmd, 'itemconfigure', cmd.tab1$IDtab, state = stateDataIn)
})
##############
frameMap <- ttklabelframe(subfr2, text = lang.dlg[['label']][['14']], relief = 'groove')
date.year <- tclVar(GeneralParameters$date$year)
date.mon <- tclVar(GeneralParameters$date$mon)
date.day <- tclVar(GeneralParameters$date$day)
date.hour <- tclVar(GeneralParameters$date$hour)
date.min <- tclVar(GeneralParameters$date$min)
date.other <- tclVar(GeneralParameters$date$other)
##############
frTS0 <- tkframe(frameMap)
frTS1 <- tkframe(frTS0)
cb.other <- NULL
date.time.selection(GeneralParameters$intstep, frTS1)
bt.date.prev <- ttkbutton(frameMap, text = "<<", width = largeur5)
bt.Map.plot <- ttkbutton(frameMap, text = .cdtEnv$tcl$lang$global[['button']][['3']], width = largeur5)
bt.date.next <- ttkbutton(frameMap, text = ">>", width = largeur5)
bt.Map.Opt <- ttkbutton(frameMap, text = .cdtEnv$tcl$lang$global[['button']][['4']], width = largeur5)
##############
frPLOTpanel <- tkframe(frameMap)
.cdtData$EnvData$map$panelMap <- 'two'
panelMapVar <- tclVar()
panelMaps <- lang.dlg[['combobox']][['1']]
panelNumber <- c('one', 'two')
tclvalue(panelMapVar) <- panelMaps[panelNumber %in% .cdtData$EnvData$map$panelMap]
txt.Map.panel <- tklabel(frPLOTpanel, text = lang.dlg[['label']][['15']], anchor = 'w', justify = 'left')
cb.Map.panel <- ttkcombobox(frPLOTpanel, values = panelMaps, textvariable = panelMapVar, width = largeur0)
tkgrid(txt.Map.panel, row = 0, column = 0, sticky = 'e', padx = 0, pady = 1, columnspan = 1)
tkgrid(cb.Map.panel, row = 0, column = 1, sticky = 'we', padx = 1, pady = 1, columnspan = 1)
##############
tkbind(cb.Map.panel, "<<ComboboxSelected>>", function(){
.cdtData$EnvData$map$panelMap <- panelNumber[panelMaps %in% trimws(tclvalue(panelMapVar))]
statetypeMapPLOT1 <- if(.cdtData$EnvData$map$panelMap == "one") "disabled" else "normal"
tkconfigure(cb.Map.type1, state = statetypeMapPLOT1)
})
##############
frOPTS0 <- tkframe(frameMap)
.cdtData$EnvData$map$typeMap1 <- "Points"
typeMapPLOT1 <- c("Points", "Pixels")
typeMap1Var <- tclVar(.cdtData$EnvData$map$typeMap1)
statetypeMapPLOT1 <- if(.cdtData$EnvData$map$panelMap == "one") "disabled" else "normal"
.cdtData$EnvData$map$typeMap2 <- "Pixels"
typeMapPLOT2 <- c("Pixels", "FilledContour")
typeMap2Var <- tclVar(.cdtData$EnvData$map$typeMap2)
txt.Map.type1 <- tklabel(frOPTS0, text = lang.dlg[['label']][['16']], anchor = 'w', justify = 'left')
cb.Map.type1 <- ttkcombobox(frOPTS0, values = typeMapPLOT1, textvariable = typeMap1Var, width = largeur3, state = statetypeMapPLOT1)
txt.Map.type2 <- tklabel(frOPTS0, text = lang.dlg[['label']][['17']], anchor = 'w', justify = 'left')
cb.Map.type2 <- ttkcombobox(frOPTS0, values = typeMapPLOT2, textvariable = typeMap2Var, width = largeur3)
##############
tkbind(cb.Map.type1, "<<ComboboxSelected>>", function(){
.cdtData$EnvData$map$typeMap1 <- trimws(tclvalue(typeMap1Var))
if(.cdtData$EnvData$map$typeMap1 == "Points"){
.cdtData$EnvData$dataMapOp$pointSize <- pointSizeI
}else .cdtData$EnvData$dataMapOp$pointSize <- NULL
})
tkbind(cb.Map.type2, "<<ComboboxSelected>>", function(){
.cdtData$EnvData$map$typeMap2 <- trimws(tclvalue(typeMap2Var))
})
##############
tkgrid(frTS1, row = 0, column = 0, sticky = 'we', padx = 1, pady = 1, rowspan = 1, columnspan = 1)
##############
tkgrid(txt.Map.type1, row = 0, column = 0, sticky = 'e', padx = 1, pady = 1, columnspan = 1)
tkgrid(cb.Map.type1, row = 0, column = 1, sticky = 'we', padx = 1, pady = 1, columnspan = 1)
tkgrid(txt.Map.type2, row = 1, column = 0, sticky = 'e', padx = 1, pady = 1, columnspan = 1)
tkgrid(cb.Map.type2, row = 1, column = 1, sticky = 'we', padx = 1, pady = 1, columnspan = 1)
##############
tkgrid(frTS0, row = 0, column = 0, sticky = '', padx = 1, pady = 1, columnspan = 3)
tkgrid(bt.date.prev, row = 1, column = 0, sticky = 'we', padx = 1, pady = 1, columnspan = 1)
tkgrid(bt.Map.plot, row = 1, column = 1, sticky = 'we', padx = 5, pady = 1, columnspan = 1)
tkgrid(bt.date.next, row = 1, column = 2, sticky = 'we', padx = 1, pady = 1, columnspan = 1)
tkgrid(frPLOTpanel, row = 2, column = 0, sticky = '', padx = 1, pady = 5, columnspan = 3)
tkgrid(frOPTS0, row = 3, column = 0, sticky = 'we', padx = 1, pady = 1, columnspan = 2)
tkgrid(bt.Map.Opt, row = 3, column = 2, sticky = 'we', padx = 1, pady = 1, rowspan = 2, columnspan = 1)
##############
tkconfigure(bt.Map.Opt, command = function(){
if(!is.null(.cdtData$EnvData$mapdata$mapstn)){
atlevel <- pretty(.cdtData$EnvData$mapdata$mapstn$z, n = 10, min.n = 7)
if(is.null(.cdtData$EnvData$dataMapOp$userLvl$levels)){
.cdtData$EnvData$dataMapOp$userLvl$levels <- atlevel
}else{
if(!.cdtData$EnvData$dataMapOp$userLvl$custom)
.cdtData$EnvData$dataMapOp$userLvl$levels <- atlevel
}
}
.cdtData$EnvData$dataMapOp <- MapGraph.MapOptions(.cdtData$EnvData$dataMapOp)
if(.cdtData$EnvData$map$typeMap1 == "Points")
pointSizeI <<- .cdtData$EnvData$dataMapOp$pointSize
})
##############
.cdtData$EnvData$tab$dataMap <- NULL
tkconfigure(bt.Map.plot, command = function(){
if(is.null(.cdtData$EnvData$stnData)) return(NULL)
ret <- try(getStnMap(), silent = TRUE)
if(inherits(ret, "try-error") | is.null(ret)){
Insert.Messages.Out(gsub('[\r\n]', '', ret[1]), TRUE, "e")
return(NULL)
}
####
imgContainer <- CDT.Display.Graph(spatialInterp.plotMap, .cdtData$EnvData$tab$dataMap, 'Spatial-Interpolation')
.cdtData$EnvData$tab$dataMap <- imageNotebookTab_unik(imgContainer, .cdtData$EnvData$tab$dataMap)
})
tkconfigure(bt.date.prev, command = function(){
if(is.null(.cdtData$EnvData$stnData)) return(NULL)
intstep <- periodVAL[CbperiodVAL %in% trimws(tclvalue(timeSteps))]
if(intstep == "others"){
idaty <- which(.cdtData$EnvData$stnData$dates == trimws(tclvalue(date.other)))
idaty <- idaty - 1
if(idaty < 1) idaty <- length(.cdtData$EnvData$stnData$dates)
tclvalue(date.other) <- .cdtData$EnvData$stnData$dates[idaty]
}else{
daty <- set.dates.times(-1, intstep)
if(daty < .cdtData$EnvData$first.date) daty <- .cdtData$EnvData$last.date
tclvalue(date.year) <- as.numeric(format(daty, '%Y'))
tclvalue(date.mon) <- as.numeric(format(daty, '%m'))
tclvalue(date.day) <- as.numeric(format(daty, '%d'))
tclvalue(date.hour) <- as.numeric(format(daty, '%H'))
tclvalue(date.min) <- as.numeric(format(daty, '%M'))
}
######
ret <- try(getStnMap(), silent = TRUE)
if(inherits(ret, "try-error") | is.null(ret)){
Insert.Messages.Out(gsub('[\r\n]', '', ret[1]), TRUE, "e")
return(NULL)
}
####
imgContainer <- CDT.Display.Graph(spatialInterp.plotMap, .cdtData$EnvData$tab$dataMap, 'Spatial-Interpolation')
.cdtData$EnvData$tab$dataMap <- imageNotebookTab_unik(imgContainer, .cdtData$EnvData$tab$dataMap)
})
tkconfigure(bt.date.next, command = function(){
if(is.null(.cdtData$EnvData$stnData)) return(NULL)
intstep <- periodVAL[CbperiodVAL %in% trimws(tclvalue(timeSteps))]
if(intstep == "others"){
idaty <- which(.cdtData$EnvData$stnData$dates == trimws(tclvalue(date.other)))
idaty <- idaty + 1
if(idaty > length(.cdtData$EnvData$stnData$dates)) idaty <- 1
tclvalue(date.other) <- .cdtData$EnvData$stnData$dates[idaty]
}else{
daty <- set.dates.times(1, intstep)
if(daty > .cdtData$EnvData$last.date) daty <- .cdtData$EnvData$first.date
tclvalue(date.year) <- as.numeric(format(daty, '%Y'))
tclvalue(date.mon) <- as.numeric(format(daty, '%m'))
tclvalue(date.day) <- as.numeric(format(daty, '%d'))
tclvalue(date.hour) <- as.numeric(format(daty, '%H'))
tclvalue(date.min) <- as.numeric(format(daty, '%M'))
}
######
ret <- try(getStnMap(), silent = TRUE)
if(inherits(ret, "try-error") | is.null(ret)){
Insert.Messages.Out(gsub('[\r\n]', '', ret[1]), TRUE, "e")
return(NULL)
}
####
imgContainer <- CDT.Display.Graph(spatialInterp.plotMap, .cdtData$EnvData$tab$dataMap, 'Spatial-Interpolation')
.cdtData$EnvData$tab$dataMap <- imageNotebookTab_unik(imgContainer, .cdtData$EnvData$tab$dataMap)
})
############################################
tkgrid(frameINTRP, row = 0, column = 0, sticky = 'we', padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(frameMap, row = 1, column = 0, sticky = 'we', padx = 1, pady = 1, ipadx = 1, ipady = 1)
#######################################################################################################
#Tab3
subfr3 <- bwTabScrollableFrame(cmd.tab3)
##############################################
frameSHP <- ttklabelframe(subfr3, text = lang.dlg[['label']][['18']], relief = 'groove')
.cdtData$EnvData$shp$add.shp <- tclVar(FALSE)
file.plotShp <- tclVar()
stateSHP <- "disabled"
chk.addshp <- tkcheckbutton(frameSHP, variable = .cdtData$EnvData$shp$add.shp, text = lang.dlg[['checkbutton']][['4']], anchor = 'w', justify = 'left')
bt.addshpOpt <- ttkbutton(frameSHP, text = .cdtEnv$tcl$lang$global[['button']][['4']], state = stateSHP)
cb.addshp <- ttkcombobox(frameSHP, values = unlist(listOpenFiles), textvariable = file.plotShp, width = largeur1, state = stateSHP)
bt.addshp <- tkbutton(frameSHP, text = "...", state = stateSHP)
########
tkgrid(chk.addshp, row = 0, column = 0, sticky = 'we', rowspan = 1, columnspan = 6, padx = 1, pady = 1)
tkgrid(bt.addshpOpt, row = 0, column = 6, sticky = 'we', rowspan = 1, columnspan = 2, padx = 1, pady = 1)
tkgrid(cb.addshp, row = 1, column = 0, sticky = 'we', rowspan = 1, columnspan = 7, padx = 1, pady = 1)
tkgrid(bt.addshp, row = 1, column = 7, sticky = 'we', rowspan = 1, columnspan = 1, padx = 0, pady = 1)
########
tkconfigure(bt.addshp, command = function(){
shp.opfiles <- getOpenShp(.cdtEnv$tcl$main$win)
if(!is.null(shp.opfiles)){
update.OpenFiles('shp', shp.opfiles)
tclvalue(file.plotShp) <- shp.opfiles[[1]]
listOpenFiles[[length(listOpenFiles) + 1]] <<- shp.opfiles[[1]]
lapply(list(cb.cdtdata2, cb.blankgrid, cb.addshp), tkconfigure, values = unlist(listOpenFiles))
shpofile <- getShpOpenData(file.plotShp)
if(is.null(shpofile))
.cdtData$EnvData$shp$ocrds <- NULL
else
.cdtData$EnvData$shp$ocrds <- getBoundaries(shpofile[[2]])
}
})
########
tkconfigure(bt.addshpOpt, command = function(){
.cdtData$EnvData$SHPOp <- MapGraph.GraphOptions.LineSHP(.cdtData$EnvData$SHPOp)
})
#################
tkbind(cb.addshp, "<<ComboboxSelected>>", function(){
shpofile <- getShpOpenData(file.plotShp)
if(is.null(shpofile))
.cdtData$EnvData$shp$ocrds <- NULL
else
.cdtData$EnvData$shp$ocrds <- getBoundaries(shpofile[[2]])
})
tkbind(chk.addshp, "<Button-1>", function(){
stateSHP <- if(tclvalue(.cdtData$EnvData$shp$add.shp) == "1") "disabled" else "normal"
tkconfigure(cb.addshp, state = stateSHP)
tkconfigure(bt.addshp, state = stateSHP)
tkconfigure(bt.addshpOpt, state = stateSHP)
})
##############################################
tkgrid(frameSHP, row = 0, column = 0, sticky = 'we', pady = 1)
#######################################################################################################
getStnMap <- function(){
tkconfigure(.cdtEnv$tcl$main$win, cursor = 'watch')
tcl('update')
on.exit({
tkconfigure(.cdtEnv$tcl$main$win, cursor = '')
tcl('update')
})
typemap1 <- .cdtData$EnvData$map$typeMap1
typemap2 <- .cdtData$EnvData$map$typeMap2
tstep <- periodVAL[CbperiodVAL %in% trimws(tclvalue(timeSteps))]
if(tstep != "others"){
yrs <- as.numeric(trimws(tclvalue(date.year)))
mon <- as.numeric(trimws(tclvalue(date.mon)))
dpk <- as.numeric(trimws(tclvalue(date.day)))
hrs <- as.numeric(trimws(tclvalue(date.hour)))
min <- as.numeric(trimws(tclvalue(date.min)))
getSpat <- list(yrs, mon, dpk, hrs, min, typemap1)
}else getSpat <- list(trimws(tclvalue(date.other)), typemap1)
if(tstep != "others"){
if(tstep == "minute"){
mins <- paste(yrs, mon, dpk, hrs, min, sep = "-")
daty <- format(as.POSIXct(mins, format = "%Y-%m-%d-%H-%M"), "%Y%m%d%H%M")
}
if(tstep == "hourly"){
hhrs <- paste(yrs, mon, dpk, hrs, sep = "-")
daty <- format(as.POSIXct(hhrs, format = "%Y-%m-%d-%H"), "%Y%m%d%H")
}
if(tstep == "daily")
daty <- format(as.Date(paste(yrs, mon, dpk, sep = "-")), "%Y%m%d")
if(tstep == "pentad"){
pen <- as.Date(paste(yrs, mon, dpk, sep = "-"))
daty <- paste0(format(pen, "%Y%m"), dpk)
}
if(tstep == "dekadal"){
dek <- as.Date(paste(yrs, mon, dpk, sep = "-"))
daty <- paste0(format(dek, "%Y%m"), dpk)
}
if(tstep == "monthly")
daty <- format(as.Date(paste(yrs, mon, dpk, sep = "-")), "%Y%m")
}else daty <- trimws(tclvalue(date.other))
idaty <- which(.cdtData$EnvData$stnData$dates == daty)
if(length(idaty) == 0){
.cdtData$EnvData$mapdata$mapstn <- NULL
.cdtData$EnvData$mapdata$mapncdf <- NULL
Insert.Messages.Out(lang.dlg[['message']][['9']], TRUE, "e")
return(NULL)
}else{
formatSpData <- TRUE
if(!is.null(.cdtData$EnvData$mapdata$spatial)){
formatSpData <- all.equal(.cdtData$EnvData$mapdata$spatial, getSpat)
formatSpData <- if(!isTRUE(formatSpData)) TRUE else FALSE
}
if(formatSpData){
if(typemap1 == "Points"){
.cdtData$EnvData$mapdata$mapstn$x <- .cdtData$EnvData$stnData$lon
.cdtData$EnvData$mapdata$mapstn$y <- .cdtData$EnvData$stnData$lat
.cdtData$EnvData$mapdata$mapstn$z <- as.numeric(.cdtData$EnvData$stnData$data[idaty, ])
}
if(typemap1 == "Pixels"){
nx <- nx_ny_as.image(diff(range(.cdtData$EnvData$stnData$lon)))
ny <- nx_ny_as.image(diff(range(.cdtData$EnvData$stnData$lat)))
tmp <- cdt.as.image(as.numeric(.cdtData$EnvData$stnData$data[idaty, ]), nx = nx, ny = ny,
pts.xy = cbind(.cdtData$EnvData$stnData$lon, .cdtData$EnvData$stnData$lat))
.cdtData$EnvData$mapdata$mapstn$x <- tmp$x
.cdtData$EnvData$mapdata$mapstn$y <- tmp$y
.cdtData$EnvData$mapdata$mapstn$z <- tmp$z
}
.cdtData$EnvData$mapdata$spatial <- getSpat
}
################
ncfile <- paste0("stn_interp_", daty, ".nc")
ncpath <- file.path(.cdtData$EnvData$ncdfOUT, ncfile)
readNCDF <- TRUE
if(!is.null(.cdtData$EnvData$mapdata$readnc)){
readNCDF <- all.equal(.cdtData$EnvData$mapdata$readnc, ncpath)
readNCDF <- if(!isTRUE(readNCDF)) TRUE else FALSE
}
if(readNCDF){
if(file.exists(ncpath)){
nc <- ncdf4::nc_open(ncpath)
.cdtData$EnvData$mapdata$mapncdf$x <- nc$dim[[1]]$vals
.cdtData$EnvData$mapdata$mapncdf$y <- nc$dim[[2]]$vals
.cdtData$EnvData$mapdata$mapncdf$z <- ncdf4::ncvar_get(nc, "var")
ncdf4::nc_close(nc)
}else{
.cdtData$EnvData$mapdata$mapncdf <- NULL
Insert.Messages.Out(paste(ncpath, lang.dlg[['message']][['10']]), TRUE, "e")
}
.cdtData$EnvData$mapdata$readnc <- ncpath
}
.cdtData$EnvData$mapdata$t <- daty
.cdtData$EnvData$mapdata$mapstn$p <- typemap1
.cdtData$EnvData$mapdata$mapstn$mp <- "Points"
if(!is.null(.cdtData$EnvData$mapdata$mapncdf)){
.cdtData$EnvData$mapdata$mapncdf$p <- typemap2
.cdtData$EnvData$mapdata$mapncdf$mp <- "Grid"
}
}
return(0)
}
#######################################################################################################
tkgrid(tknote.cmd, sticky = 'nwes')
tkgrid.columnconfigure(tknote.cmd, 0, weight = 1)
tkgrid.rowconfigure(tknote.cmd, 0, weight = 1)
tcl('update')
tkgrid(.cdtEnv$tcl$main$cmd.frame, sticky = 'nwes', pady = 1)
tkgrid.columnconfigure(.cdtEnv$tcl$main$cmd.frame, 0, weight = 1)
tkgrid.rowconfigure(.cdtEnv$tcl$main$cmd.frame, 0, weight = 1)
invisible()
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.