[R-gui] Need Advice on Tcl/Tk Translation
Wayne.W.Jones at shell.com
Wayne.W.Jones at shell.com
Wed Oct 8 08:48:11 CEST 2008
Hi Paul,
I know that finding good tcltk documentation can be tough.
You probably know of http://bioinf.wehi.edu.au/~wettenhall/RTclTkExamples/
But are you aware of the rpanel package available from CRAN and developed by
Adrian Bowman and Ewan Crawford from Glasgow Uni, see: http://www.stats.gla.ac.uk/~adrian/rpanel/
Essentially rpanel provides wrapper functions for tcltk objects which makes it extremely easy to build a tcltk GUI.
It may not do everything you need to perform the task in hand.
However, you can look at the underlying code which should give you some pointers.
Alternatively it could well be worth looking at how the "gWidgets" package handles tcltk objects.
Regards,
Wayne
-----Original Message-----
From: r-sig-gui-bounces at stat.math.ethz.ch
[mailto:r-sig-gui-bounces at stat.math.ethz.ch]On Behalf Of Paul Roebuck
Sent: 07 October 2008 23:17
To: R-SIG-GUI Mailing List
Subject: [R-gui] Need Advice on Tcl/Tk Translation
Did a quick (well, maybe not) translation of some example
code from section 4.2 of "Effective Tcl/Tk Programming".
I'm trying to learn how to write R scripts that use Tcl/Tk
and would like advice, pointers, suggestions based on
code below. Thanks for any help you could provide.
Translation left me with some questions about how best to
do a couple things with the tcltk package. Some questions
below are related to one another.
1) What's the best way to convert from a Tk widget id
back to R object? I used .Tk.newwin() as I didn't notice
anything more appropriate. Are there functions I missed
that return R objects instead?
2) Is there a method for finding a widget from a widget
hierarchy?
3) Better way to use tags on canvas widget? Don't seem
very useful in conjunction with R tcltk package.
4) tkitemconfigure() didn't seem to work for tag? What
did I do wrong? (scrollform_resize())
5) After resizing such that all form items were displayed,
clicking on the scrollbar arrows would still cause the
form to scroll.
6) What is the canonical means of accessing 'subwidgets'
(like 'form' from scrollform_create())? Global variables?
------------------------CODE------------------------------
###
### Translation of example from sect 4.2 of "Effective Tcl/Tk Programming"
###
require(tcltk)
scrollform_create <- function(top) {
cat("scrollform_create()", "\n")
frame <- tkframe(top, class="Scrollform")
sbar <- tkscrollbar(frame,
command=function(...) tkyview(vport, ...))
tkpack(sbar, side="right", fill="y")
vport <- tkcanvas(frame,
yscrollcommand=function(...) tkset(sbar, ...))
tkpack(vport, side="left", fill="both", expand=TRUE)
form <- tkframe(vport, background="red")
cat("internal form id:" , form$ID, "\n")
tkcreate(vport, "window", "0 0", anchor="nw", window=form$ID)
tkbind(form, "<Configure>", function() scrollform_resize(form))
tkaddtag(vport, "iform", "all")
iform.win <- tkitemconfigure(vport,
tkfind(vport, "withtag", "iform"),
"-window")
cat("iform.win =", tclvalue(iform.win), "\n")
return(frame)
}
## :WHY: If form is resized such that all items are displayed, why is the
## up arrow of scrollbar still active? Clicking on it scrolls frame
## downwards even though it is fully displayed...
scrollform_resize <- function(form) {
cat("scrollform_resize()", "\n")
stopifnot(tclvalue(tkwinfo("class", form)) == "Frame")
vport <- tkwinfo("parent", form)
stopifnot(tclvalue(tkwinfo("class", vport)) == "Canvas")
# this doesn't work either
#tkitemconfigure(vport, "iform", background="green")
bbox <- tkbbox(vport, "all")
cat("bbox:", tclvalue(bbox), "\n");
w <- tkwinfo("width", form)
tkconfigure(vport, width=w, scrollregion=bbox,
yscrollincrement="0.1i")
}
scrollform_interior <- function() {
cat("scrollform_interior()", "\n")
return(form) ## Would require global variable
}
## Given scrolled form widget, find its embedded "form" frame widget
## via hierarchy traversal. There must be a better way to do this...
get_scrollform_interior.hier <- function(sform) {
cat("get_scrollform_interior.hier()", "\n")
stopifnot(inherits(sform, "tkwin") && tclvalue(tkwinfo("class",
sform)) == "Scrollform")
children.ids <- unlist(strsplit(tclvalue(tkwinfo("children", sform)),
" "))
for (child.id in children.ids) {
if (tclvalue(tkwinfo("class", child.id)) == "Canvas") {
canvas.child.id <-
unlist(strsplit(tclvalue(tkwinfo("children", child.id)), " "))
stopifnot(length(canvas.child.id) == 1)
stopifnot(tclvalue(tkwinfo("class", canvas.child.id)) ==
"Frame")
cat("iform.id =", canvas.child.id, "\n")
form <- .Tk.newwin(canvas.child.id) # convert Tk widget id
to R object?
return(form)
}
}
}
## Given scrolled form widget, find its embedded "form" frame widget
## via tag reference. There must be a better way to do this...
get_scrollform_interior.tags <- function(sform) {
cat("get_scrollform_interior.tags()", "\n")
stopifnot(inherits(sform, "tkwin") && tclvalue(tkwinfo("class",
sform)) == "Scrollform")
children.ids <- unlist(strsplit(tclvalue(tkwinfo("children", sform)),
" "))
for (child.id in children.ids) {
if (tclvalue(tkwinfo("class", child.id)) == "Canvas") {
vport <- .Tk.newwin(child.id)
iform.win <- tkitemconfigure(vport, tkfind(vport, "withtag",
"iform"), "-window")
iform.id <- unlist(strsplit(tclvalue(iform.win), " "))[5] #
...shudder...
cat("iform.id =", iform.id, "\n")
stopifnot(tclvalue(tkwinfo("class", iform.id)) == "Frame")
form <- .Tk.newwin(iform.id) # convert Tk widget id to R
object?
return(form)
}
}
}
get_scrollform_interior <- get_scrollform_interior.tags
#debug(get_scrollform_interior)
toplevel <- tktoplevel()
main <- function() {
tkpack(title <- tklabel(toplevel,
text="Enter Information in the form below:"),
anchor="w")
sform <- scrollform_create(toplevel)
tkpack(sform, expand=TRUE, fill="both")
#form <- scrollform_interior()
form <- get_scrollform_interior(sform)
tktitle(toplevel) <- "ScrForm Demo"
fields <- c("Name:",
"Address:",
"City, State:",
"Phone:",
"FAX:",
"E-mail:",
"-",
"SSN:",
"Birthdate:",
"Marital Status:",
"-",
"Employer:",
"Occupation:",
"Annual Income:",
"-",
"Emergency Contact:",
"Phone:")
for (field in fields) {
if (field == "-") {
line <- tkframe(form, height=2, borderwidth=1,
relief="sunken")
tkpack(line,
fill="x",
padx=4,
pady=4)
} else {
line <- tkframe(form)
label <- tklabel(line, text=field, width=20, anchor="e")
tkpack(label, side="left")
entry <- tkentry(line)
tkpack(entry, fill="x")
tkpack(line, side="top", fill="x")
}
}
}
## Run above code
main()
----------------------------------------------------------
SIGSIG -- signature too long (core dumped)
_______________________________________________
R-SIG-GUI mailing list
R-SIG-GUI at stat.math.ethz.ch
https://stat.ethz.ch/mailman/listinfo/r-sig-gui
More information about the R-SIG-GUI
mailing list