StnChkCoordsPanelCmd <- function(){
listOpenFiles <- openFile_ttkcomboList()
if(WindowsOS()){
largeur0 <- 21
largeur1 <- 34
largeur2 <- 36
largeur3 <- 32
largeur4 <- 39
}else{
largeur0 <- 21
largeur1 <- 33
largeur2 <- 34
largeur3 <- 37
largeur4 <- 39
}
GeneralParameters <- list(data.type = 'cdtcoords', infile = "", shpfile = "", output = "", buffer = 1)
.cdtData$EnvData$MapOp <- list(blue = list(col = "blue", pch = 20, cex = 0.8),
orange = list(col = "orange", pch = 20, cex = 0.8),
red = list(col = "red", pch = 20, cex = 0.8),
shp = list(col = "black", lwd = 1.5)
)
xml.dlg <- file.path(.cdtDir$dirLocal, "languages", "cdtStnCoords_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)
#######################################################################################################
#Tab1
subfr1 <- bwTabScrollableFrame(cmd.tab1)
############################################
frameDataType <- tkframe(subfr1, relief = 'groove', borderwidth = 2)
CbdatatypeVAL <- lang.dlg[['combobox']][['1']]
datatypeVAL <- c('cdtcoords', 'cdtstation')
DataType <- tclVar()
tclvalue(DataType) <- CbdatatypeVAL[datatypeVAL %in% GeneralParameters$data.type]
txt.datatype <- tklabel(frameDataType, text = lang.dlg[['label']][['1']], anchor = 'w', justify = 'left')
cb.datatype <- ttkcombobox(frameDataType, values = CbdatatypeVAL, textvariable = DataType, width = largeur0)
tkgrid(txt.datatype, row = 0, column = 0, sticky = 'we', rowspan = 1, columnspan = 2, padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(cb.datatype, row = 0, column = 2, sticky = 'we', rowspan = 1, columnspan = 8, padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkbind(cb.datatype, "<<ComboboxSelected>>", function(){
if(trimws(tclvalue(DataType)) == CbdatatypeVAL[1])
tclvalue(txt.INData.var) <- lang.dlg[['label']][['2']]
if(trimws(tclvalue(DataType)) == CbdatatypeVAL[2])
tclvalue(txt.INData.var) <- lang.dlg[['label']][['3']]
})
#######################
frameInData <- tkframe(subfr1, relief = 'groove', borderwidth = 2)
input.file <- tclVar(GeneralParameters$infile)
shp.file <- tclVar(GeneralParameters$shpfile)
if(GeneralParameters$data.type == 'cdtcoords')
txt.INData <- lang.dlg[['label']][['2']]
if(GeneralParameters$data.type == 'cdtstation')
txt.INData <- lang.dlg[['label']][['3']]
txt.INData.var <- tclVar(txt.INData)
txt.infile <- tklabel(frameInData, text = tclvalue(txt.INData.var), textvariable = txt.INData.var, anchor = 'w', justify = 'left')
cb.infile <- ttkcombobox(frameInData, values = unlist(listOpenFiles), textvariable = input.file, width = largeur1)
bt.infile <- tkbutton(frameInData, text = "...")
txt.blkshp <- tklabel(frameInData, text = lang.dlg[['label']][['4']], anchor = 'w', justify = 'left')
cb.blkshp <- ttkcombobox(frameInData, values = unlist(listOpenFiles), textvariable = shp.file, width = largeur1)
bt.blkshp <- tkbutton(frameInData, text = "...")
tkgrid(txt.infile, row = 0, column = 0, sticky = 'we', rowspan = 1, columnspan = 8, padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(cb.infile, row = 1, column = 0, sticky = 'we', rowspan = 1, columnspan = 9, padx = 0, pady = 1, ipadx = 1, ipady = 1)
tkgrid(bt.infile, row = 1, column = 9, sticky = 'w', rowspan = 1, columnspan = 1, padx = 0, pady = 1, ipadx = 1, ipady = 1)
tkgrid(txt.blkshp, row = 2, column = 0, sticky = 'we', rowspan = 1, columnspan = 8, padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(cb.blkshp, row = 3, column = 0, sticky = 'we', rowspan = 1, columnspan = 9, padx = 0, pady = 1, ipadx = 1, ipady = 1)
tkgrid(bt.blkshp, row = 3, column = 9, sticky = 'w', rowspan = 1, columnspan = 1, padx = 0, pady = 1, ipadx = 1, ipady = 1)
####
tkconfigure(bt.infile, 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]]
tkconfigure(cb.infile, values = unlist(listOpenFiles))
}
})
tkconfigure(bt.blkshp, command = function(){
shp.opfiles <- getOpenShp(.cdtEnv$tcl$main$win)
if(!is.null(shp.opfiles)){
update.OpenFiles('shp', shp.opfiles)
tclvalue(shp.file) <- shp.opfiles[[1]]
listOpenFiles[[length(listOpenFiles) + 1]] <<- shp.opfiles[[1]]
tkconfigure(cb.blkshp, values = unlist(listOpenFiles))
}
})
#######################
frameBuff <- tkframe(subfr1)
buffer <- tclVar(GeneralParameters$buffer)
txt.buffer <- tklabel(frameBuff, text = lang.dlg[['label']][['5']])
en.buffer <- tkentry(frameBuff, textvariable = buffer, width = 6)
tkgrid(txt.buffer, row = 0, column = 0, sticky = 'we', padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(en.buffer, row = 0, column = 1, sticky = 'we', padx = 1, pady = 1, ipadx = 1, ipady = 1)
helpWidget(frameBuff, lang.dlg[['tooltip']][['1']], lang.dlg[['status']][['1']])
#######################
frameDirSav <- tkframe(subfr1, relief = 'groove', borderwidth = 2)
outdir <- tclVar(GeneralParameters$output)
txt.outdir <- tklabel(frameDirSav, text = lang.dlg[['label']][['6']], anchor = 'w', justify = 'left')
en.outdir <- tkentry(frameDirSav, textvariable = outdir, width = largeur2)
bt.outdir <- tkbutton(frameDirSav, text = "...")
tkgrid(txt.outdir, row = 0, column = 0, sticky = 'we', rowspan = 1, columnspan = 5, padx = 1, pady = 0, ipadx = 1, ipady = 1)
tkgrid(en.outdir, row = 1, column = 0, sticky = 'we', rowspan = 1, columnspan = 4, padx = 0, pady = 0, ipadx = 1, ipady = 1)
tkgrid(bt.outdir, row = 1, column = 4, sticky = 'w', rowspan = 1, columnspan = 1, padx = 0, pady = 0, ipadx = 1, ipady = 1)
####
tkconfigure(bt.outdir, command = function(){
dirCdrs <- tk_choose.dir(getwd(), "")
tclvalue(outdir) <- if(dirCdrs %in% c("", "NA") | is.na(dirCdrs)) "" else dirCdrs
})
#######################
bt.checkCoords <- ttkbutton(subfr1, text = lang.dlg[['button']][['1']])
tkconfigure(bt.checkCoords, command = function(){
GeneralParameters$data.type <- datatypeVAL[CbdatatypeVAL %in% trimws(tclvalue(DataType))]
GeneralParameters$infile <- trimws(tclvalue(input.file))
GeneralParameters$shpfile <- trimws(tclvalue(shp.file))
GeneralParameters$output <- trimws(tclvalue(outdir))
GeneralParameters$buffer <- as.numeric(trimws(tclvalue(buffer)))
# assign('GeneralParameters', GeneralParameters, envir = .GlobalEnv)
Insert.Messages.Out(lang.dlg[['message']][['1']], TRUE, "i")
tkconfigure(.cdtEnv$tcl$main$win, cursor = 'watch')
tcl('update')
ret <- tryCatch(
{
StnChkCoordsProcs(GeneralParameters)
},
warning = function(w){
warningFun(w)
return(0)
},
error = function(e) errorFun(e),
finally = {
tkconfigure(.cdtEnv$tcl$main$win, cursor = '')
tcl('update')
}
)
msg0 <- lang.dlg[['message']][['2']]
msg1 <- lang.dlg[['message']][['3']]
.cdtData$EnvData$okCorrect <- FALSE
if(!is.null(ret)){
if(ret == 0){
Insert.Messages.Out(msg0, TRUE, "s")
tkconfigure(chk.crdsdisp, state = "disabled")
.cdtData$EnvData$okCorrect <- TRUE
.cdtData$EnvData$plot.maps$data.type <- "cdtstation"
coords <- .cdtData$EnvData$output$coords[, c('lon', 'lat', 'id')]
.cdtData$EnvData$plot.maps[c('lon', 'lat', 'id')] <- coords
.cdtData$EnvData$plot.maps$id <- as.character(.cdtData$EnvData$plot.maps$id)
}else Insert.Messages.Out(msg1, TRUE, "e")
}else Insert.Messages.Out(msg1, TRUE, "e")
})
############################################
tkgrid(frameDataType, row = 0, column = 0, sticky = '', padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(frameInData, row = 1, column = 0, sticky = 'we', padx = 1, pady = 3, ipadx = 1, ipady = 1)
tkgrid(frameBuff, row = 2, column = 0, sticky = 'we', padx = 1, pady = 3, ipadx = 1, ipady = 1)
tkgrid(frameDirSav, row = 3, column = 0, sticky = 'we', padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(bt.checkCoords, row = 4, column = 0, sticky = 'we', padx = 1, pady = 3, ipadx = 1, ipady = 1)
#######################################################################################################
#Tab2
subfr2 <- bwTabScrollableFrame(cmd.tab2)
##############################################
frameCrdData <- ttklabelframe(subfr2, text = lang.dlg[['label']][['7']], relief = 'groove')
.cdtData$EnvData$DirExist <- tclVar(0)
file.Index <- tclVar()
stateIndexDat <- if(tclvalue(.cdtData$EnvData$DirExist) == "1") "normal" else "disabled"
chk.IdxDat <- tkcheckbutton(frameCrdData, variable = .cdtData$EnvData$DirExist, text = lang.dlg[['checkbutton']][['1']], anchor = 'w', justify = 'left')
en.IdxDat <- tkentry(frameCrdData, textvariable = file.Index, width = largeur4, state = stateIndexDat)
bt.IdxDat <- ttkbutton(frameCrdData, text = .cdtEnv$tcl$lang$global[['button']][['6']], state = stateIndexDat)
tkgrid(chk.IdxDat, row = 0, column = 0, sticky = 'we', rowspan = 1, columnspan = 4, padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(bt.IdxDat, row = 0, column = 4, sticky = 'e', rowspan = 1, columnspan = 1, padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(en.IdxDat, row = 1, column = 0, sticky = 'we', rowspan = 1, columnspan = 5, padx = 1, pady = 1, ipadx = 1, ipady = 1)
###############
tkconfigure(bt.IdxDat, command = function(){
path.Idx <- tclvalue(tkgetOpenFile(initialdir = getwd(), filetypes = .cdtEnv$tcl$data$filetypes6))
if(path.Idx %in% c("", "NA") | is.na(path.Idx)) return(NULL)
tclvalue(file.Index) <- path.Idx
if(file.exists(trimws(tclvalue(file.Index)))){
OutChkCrds <- try(readRDS(trimws(tclvalue(file.Index))), silent = TRUE)
if(inherits(OutChkCrds, "try-error")){
Insert.Messages.Out(gsub('[\r\n]', '', OutChkCrds[1]), format = TRUE)
Insert.Messages.Out(lang.dlg[['message']][['7']], TRUE, "e")
.cdtData$EnvData$okCorrect <- FALSE
.cdtData$EnvData$output <- NULL
.cdtData$EnvData$Table.Disp <- NULL
.cdtData$EnvData$Maps.Disp <- NULL
return(NULL)
}
.cdtData$EnvData$okCorrect <- TRUE
.cdtData$EnvData$output <- OutChkCrds
.cdtData$EnvData$PathData <- dirname(trimws(tclvalue(file.Index)))
dataOUT <- file.path(.cdtData$EnvData$PathData, 'CDTDATASET')
file.table.rds <- file.path(dataOUT, 'Table.rds')
file.display <- file.path(dataOUT, 'Display.rds')
.cdtData$EnvData$Table.Disp <- readRDS(file.table.rds)
.cdtData$EnvData$Maps.Disp <- readRDS(file.display)
.cdtData$EnvData$plot.maps$data.type <- "cdtstation"
coords <- .cdtData$EnvData$output$coords[, c('lon', 'lat', 'id')]
.cdtData$EnvData$plot.maps[c('lon', 'lat', 'id')] <- coords
.cdtData$EnvData$plot.maps$id <- as.character(.cdtData$EnvData$plot.maps$id)
}
})
###############
tkbind(chk.IdxDat, "<Button-1>", function(){
stateIndexDat <- if(tclvalue(.cdtData$EnvData$DirExist) == '1') 'disabled' else 'normal'
tkconfigure(en.IdxDat, state = stateIndexDat)
tkconfigure(bt.IdxDat, state = stateIndexDat)
stateChkCrds <- 'disabled'
if(tclvalue(.cdtData$EnvData$DirExist) == '1')
stateChkCrds <- if(tclvalue(.cdtData$EnvData$DispCrd) == '0') 'normal' else 'disabled'
tkconfigure(bt.checkCoords, state = stateChkCrds)
tkconfigure(en.buffer, state = stateChkCrds)
tkconfigure(en.outdir, state = stateChkCrds)
tkconfigure(bt.outdir, state = stateChkCrds)
if(tclvalue(.cdtData$EnvData$DispCrd) == '0'){
stateChkCrds1 <- if(tclvalue(.cdtData$EnvData$DirExist) == '0') 'disabled' else 'normal'
}else{
stateChkCrds1 <- if(tclvalue(.cdtData$EnvData$DirExist) == '0') 'disabled' else 'normal'
}
tkconfigure(cb.datatype, state = stateChkCrds1)
tkconfigure(cb.infile, state = stateChkCrds1)
tkconfigure(bt.infile, state = stateChkCrds1)
stateEdit <- 'normal'
if(tclvalue(.cdtData$EnvData$DirExist) == '1')
stateEdit <- if(tclvalue(.cdtData$EnvData$DispCrd) == '0') 'normal' else 'disabled'
tkconfigure(bt.editCoords, state = stateEdit)
tkconfigure(bt.correctCoords, state = stateEdit)
stateCrdDisp <- if(tclvalue(.cdtData$EnvData$DirExist) == '1') 'normal' else 'disabled'
tkconfigure(chk.crdsdisp, state = stateCrdDisp)
})
##############################################
bt.editCoords <- ttkbutton(subfr2, text = lang.dlg[['button']][['2']])
.cdtData$EnvData$okCorrect <- FALSE
.cdtData$EnvData$tab$Table <- NULL
.cdtData$EnvData$Table.Disp0 <- NULL
tkconfigure(bt.editCoords, command = function(){
if(.cdtData$EnvData$okCorrect){
if(!is.null(.cdtData$EnvData$Table.Disp)){
.cdtData$EnvData$Table.Disp0 <- .cdtData$EnvData$Table.Disp
editstn.df <- .cdtData$EnvData$Table.Disp
editstn.df[is.na(editstn.df)] <- ""
.cdtData$EnvData$tab$Table <- tableNotebookTab_unik(editstn.df, .cdtData$EnvData$tab$Table,
"Edit-Coordinates", 10, 'chkcrds')
menuRowHandleCopyPaste.OpenTable()
}else{
Insert.Messages.Out(lang.dlg[['message']][['4']], TRUE, "s")
return(NULL)
}
}
})
##############################################
bt.correctCoords <- ttkbutton(subfr2, text = lang.dlg[['button']][['3']])
tkconfigure(bt.correctCoords, command = function(){
if(.cdtData$EnvData$okCorrect){
ret <- try(StnChkCoordsCorrect(), silent = TRUE)
if(is.null(ret)) return(NULL)
if(inherits(ret, "try-error")){
Insert.Messages.Out(lang.dlg[['message']][['6']], TRUE, "e")
Insert.Messages.Out(gsub('[\r\n]', '', ret[1]), format = TRUE)
}else{
Insert.Messages.Out(lang.dlg[['message']][['5']], TRUE, "s")
}
}
})
##############################################
frameDisplay <- tkframe(subfr2, relief = 'groove', borderwidth = 2)
.cdtData$EnvData$DispCrd <- tclVar(0)
bt.dispCDT <- ttkbutton(frameDisplay, text = lang.dlg[['button']][['4']])
bt.dispCDTOpt <- ttkbutton(frameDisplay, text = .cdtEnv$tcl$lang$global[['button']][['4']])
bt.dispGoogle <- ttkbutton(frameDisplay, text = lang.dlg[['button']][['5']])
chk.crdsdisp <- tkcheckbutton(frameDisplay, variable = .cdtData$EnvData$DispCrd, text = lang.dlg[['checkbutton']][['2']], anchor = 'w', justify = 'left', width = largeur3)
tkgrid(bt.dispCDT, row = 0, column = 0, sticky = 'we', rowspan = 1, columnspan = 1, padx = 0, pady = 1, ipadx = 1, ipady = 1)
tkgrid(bt.dispCDTOpt, row = 0, column = 1, sticky = 'we', rowspan = 1, columnspan = 1, padx = 0, pady = 3, ipadx = 1, ipady = 1)
tkgrid(bt.dispGoogle, row = 1, column = 0, sticky = 'we', rowspan = 1, columnspan = 2, padx = 1, pady = 3, ipadx = 1, ipady = 1)
tkgrid(chk.crdsdisp, row = 2, column = 0, sticky = 'we', rowspan = 1, columnspan = 2, padx = 1, pady = 1, ipadx = 1, ipady = 1)
###########################
tkconfigure(bt.dispCDTOpt, command = function(){
.cdtData$EnvData$MapOp <- MapGraph.ChkCoordsOptions(.cdtData$EnvData$MapOp)
})
###############
.cdtData$EnvData$tab$MapSelect <- NULL
tkconfigure(bt.dispCDT, command = function(){
if(tclvalue(.cdtData$EnvData$DispCrd) == '1' &
trimws(tclvalue(input.file)) != "")
{
GeneralParameters$data.type <- datatypeVAL[CbdatatypeVAL %in% trimws(tclvalue(DataType))]
GeneralParameters$infile <- trimws(tclvalue(input.file))
tkconfigure(.cdtEnv$tcl$main$win, cursor = 'watch')
tcl('update')
ret <- tryCatch(
{
StnChkCoordsDataStn(GeneralParameters)
},
warning = function(w){
warningFun(w)
return(0)
},
error = function(e) errorFun(e),
finally = {
tkconfigure(.cdtEnv$tcl$main$win, cursor = '')
tcl('update')
}
)
ok.crds <- FALSE
if(!is.null(ret))
if(ret == 0){
ok.crds <- TRUE
.cdtData$EnvData$plot.maps$data.type <- "cdtstation"
coords <- .cdtData$EnvData$output$coords[, c('lon', 'lat', 'id')]
.cdtData$EnvData$plot.maps[c('lon', 'lat', 'id')] <- coords
.cdtData$EnvData$plot.maps$id <- as.character(.cdtData$EnvData$plot.maps$id)
}
if(!ok.crds){
.cdtData$EnvData$Maps.Disp <- NULL
return(NULL)
}
}
if(trimws(tclvalue(shp.file)) != "")
{
shpofile <- getShpOpenData(trimws(tclvalue(shp.file)))
if(is.null(shpofile))
.cdtData$EnvData$shp$ocrds <- NULL
else
.cdtData$EnvData$shp$ocrds <- getBoundaries(shpofile[[2]])
}else .cdtData$EnvData$shp$ocrds <- NULL
if(!is.null(.cdtData$EnvData$Maps.Disp))
{
set.initialize.Zoom()
imgContainer <- CDT.Display.Points.Zoom(StnChkCoordsPlotMap, .cdtData$EnvData$tab$MapSelect, 'Coordinates-Map')
.cdtData$EnvData$tab$MapSelect <- imageNotebookTab_unik(imgContainer, .cdtData$EnvData$tab$MapSelect)
}
})
###############
tkconfigure(bt.dispGoogle, command = function(){
if(!testConnection())
{
Insert.Messages.Out(lang.dlg[['message']][['8']], TRUE, "e")
return(NULL)
}
if(tclvalue(.cdtData$EnvData$DispCrd) == '1' &
trimws(tclvalue(input.file)) != "")
{
GeneralParameters$data.type <- datatypeVAL[CbdatatypeVAL %in% trimws(tclvalue(DataType))]
GeneralParameters$infile <- trimws(tclvalue(input.file))
tkconfigure(.cdtEnv$tcl$main$win, cursor = 'watch')
tcl('update')
ret <- tryCatch(
{
StnChkCoordsDataStn(GeneralParameters)
},
warning = function(w) {
warningFun(w)
return(0)
},
error = function(e) errorFun(e),
finally = {
tkconfigure(.cdtEnv$tcl$main$win, cursor = '')
tcl('update')
}
)
ok.crds <- FALSE
if(!is.null(ret))
if(ret == 0) ok.crds <- TRUE
if(!ok.crds){
.cdtData$EnvData$Maps.Disp <- NULL
return(NULL)
}
}
if(!is.null(.cdtData$EnvData$Maps.Disp))
{
html.page <- StnChkCoordsFormatHtml()
StnChkCoordsBrowse(html.page)
}
})
###############
tkbind(chk.crdsdisp, "<Button-1>", function(){
if(tclvalue(.cdtData$EnvData$DirExist) == '0'){
stateEdit <- if(tclvalue(.cdtData$EnvData$DispCrd) == '1') 'normal' else 'disabled'
tkconfigure(bt.checkCoords, state = stateEdit)
tkconfigure(bt.editCoords, state = stateEdit)
tkconfigure(bt.correctCoords, state = stateEdit)
tkconfigure(en.buffer, state = stateEdit)
tkconfigure(en.outdir, state = stateEdit)
tkconfigure(bt.outdir, state = stateEdit)
}
})
##############################################
tkgrid(frameCrdData, row = 0, column = 0, sticky = 'we', padx = 1, pady = 1, ipadx = 1, ipady = 1)
tkgrid(bt.editCoords, row = 1, column = 0, sticky = 'we', padx = 1, pady = 3, ipadx = 1, ipady = 1)
tkgrid(bt.correctCoords, row = 2, column = 0, sticky = 'we', padx = 1, pady = 3, ipadx = 1, ipady = 1)
tkgrid(frameDisplay, row = 3, column = 0, sticky = 'we', padx = 0, pady = 1, ipadx = 0, ipady = 1)
#######################################################################################################
#Tab3
subfr3 <- bwTabScrollableFrame(cmd.tab3)
##############################################
.cdtData$EnvData$zoom$xx1 <- tclVar()
.cdtData$EnvData$zoom$xx2 <- tclVar()
.cdtData$EnvData$zoom$yy1 <- tclVar()
.cdtData$EnvData$zoom$yy2 <- tclVar()
.cdtData$EnvData$zoom$pressButP <- tclVar(0)
.cdtData$EnvData$zoom$pressButM <- tclVar(0)
.cdtData$EnvData$zoom$pressButRect <- tclVar(0)
.cdtData$EnvData$zoom$pressButDrag <- tclVar(0)
ZoomXYval0 <- NULL
##############################################
frameZoom <- ttklabelframe(subfr3, text = lang.dlg[['label']][['8']], relief = 'groove')
xentr1.zoom <- tkentry(frameZoom, width = 7, justify = "left", textvariable = .cdtData$EnvData$zoom$xx1)
xentr2.zoom <- tkentry(frameZoom, width = 7, justify = "left", textvariable = .cdtData$EnvData$zoom$xx2)
yentr1.zoom <- tkentry(frameZoom, width = 7, justify = "left", textvariable = .cdtData$EnvData$zoom$yy1)
yentr2.zoom <- tkentry(frameZoom, width = 7, justify = "left", textvariable = .cdtData$EnvData$zoom$yy2)
bt.centre.zoom <- tklabel(frameZoom, image = .cdtEnv$tcl$zoom$img$centre)
.cdtData$EnvData$zoom$btZoomP <- tkbutton(frameZoom, image = .cdtEnv$tcl$zoom$img$plus, relief = 'raised', bg = 'lightblue', state = 'normal')
.cdtData$EnvData$zoom$btZoomM <- tkbutton(frameZoom, image = .cdtEnv$tcl$zoom$img$moins, relief = 'raised', bg = 'lightblue', state = 'normal')
.cdtData$EnvData$zoom$btZoomRect <- tkbutton(frameZoom, image = .cdtEnv$tcl$zoom$img$rect, relief = 'raised', bg = 'lightblue', state = 'normal')
.cdtData$EnvData$zoom$btPanImg <- tkbutton(frameZoom, image = .cdtEnv$tcl$zoom$img$pan, relief = 'raised', bg = 'lightblue', state = 'normal')
.cdtData$EnvData$zoom$btRedraw <- tkbutton(frameZoom, image = .cdtEnv$tcl$zoom$img$redraw, relief = 'raised', bg = 'lightblue')
.cdtData$EnvData$zoom$btReset <- tkbutton(frameZoom, image = .cdtEnv$tcl$zoom$img$reset, relief = 'raised')
tkgrid(xentr1.zoom, row = 1, column = 0, sticky = 'we', rowspan = 1, columnspan = 1)
tkgrid(xentr2.zoom, row = 1, column = 2, sticky = 'we', rowspan = 1, columnspan = 1)
tkgrid(yentr1.zoom, row = 2, column = 1, sticky = 'we', rowspan = 1, columnspan = 1)
tkgrid(yentr2.zoom, row = 0, column = 1, sticky = 'we', rowspan = 1, columnspan = 1)
tkgrid(bt.centre.zoom, row = 1, column = 1, sticky = 'nswe', rowspan = 1, columnspan = 1)
tkgrid(.cdtData$EnvData$zoom$btReset, row = 0, column = 3, sticky = 'nswe', rowspan = 1, columnspan = 1)
tkgrid(.cdtData$EnvData$zoom$btRedraw, row = 1, column = 3, sticky = 'nswe', rowspan = 1, columnspan = 1)
tkgrid(.cdtData$EnvData$zoom$btPanImg, row = 2, column = 3, sticky = 'nswe', rowspan = 1, columnspan = 1)
tkgrid(.cdtData$EnvData$zoom$btZoomP, row = 0, column = 4, sticky = 'nswe', rowspan = 1, columnspan = 1)
tkgrid(.cdtData$EnvData$zoom$btZoomM, row = 1, column = 4, sticky = 'nswe', rowspan = 1, columnspan = 1)
tkgrid(.cdtData$EnvData$zoom$btZoomRect, row = 2, column = 4, sticky = 'nswe', rowspan = 1, columnspan = 1)
helpWidget(.cdtData$EnvData$zoom$btZoomP, lang.dlg[['tooltip']][['2']], lang.dlg[['status']][['2']])
helpWidget(.cdtData$EnvData$zoom$btZoomM, lang.dlg[['tooltip']][['3']], lang.dlg[['status']][['3']])
helpWidget(.cdtData$EnvData$zoom$btZoomRect, lang.dlg[['tooltip']][['4']], lang.dlg[['status']][['4']])
helpWidget(.cdtData$EnvData$zoom$btPanImg, lang.dlg[['tooltip']][['5']], lang.dlg[['status']][['5']])
helpWidget(.cdtData$EnvData$zoom$btRedraw, lang.dlg[['tooltip']][['6']], lang.dlg[['status']][['6']])
helpWidget(.cdtData$EnvData$zoom$btReset, lang.dlg[['tooltip']][['7']], lang.dlg[['status']][['7']])
#################
tkconfigure(.cdtData$EnvData$zoom$btRedraw, command = function(){
.cdtData$EnvData$ZoomXYval <- as.numeric(c(tclvalue(.cdtData$EnvData$zoom$xx1), tclvalue(.cdtData$EnvData$zoom$xx2),
tclvalue(.cdtData$EnvData$zoom$yy1), tclvalue(.cdtData$EnvData$zoom$yy2)))
# ZoomXYval
tabid <- as.numeric(tclvalue(tkindex(.cdtEnv$tcl$main$tknotes, 'current'))) + 1
if(length(.cdtData$OpenTab$Type) > 0){
if(.cdtData$OpenTab$Type[[tabid]] == "img" & !is.null(.cdtData$EnvData$tab$MapSelect))
{
if(.cdtData$OpenTab$Data[[tabid]][[1]][[1]]$ID == .cdtData$EnvData$tab$MapSelect[[2]])
{
refreshPlot(W = .cdtData$OpenTab$Data[[tabid]][[2]][[1]],
img = .cdtData$OpenTab$Data[[tabid]][[2]][[2]],
hscale = as.numeric(tclvalue(tkget(.cdtEnv$tcl$toolbar$spinH))),
vscale = as.numeric(tclvalue(tkget(.cdtEnv$tcl$toolbar$spinV))))
tkconfigure(.cdtData$EnvData$zoom$btRedraw, relief = 'raised', bg = 'lightblue')
}
}
}
})
tkconfigure(.cdtData$EnvData$zoom$btReset, command = function(){
.cdtData$EnvData$ZoomXYval <- ZoomXYval0
tclvalue(.cdtData$EnvData$zoom$xx1) <- ZoomXYval0[1]
tclvalue(.cdtData$EnvData$zoom$xx2) <- ZoomXYval0[2]
tclvalue(.cdtData$EnvData$zoom$yy1) <- ZoomXYval0[3]
tclvalue(.cdtData$EnvData$zoom$yy2) <- ZoomXYval0[4]
# ZoomXYval
tabid <- as.numeric(tclvalue(tkindex(.cdtEnv$tcl$main$tknotes, 'current'))) + 1
if(length(.cdtData$OpenTab$Type) > 0){
if(.cdtData$OpenTab$Type[[tabid]] == "img" & !is.null(.cdtData$EnvData$tab$MapSelect))
{
if(.cdtData$OpenTab$Data[[tabid]][[1]][[1]]$ID == .cdtData$EnvData$tab$MapSelect[[2]])
{
refreshPlot(W = .cdtData$OpenTab$Data[[tabid]][[2]][[1]],
img = .cdtData$OpenTab$Data[[tabid]][[2]][[2]],
hscale = as.numeric(tclvalue(tkget(.cdtEnv$tcl$toolbar$spinH))),
vscale = as.numeric(tclvalue(tkget(.cdtEnv$tcl$toolbar$spinV))))
tkconfigure(.cdtData$EnvData$zoom$btRedraw, relief = 'raised', bg = 'lightblue')
}
}
}
})
##########################################
initXYval0 <- NA
initializeButZoom <- function(){
initXYval0 <<- trimws(c(tclvalue(.cdtData$EnvData$zoom$xx1), tclvalue(.cdtData$EnvData$zoom$xx2),
tclvalue(.cdtData$EnvData$zoom$yy1), tclvalue(.cdtData$EnvData$zoom$yy2)))
tclvalue(.cdtData$EnvData$zoom$pressButP) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButM) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButRect) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButDrag) <- 0
tkconfigure(.cdtData$EnvData$zoom$btZoomP, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btZoomM, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btZoomRect, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btPanImg, relief = 'raised', bg = 'lightblue', state = 'normal')
}
activateButRedraw <- function(){
initXYval1 <- trimws(c(tclvalue(.cdtData$EnvData$zoom$xx1), tclvalue(.cdtData$EnvData$zoom$xx2),
tclvalue(.cdtData$EnvData$zoom$yy1), tclvalue(.cdtData$EnvData$zoom$yy2)))
if(!all(initXYval0 == initXYval1)) tkconfigure(.cdtData$EnvData$zoom$btRedraw, relief = 'raised', bg = 'red')
}
#################
tkbind(xentr1.zoom, "<FocusIn>", initializeButZoom)
tkbind(xentr1.zoom, "<FocusOut>", activateButRedraw)
tkbind(xentr2.zoom, "<FocusIn>", initializeButZoom)
tkbind(xentr2.zoom, "<FocusOut>", activateButRedraw)
tkbind(yentr1.zoom, "<FocusIn>", initializeButZoom)
tkbind(yentr1.zoom, "<FocusOut>", activateButRedraw)
tkbind(yentr2.zoom, "<FocusIn>", initializeButZoom)
tkbind(yentr2.zoom, "<FocusOut>", activateButRedraw)
####
tkbind(.cdtData$EnvData$zoom$btRedraw, "<Button-1>", function(){
tclvalue(.cdtData$EnvData$zoom$pressButP) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButM) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButRect) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButDrag) <- 0
tkconfigure(.cdtData$EnvData$zoom$btRedraw, relief = 'raised', bg = 'lightblue')
tkconfigure(.cdtData$EnvData$zoom$btZoomP, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btZoomM, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btZoomRect, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btPanImg, relief = 'raised', bg = 'lightblue', state = 'normal')
})
tkbind(.cdtData$EnvData$zoom$btReset, "<Button-1>", function(){
tclvalue(.cdtData$EnvData$zoom$pressButP) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButM) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButRect) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButDrag) <- 0
tkconfigure(.cdtData$EnvData$zoom$btRedraw, relief = 'raised', bg = 'lightblue')
tkconfigure(.cdtData$EnvData$zoom$btZoomP, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btZoomM, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btZoomRect, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btPanImg, relief = 'raised', bg = 'lightblue', state = 'normal')
})
tkbind(.cdtData$EnvData$zoom$btZoomP, "<Button-1>", function(){
tclvalue(.cdtData$EnvData$zoom$pressButP) <- 1
tclvalue(.cdtData$EnvData$zoom$pressButM) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButRect) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButDrag) <- 0
tkconfigure(.cdtData$EnvData$zoom$btRedraw, relief = 'raised', bg = 'lightblue')
tkconfigure(.cdtData$EnvData$zoom$btZoomP, relief = 'raised', bg = 'red', state = 'disabled')
tkconfigure(.cdtData$EnvData$zoom$btZoomM, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btZoomRect, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btPanImg, relief = 'raised', bg = 'lightblue', state = 'normal')
})
tkbind(.cdtData$EnvData$zoom$btZoomM, "<Button-1>", function(){
tclvalue(.cdtData$EnvData$zoom$pressButP) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButM) <- 1
tclvalue(.cdtData$EnvData$zoom$pressButRect) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButDrag) <- 0
tkconfigure(.cdtData$EnvData$zoom$btRedraw, relief = 'raised', bg = 'lightblue')
tkconfigure(.cdtData$EnvData$zoom$btZoomP, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btZoomM, relief = 'raised', bg = 'red', state = 'disabled')
tkconfigure(.cdtData$EnvData$zoom$btZoomRect, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btPanImg, relief = 'raised', bg = 'lightblue', state = 'normal')
})
tkbind(.cdtData$EnvData$zoom$btZoomRect, "<Button-1>", function(){
tclvalue(.cdtData$EnvData$zoom$pressButP) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButM) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButRect) <- 1
tclvalue(.cdtData$EnvData$zoom$pressButDrag) <- 0
tkconfigure(.cdtData$EnvData$zoom$btRedraw, relief = 'raised', bg = 'lightblue')
tkconfigure(.cdtData$EnvData$zoom$btZoomP, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btZoomM, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btZoomRect, relief = 'raised', bg = 'red', state = 'disabled')
tkconfigure(.cdtData$EnvData$zoom$btPanImg, relief = 'raised', bg = 'lightblue', state = 'normal')
})
tkbind(.cdtData$EnvData$zoom$btPanImg, "<Button-1>", function(){
tclvalue(.cdtData$EnvData$zoom$pressButP) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButM) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButRect) <- 0
tclvalue(.cdtData$EnvData$zoom$pressButDrag) <- 1
tkconfigure(.cdtData$EnvData$zoom$btRedraw, relief = 'raised', bg = 'lightblue')
tkconfigure(.cdtData$EnvData$zoom$btZoomP, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btZoomM, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btZoomRect, relief = 'raised', bg = 'lightblue', state = 'normal')
tkconfigure(.cdtData$EnvData$zoom$btPanImg, relief = 'raised', bg = 'red', state = 'disabled')
})
##########################################
tkgrid(frameZoom, row = 0, column = 0, sticky = '')
#######################################################################################################
.cdtData$EnvData$StnChkCoords$SaveEdit <- function(dat2sav){
if(all(is.na(dat2sav)) | is.null(dat2sav)) dat2sav <- NULL
.cdtData$EnvData$Table.Disp <- dat2sav
file.table.rds <- file.path(.cdtData$EnvData$PathData, 'CDTDATASET', 'Table.rds')
saveRDS(dat2sav, file.table.rds)
if(is.null(dat2sav)) dat2sav <- ""
file.table.csv <- file.path(.cdtData$EnvData$PathData, 'Stations_to_Check.csv')
writeFiles(dat2sav, file.table.csv, col.names = TRUE)
}
set.initialize.Zoom <- function(){
donX <- range(.cdtData$EnvData$Maps.Disp$LonX, na.rm = TRUE)
donY <- range(.cdtData$EnvData$Maps.Disp$LatX, na.rm = TRUE)
lo1 <- round(donX[1], 4)
lo2 <- round(donX[2], 4)
la1 <- round(donY[1], 4)
la2 <- round(donY[2], 4)
ZoomXYval0 <<- c(lo1, lo2, la1, la2)
tclvalue(.cdtData$EnvData$zoom$xx1) <- lo1
tclvalue(.cdtData$EnvData$zoom$xx2) <- lo2
tclvalue(.cdtData$EnvData$zoom$yy1) <- la1
tclvalue(.cdtData$EnvData$zoom$yy2) <- la2
.cdtData$EnvData$ZoomXYval <- as.numeric(c(tclvalue(.cdtData$EnvData$zoom$xx1),
tclvalue(.cdtData$EnvData$zoom$xx2),
tclvalue(.cdtData$EnvData$zoom$yy1),
tclvalue(.cdtData$EnvData$zoom$yy2)))
}
#######################################################################################################
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.