Skip to content

@jbryer /varEntryDialog.r
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Function to create a tcl/tk dialog box for a user to enter variable values.
#' Creates a dialog box using tcl/tk to get input from the user.
#'
#' This function will create a tcl/tk dialog box to get user input. It has been
#' written to be extensible so the R programmer can easily create a dialog with
#' any number of varaibles with custom labels and data conversion of the user
#' entered data. The function will return a list where the element names are
#' \code{vars} and the value is the user input. By default, all entry will be
#' converted using the \code{as.character} function. However, this can easily be
#' altered using the \code{fun} parameter. For example, if integers are required,
#' use \code{fun=c(as.integer, ...)}. It is also possible to write custom
#' functions that can serve as a data validation. See the examples.
#'
#' Adopted from Kay Cichini:
#' \url{http://thebiobucket.blogspot.com/2012/08/tcltk-gui-example-with-variable-input.html}
#' See also:
#' \url{http://bioinf.wehi.edu.au/~wettenhall/RTclTkExamples/OKCancelDialog.html}
#'
#' @param vars character list of variable names. These will be the element names
#' within the returned list.
#' @param labels the labels the user will see for each variable entry.
#' @param fun list of functions that converts the user input.
#' @param title the title of the dialog box.
#' @param prompt the prompt the user will see on the dialog box.
#' @return a \code{\link{list}} of named values entered by the user.
varEntryDialog <- function(vars,
labels = vars,
fun = rep(list(as.character), length(vars)),
title = 'Variable Entry',
prompt = NULL) {
require(tcltk)
stopifnot(length(vars) == length(labels), length(labels) == length(fun))
# Create a variable to keep track of the state of the dialog window:
# done = 0; If the window is active
# done = 1; If the window has been closed using the OK button
# done = 2; If the window has been closed using the Cancel button or destroyed
done <- tclVar(0)
tt <- tktoplevel()
tkwm.title(tt, title)
entries <- list()
tclvars <- list()
# Capture the event "Destroy" (e.g. Alt-F4 in Windows) and when this happens,
# assign 2 to done.
tkbind(tt,"<Destroy>",function() tclvalue(done)<-2)
for(i in seq_along(vars)) {
tclvars[[i]] <- tclVar("")
entries[[i]] <- tkentry(tt, textvariable=tclvars[[i]])
}
doneVal <- as.integer(tclvalue(done))
results <- list()
reset <- function() {
for(i in seq_along(entries)) {
tclvalue(tclvars[[i]]) <<- ""
}
}
reset.but <- tkbutton(tt, text="Reset", command=reset)
cancel <- function() {
tclvalue(done) <- 2
}
cancel.but <- tkbutton(tt, text='Cancel', command=cancel)
submit <- function() {
for(i in seq_along(vars)) {
tryCatch( {
results[[vars[[i]]]] <<- fun[[i]](tclvalue(tclvars[[i]]))
tclvalue(done) <- 1
},
error = function(e) { tkmessageBox(message=geterrmessage()) },
finally = { }
)
}
}
submit.but <- tkbutton(tt, text="Submit", command=submit)
if(!is.null(prompt)) {
tkgrid(tklabel(tt,text=prompt), columnspan=3, pady=10)
}
for(i in seq_along(vars)) {
tkgrid(tklabel(tt, text=labels[i]), entries[[i]], pady=10, padx=10, columnspan=4)
}
tkgrid(submit.but, cancel.but, reset.but, pady=10, padx=10, columnspan=3)
tkfocus(tt)
# Do not proceed with the following code until the variable done is non-zero.
# (But other processes can still run, i.e. the system is not frozen.)
tkwait.variable(done)
if(tclvalue(done) != 1) {
results <- NULL
}
tkdestroy(tt)
return(results)
}
if(FALSE) { #Test the dialog
vals <- varEntryDialog(vars=c('Variable1', 'Variable2'))
str(vals)
vals <- varEntryDialog(vars=c('Var1', 'Var2'),
labels=c('Enter an integer:', 'Enter a string:'),
fun=c(as.integer, as.character))
str(vals)
#Add a custom validation function
vals <- varEntryDialog(vars=c('Var1'),
labels=c('Enter an integer between 0 and 10:'),
fun=c(function(x) {
x <- as.integer(x)
if(x >= 0 & x <= 10) {
return(x)
} else {
stop("Why didn't you follow instruction!\nPlease enter a number between 0 and 10.")
}
} ))
str(vals)
#Return a list
vals <- varEntryDialog(vars=c('Var1'),
labels=c('Enter a comma separated list of something:'),
fun=c(function(x) {
return(strsplit(x, split=','))
}))
vals$Var1
str(vals)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.