[R] tcltk, X11 protocol error: Bug?

[Nicholas Lewin-Koh]

Hi,
I am having trouble debugging this one. The code is attached below, but
it seems to be a problem at the
C-tk interface. If I run this 1 time there are no problems if I run it
more than once I start to get warnings
that increase in multiples of 11 everytime I run it. Here is a sample
session


> source("clrramp2.r")
Loading required package: tcltk
Loading Tcl/Tk interface ... done
> clrRamp()
>
> tt<-clrRamp()
> tt
function (n)
{
    x <- ramp(seq(0, 1, length = n))
    rgb(x[, 1], x[, 2], x[, 3], max = 255)
}
<environment: 0x8b8674c>
> image(matrix(1:10),col=tt(10))
> tt<-clrRamp()
There were 22 warnings (use warnings() to see them)
> image(matrix(1:10),col=tt(10))
There were 11 warnings (use warnings() to see them)
> warnings()
Warning messages:
1: X11 protocol error: BadWindow (invalid Window parameter)
2: X11 protocol error: BadWindow (invalid Window parameter)
3: X11 protocol error: BadWindow (invalid Window parameter)
4: X11 protocol error: BadWindow (invalid Window parameter)
5: X11 protocol error: BadWindow (invalid Window parameter)
6: X11 protocol error: BadWindow (invalid Window parameter)
7: X11 protocol error: BadWindow (invalid Window parameter)
8: X11 protocol error: BadWindow (invalid Window parameter)
9: X11 protocol error: BadWindow (invalid Window parameter)
10: X11 protocol error: BadWindow (invalid Window parameter)
11: X11 protocol error: BadWindow (invalid Window parameter)

I am running R-2.1.1 on ubuntu linux 5.04, compiled from source (not the
deb package).
My version of tcl/tk is 8.4. The code is below. If anyone sees something
I am doing foolish
let me know, otherwise I will file a bug report.

Nicholas

##### File clrramp2.r ##############

require(tcltk)
clrRamp <- function(n.col, b.color=NULL,e.color=NULL){

  B.ChangeColor <- function()
    {
 
      b.color <<- tclvalue(tkcmd("tk_chooseColor",initialcolor=e.color,
                                 title="Choose a color"))
      if (nchar(b.color)>0){
        tkconfigure(canvas.b,bg=b.color)
        Rmp.Draw()
      }
    }

  E.ChangeColor <- function()
    {
 
      e.color <<- tclvalue(tkcmd("tk_chooseColor",initialcolor=e.color,
                                 title="Choose a color"))
      ##cat(e.color)
      if (nchar(e.color)>0){
        tkconfigure(canvas.e,bg=e.color)
        Rmp.Draw()
      }
    }

  Rmp.Draw <-function(){
    cr<<-colorRampPalette(c(b.color,e.color),space="Lab",interpolate="spline")
    rmpcol <- cr(n.col)
    #rmpcol<-rgb( rmpcol[,1],rmpcol[,2],rmpcol[,3])
    inc <- 300/n.col
    xl <- 0
    for(i in 1:n.col){
      ##item <- 
      tkitemconfigure(canvas.r,barlst[[i]],fill=rmpcol[i],outline=rmpcol[i])
      #xl <- xl+inc
    }
  }

  save.ramp <- function(){
    cr<<-colorRampPalette(c(b.color,e.color),space="Lab",interpolate="spline")
    tkdestroy(tt)
    ##invisible(cr)
  }

  tt <- tktoplevel()
  tkwm.title(tt,"Color Ramp Tool")
  frame <- tkframe(tt)
  bframe <- tkframe(frame,relief="groove",borderwidth=1)

  if(is.null(b.color)) b.color <- "blue"
  if(is.null(e.color)) e.color <- "yellow"
  if(missing(n.col)) n.col <- 100

  canvas.b <- tkcanvas(bframe,width="50",height="25",bg=b.color)
  canvas.e <- tkcanvas(bframe,width="50",height="25",bg=e.color)
  canvas.r <- tkcanvas(tt,width="300",height="50",bg="white")
  
  BColor.button <- tkbutton(bframe,text="Begin
  Color",command=B.ChangeColor)
  ##tkgrid(canvas.b,BColor.button)
  EColor.button <- tkbutton(bframe,text="End
  Color",command=E.ChangeColor)
  killbutton <- tkbutton(bframe,text="Save",command=save.ramp)
  tkgrid(canvas.b,BColor.button,canvas.e,EColor.button)
  tkgrid(bframe)
  tkgrid(frame)
  tkgrid(canvas.r)
  tkgrid(killbutton)

  cr<-colorRampPalette(c(b.color,e.color),space="Lab",interpolate="spline")
  ##rmpcol <- hex(mixcolor(alpha,bc,ec,where="LUV"))
  rmpcol <- cr(n.col)
  inc <- 300/n.col
  xl <- 0
  #barlst <- vector(length=n.col,mode="list")
  barlst <- tclArray()
  for(i in 1:n.col){
    item<-tkcreate(canvas.r,"rect",xl,0,xl+inc,50,
                   fill=rmpcol[i],outline=rmpcol[i])
    ##tkaddtag(canvas.r, "point", "withtag", item)
    barlst[[i]]<-item
    xl <- xl+inc
  }
  tkgrab.set(tt)
  tkwait.window(tt)

  ##tkdestroy(tt)
  invisible(cr)
}