# global variables
#  data_top, data_load, data_menu
#  menu_* : functions for menus

source("tktool.r")
source("plot.r")

data_frame <- function(){
  r<-c()
  for(i in ls(envir=.GlobalEnv)){
    if( is.data.frame(get(i,envir=.GlobalEnv)) ){ r<-c(r,i) }
  }
  return(r)
}
data_frame_element <- function(){
  r<-c()
  for(i in data_frame()){
    for(j in colnames(get(i,envir=.GlobalEnv))){
      r<-c(r,sprintf("%s$%s",i,j))
    }
  }
  return(r)
}
data_eval <- function(cmd){
  if(is.null(cmd)){cmd<-""}
#  cat(cmd,sep="\n")
  eval(parse(text=cmd))
}

data_menu<-list(
list('File',
#  list('New',function()plot_new()),
  list('New',function()menu_file_new()),
  list('Load',function()menu_file_load(data_top)),
  list('Save',function()menu_file_save(data_top)),
  list('Commands',function()menu_file_commands(data_top)),
  list('Graphic',function()menu_file_graphic(data_top)),
  list('-'),
  list('quit',function()tkdestroy(data_top))
  ),
list('Data',
  list('Update',function()menu_data_update()),
  list('-'),
  list('Load',function()menu_data_load(data_top)),
  list('Edit',function()menu_data_edit(data_top)),
  list('Browse',function()menu_data_browse(data_top)),
  list('Duplicate',function()menu_data_duplicate(data_top))
  ),
list('Analysis',
  list('Linear',function()menu_analysis_linear(data_top)),
  list('Polynomial',function()menu_analysis_polynomial(data_top)),
  list('Nonlinear',function()menu_analysis_nonlinear(data_top))
  ),
list('Plot',
  list('Redraw',function()menu_plot_redraw()),
  list('-'),
  list('Plot',function()menu_plot_plot(data_top)),
  list('aXis',function()menu_plot_axis(data_top)),
  list('Label',function()menu_plot_label(data_top)),
  list('leGend',function()menu_plot_legend(data_top)),
  list('Text',function()menu_plot_text(data_top)),
  list('-'),
  list('Expand',function()menu_plot_expand(1)),
  list('Shrink',function()menu_plot_expand(2)),
  list('Move',function()menu_plot_move()),
  list('siZe',function()menu_plot_size(data_top))
  ),
list('Library',
  list('default',function()menu_library_default(data_top)),
  list('rgl',function()menu_library_rgl(data_top))
  ),
list('Help',
  list('Function',function()menu_help_function(data_top)),
  list('String',function()menu_help_string(data_top))
  )
)

menu_sub_data <- function(parent,str){
  dfe<-data_frame_element()
  f1<-my_frame(parent)
  f2<-my_frame(parent)
  my_label(f1,str,side="left")
  xt<-my_entry(f1,width=20,side="left")
  x<-my_listbox(f2,dfe,default=NA)
  tkbind(x,"<<ListboxSelect>>",function(){
    i<-my_value(x)
    my_value(xt)<-dfe[[my_value(x)+1]]
  })
  return(xt)
}
menu_sub_x11 <- function(w,h){
  dd<-c("windows","quartz","X11")
  tp<-c("","",",type='Xlib'")
  i<-switch(Sys.info()[1],"Windows"=1,"Darwin"=2,3) #.Platform$OS.type,
  cmd<-sprintf("%s.options(width=%f,height=%f%s)\n",dd[i],w,h,tp[i])
  return(cmd)
}
menu_sub_size <- function(){
  wh<-switch(Sys.info()[1],
    "Windows" = windows.options(),
    "Darwin" = quartz.options(),
    X11.options() )
  return(c(wh$width,wh$height))
}

menu_file_new <- function(parent){
  rm(list=data_frame(),envir=.GlobalEnv)
  plot_new()
  data_load<<-c()
}
menu_file_load <- function(parent){
  fl<-tclvalue(tkgetOpenFile(filetypes="{graph {.rtk}} {R {.r}}"))
  source(fl)
  data_eval(data_load)
  data_eval(plot_all())
}
menu_file_save <- function(parent){
  fl<-tclvalue(tkgetSaveFile(filetypes="{graph {.rtk}}"))
  r<-c()
  r<-c(r,"data_load <<- ",deparse(data_load),"\n")
  r<-c(r,"data_plot <<- ",deparse(data_plot),"\n")
  r<-c(r,"data_axis <<- ",deparse(data_axis),"\n")
  r<-c(r,"data_label <<- ",deparse(data_label),"\n")
  r<-c(r,"data_legend <<- ",deparse(data_legend),"\n")
  r<-c(r,"data_text <<- ",deparse(data_text),"\n")
  r<-paste(r,collapse="\n")
  cat(r,file=fl)
}
menu_file_commands <- function(parent){
  fl<-tclvalue(tkgetSaveFile(filetypes="{R {.r}}"))
  r<-paste(c(data_load,plot_all()),collapse="")
  r<-gsub("<<-","<-",r)
  cat(r,file=fl)
}
menu_file_graphic <- function(parent){
  wh<-menu_sub_size()
  ft<-"{eps {.eps}} {pdf {.pdf}} {png {.png}} {jpeg {.jpg}}"
  fl<-tclvalue(tkgetSaveFile(filetypes=ft))
  ext<-strsplit(fl,"\\.")[[1]]
  ext<-ext[length(ext)]
  switch(ext,
   "eps" = dev.copy2eps(file=fl),
   "pdf" = dev.copy2pdf(file=fl),
   "png" = {dev.copy(png,file=fl,width=72*wh[1],height=72*wh[2],res=72);dev.off()},
   "jpg" = {dev.copy(jpeg,file=fl,width=72*wh[1],height=72*wh[2],res=72);dev.off()},
   print("unknown format")
  )
}

menu_data_update <-function(){
  data_eval(data_load)
  data_eval(plot_all())
}
menu_data_load <- function(parent){
  fl<-tclvalue(tkgetOpenFile(filetypes="{all {*.*}} {text {.txt}} {data {.dat}}"))
  if(fl==""){return()}
  mt<-my_toplevel(parent,title="data load")
cat(fl)
  flio<-file(fl,"r")
  ttl<-""
  repeat{
    num<-readLines(flio,1,ok=FALSE)
    if( regexpr("^s*[\\d\\.]",num,perl=TRUE)!=-1 ){break}
    ttl<-num
  }
  close(flio)
#  my_label(mt,ttl)
#  my_label(mt,num)
  my_text(mt,height=2,width=40,text=paste(ttl,num,sep="\n"))
  f0<-my_frame(mt)
  hdrv<-1
  cmtc<-c("#","*")
  cmtv<-0
  if(regexpr("\\*",ttl)!=-1){cmtv<-1;hdrv<-0}
  hdr<-my_checkbutton(f0,"Auto name",hdrv,side="left")
  my_label(f0,"Comment",side="left")
  cmt<-my_radiobutton(f0,cmtc,cmtv,side="left")
  f1<-my_frame(mt)
  if(regexpr(",",num)!=-1){dlmv<-1}
  else{dlmv<-0}
  dlm<-my_radiobutton(f1,c("space","comma","tab"),dlmv,side="left")
  f2<-my_frame(mt)
  my_label(f2,"data frame",side="left")
  dfv<-0
  while(sprintf("df%d",dfv) %in% data_frame()){dfv<-dfv+1}
  df<-my_entry(f2,sprintf("df%d",dfv),side="left")
  my_button(mt,"cancel",function()tkdestroy(mt),side="right")
  my_button(mt,"OK",function(){
    hdr <- (my_value(hdr)==1)
    dlm<-c("table","csv","delim")[my_value(dlm)+1]
    cmt<-cmtc[my_value(cmt)+1]
    cmd<-sprintf("%s<<-read.%s(\"%s\",header=%s,comment.char='%s')\n",
      my_value(df),dlm,fl,hdr,cmt)
    data_eval(cmd)
    data_load<<-c(data_load,cmd)
    tkdestroy(mt)
  },side='left')
}
menu_data_edit <- function(parent){
  mt<-my_toplevel(parent,title="edit")
  df<-data_frame()
  ml<-my_listbox(mt,df)
  my_button(mt,"close",function()tkdestroy(mt),side="right")
  my_button(mt,"edit",function(){
    nm<-df[my_value(ml)+1]
    tkdestroy(mt)
#    assign(nm,edit(get(nm)),envir=.GlobalEnv)
    cmd<-sprintf("%s<<-edit(%s)",nm,nm)
    data_eval(cmd)
  },side='left')
}
menu_data_browse <- function(parent){
  mt<-my_toplevel(parent,title="browse")
  df<-data_frame()
  ml<-my_listbox(mt,df)
  mf<-my_frame(mt)
  tempenv<-new.env()
  assign("mfl",my_frame(mf),envir=tempenv)
  mff<-my_frame(mt)
  mex<-my_entry(mff,side="left")
  my_label(mff,"=",side="left")
  mey<-my_entry(mff,side="left")
  fe <- function(){
      dfnm<-df[my_value(ml)+1]
      dfel<-get("cn",envir=tempenv)[my_value( get("dfe",envir=tempenv) )+1]
      my_value(mex)<-dfel
      my_value(mey)<-sprintf("%s$%s",dfnm,dfel)
  }
  fd <- function(){
    tkdestroy(get("mfl",envir=tempenv))
    assign("cn", colnames( get(df[my_value(ml)+1]) ), envir=tempenv)
    assign("mfl",my_frame(mf),envir=tempenv)
    assign("dfe",my_listbox(get("mfl",envir=tempenv),
      get("cn",envir=tempenv)),envir=tempenv)
    tkbind(get("dfe",envir=tempenv),"<<ListboxSelect>>",function(){fe()})
    fe()
  }
  fd()
  tkbind(ml,"<<ListboxSelect>>",function(){fd()})
  my_button(mt,"close",function()tkdestroy(mt),side="right")
  my_button(mt,"add",function(){
    dfnm<-df[my_value(ml)+1]
    dfel<-get("cn",envir=tempenv)[my_value( get("dfe",envir=tempenv) )+1]
    mv<-my_value(mex)
    if(mv==""){break}
#    cmd<-sprintf("%s<<-transform(%s,%s=%s)\n",dfnm,dfnm,mv,my_value(mey))
    cmd<-sprintf("%s[['%s']]<<-%s\n",dfnm,mv,my_value(mey))
    data_eval(cmd)
    data_load<<-c(data_load,cmd)
    fd()
  },side='left')
  my_button(mt,"delete",function(){
    dfnm<-df[my_value(ml)+1]
    dfel<-get("cn",envir=tempenv)[my_value( get("dfe",envir=tempenv) )+1]
    mv<-my_value(mex)
    if(mv==""){break}
    cmd<-sprintf("%s[['%s']]<<-NULL\n",dfnm,mv)
    data_eval(cmd)
    data_load<<-c(data_load,cmd)
    fd()
  },side='left')
}
menu_data_duplicate <- function(parent){
  mt<-my_toplevel(parent,title="duplicate")
  mlf<-my_frame(mt)
  tempenv<-new.env()
  assign("mdf",my_frame(mlf),envir=tempenv)
  ml<-my_listbox(get("mdf",envir=tempenv),data_frame())
  mff<-my_frame(mt)
  mex<-my_entry(mff,side="left")
  my_label(mff,"=",side="left")
  mey<-my_entry(mff,side="left")
  fe <- function(){
      my_value(mey)<-data_frame()[my_value(ml)+1]
  }
  tkbind(ml,"<<ListboxSelect>>",function()fe())
  my_button(mt,"close",function()tkdestroy(mt),side="right")
  my_button(mt,"apply",function(){
    mv<-my_value(mex)
    if(mv==""){break}
    cmd<-sprintf("%s<<-%s\n",mv,my_value(mey))
    data_eval(cmd)
    data_load<<-c(data_load,cmd)
    tkdestroy(get("mdf",envir=tempenv))
    assign("mdf",my_frame(mlf),envir=tempenv)
    ml<-my_listbox(get("mdf",envir=tempenv),data_frame())
    tkbind(ml,"<<ListboxSelect>>",function()fe())
  },side='left')
}

menu_sub_xy <-function(parent){
  mt<-parent
  fxy<-my_frame(mt)
  fy<-my_frame(fxy,side="left")
  fx<-my_frame(fxy,side="right")
  ye<-menu_sub_data(fy,"y")
  xe<-menu_sub_data(fx,"x")
  lfy<-my_frame(fy)
  my_label(lfy,"range",side="left")
  limy1<-my_entry(lfy,"-Inf",width=5,side="left")
  limy2<-my_entry(lfy,"Inf",width=5,side="left")
  lfx<-my_frame(fx)
  my_label(lfx,"range",side="left")
  limx1<-my_entry(lfx,"-Inf",width=5,side="left")
  limx2<-my_entry(lfx,"Inf",width=5,side="left")
  return( list(xe,ye,limx1,limx2,limy1,limy2) )
}
menu_analysis_cmd <-function(mas){
  xx<-my_value(mas[[1]]); yy<-my_value(mas[[2]])
  xl1<-my_value(mas[[3]]); xl2<-my_value(mas[[4]])
  yl1<-my_value(mas[[5]]); yl2<-my_value(mas[[6]])
  cmd<-sprintf("fit_range<<-(%s<(%s))&((%s)<%s)&(%s<(%s))&((%s)<%s)\n",xl1,xx,xx,xl2,yl1,yy,yy,yl2)
  cmd<-c(cmd,sprintf("fit_x<<-%s\n",my_value(mas[[1]])))
  cmd<-c(cmd,sprintf("fit_y<<-%s\n",my_value(mas[[2]])))
  return(cmd)
}
menu_analysis_linear <- function(parent){
  mt<-my_toplevel(parent,title="linear")
  my_label(mt,"y = a + b x")
  mas<-menu_sub_xy(mt)
  my_button(mt,"close",function()tkdestroy(mt),side="right")
  my_button(mt,"fit",function(){
    cmd<-menu_analysis_cmd(mas)
    cmd<-c(cmd,"fit_res<<-lm(fit_y[fit_range]~fit_x[fit_range])\n")
    cmd<-c(cmd,"cat(fit_res$coefficient)\n")
    cmd<-c(cmd,"fit_df<<-data.frame(x=fit_x,y=fit_y)\n")
    cmd<-c(cmd,"fit_df$y<<-fit_res$coefficient[1]+fit_res$coefficient[2]*fit_x\n")
    data_eval(cmd)
    data_load<<-c(data_load,cmd)
#    abline(fit) #before that, redefine axies
},side='left')
  my_button(mt,"redraw",function()menu_plot_redraw(),side="left")
}
menu_analysis_polynomial <- function(parent){
  mt<-my_toplevel(parent,title="polynomial")
  fv<-my_frame(mt)
  fv1<-my_frame(fv,side="top")
  vv<-my_label(fv1,"2",side="left")
  my_label(fv1,"degrees",side="left")
  ff<-my_frame(mt)
  my_label(ff,"y ~",side="left")
  svv<-my_label(ff,"1+x+I(x^2)",side="left")
  model<-function(){
    sv<-c("1","x")
    for(i in 2:as.numeric(my_value(vv))){
      sv<-c(sv,sprintf("I(x^%d)",i))
    }
    my_value(svv)<-paste(sv,collapse="+")
  }
  addv<-function(){
    i<-as.numeric(my_value(vv))
    my_value(vv)<-i+1
    model()
  }
  delv<-function(){
    i<-as.numeric(my_value(vv))
    if(i>2){ my_value(vv)<-i-1 }
    model()
  }
  my_button(fv1,"+",function()addv(),side="left")
  my_button(fv1,"-",function()delv(),side="left")
  mas<-menu_sub_xy(mt)
  my_button(mt,"close",function()tkdestroy(mt),side="right")
  my_button(mt,"fit",function(){
    cmd<-menu_analysis_cmd(mas)
    cmd<-c(cmd,sprintf("x<<-fit_x[fit_range]\n"))
    cmd<-c(cmd,sprintf("fit_res<<-lm(fit_y[fit_range]~%s)\n",my_value(svv)))
    cmd<-c(cmd,"print(summary(fit_res)$coefficients)\n")
    cmd<-c(cmd,"fit_df<<-data.frame(x=fit_x,y=fit_y)\n")
    cmd<-c(cmd,"fit_df$y<<-predict(fit_res,newdata=fit_df)\n")
    data_eval(cmd)
    data_load<<-c(data_load,cmd)
},side='left')
  my_button(mt,"redraw",function()menu_plot_redraw(),side="left")
}
menu_analysis_nonlinear <- function(parent){
  mt<-my_toplevel(parent,title="nonlinear")
  tempenv<-new.env()
  fv<-my_frame(mt)
  fv1<-my_frame(fv,side="top")
  fv2<-my_frame(fv)
  vv<-my_label(fv1,"0",side="left")
  my_label(fv1,"variable(s)",side="left")
  addv<-function(){
    i<-as.numeric(my_value(vv))
#    assign(sprintf("vf%d",i),my_frame(fv2,side='left'),envir=tempenv)
#    my_label(get(sprintf("vf%d",i),envir=tempenv),sprintf('v%d=',i),side='left')
    cmd<-c(sprintf("vf%d<-my_frame(fv2,side='left')",i))
    cmd<-c(cmd,sprintf("my_label(vf%d,'v%d=',side='left')",i,i))
    cmd<-c(cmd,sprintf("vl%s<-my_entry(vf%d,0,width=5,side='left')",i,i,i))
    eval(parse(text=cmd),envir=tempenv)
    my_value(vv)<-i+1
  }
  delv<-function(){
    i<-as.numeric(my_value(vv))-1
    if(i>0){
      tkdestroy(get(sprintf("vf%d",i),envir=tempenv))
      my_value(vv)<-i
    }
  }
  my_button(fv1,"+",function()addv(),side="left")
  my_button(fv1,"-",function()delv(),side="left")
  addv()
  ff<-my_frame(mt)
  my_label(ff,"y=",side="left")
  ef<-my_entry(ff,"sin(v0*x)",width=50,side="left")
  mas<-menu_sub_xy(mt)
  my_button(mt,"close",function()tkdestroy(mt),side="right")
  my_button(mt,"fit",function(){
    sv<-c()
    for(i in 0:(as.numeric(my_value(vv))-1)){
      cmd<-sprintf("my_value(vl%d)",i)
      sv<-c(sv,sprintf("v%d=%s",i,eval(parse(text=cmd),envir=tempenv)))
    }
    cmd<-menu_analysis_cmd(mas)
    cmd<-c(cmd,sprintf("x<<-fit_x[fit_range]\n"))
    cmd<-c(cmd,sprintf("fit_res<<-nls(fit_y[fit_range]~%s,start=c(%s))\n",my_value(ef),paste(sv,collapse=",")))
    cmd<-c(cmd,"print(summary(fit_res)$coefficients)\n")
    cmd<-c(cmd,"fit_df<<-data.frame(x=fit_x,y=fit_y)\n")
    cmd<-c(cmd,"fit_df$y<<-predict(fit_res,newdata=fit_df)\n")
    data_eval(cmd)
    data_load<<-c(data_load,cmd)
  },side='left')
  my_button(mt,"redraw",function()menu_plot_redraw(),side="left")
}


menu_plot_sub <- function(){
  cat("click two points\n")
  xy<-locator(1)
  abline(v=xy$x)
  abline(h=xy$y)
  xy2<-locator(1)
  return(c(xy$x,xy2$x,xy$y,xy2$y))
}
menu_plot_redraw <- function(){
  data_eval(plot_all())
}
menu_plot_plot <- function(parent){
  plot_string<-function(p){
    return(sprintf("%s vs %s",p$x,p$y))}
  mt<-my_toplevel(parent,title="plot")
  ps<-c()
  for(p in data_plot){
    ps<-c(ps,plot_string(p))
  }
  wave<-my_listbox(mt,ps,default=NA,width=40)
  fxy<-my_frame(mt)
  fy<-my_frame(fxy,side="left")
  fx<-my_frame(fxy,side="right")
  flr<-my_frame(mt)
  fl<-my_frame(flr,side="left")
  fr<-my_frame(flr,side="right")
  tkbind(wave,"<<ListboxSelect>>",function(){
    i<-my_value(wave)
    p<-data_plot[[i+1]]
    my_value(xt)<-p$x
    my_value(yt)<-p$y
    my_value(type)<-p$type
    my_value(lwd)<-p$lwd
    my_value(lty)<-p$lty
    my_value(pch)<-p$pch
    my_value(col)<-p$col
    my_value(xside)<-(p$xside-1)/2
    my_value(yside)<-(p$yside-2)/2
  })
  dfe<-data_frame_element()
  xt<-menu_sub_data(fx,"x")
  xside<-my_radiobutton(fx,plot_side[c(1,3)],0)
  yt<-menu_sub_data(fy,"y")
  yside<-my_radiobutton(fy,plot_side[c(2,4)],0)
  type<-my_listbox(fl,plot_type_string)
  col<-my_listbox(fr,plot_col,height=8)
  lty<-my_listbox(fl,plot_lty,default=1)
  pch<-my_listbox(fl,plot_pch)
  lwd<-my_listbox(fr,plot_lwd)
  my_button(mt,"close",function()tkdestroy(mt),side="right")
  lp<-function(){
    list_plot(
#      x=dfe[my_value(x)+1],
#      y=dfe[my_value(y)+1],
      x=my_value(xt),
      y=my_value(yt),
      type=my_value(type),
      lwd=my_value(lwd),
      lty=my_value(lty),
      pch=my_value(pch),
      col=my_value(col),
      xside=my_value(xside)*2+1,
      yside=my_value(yside)*2+2
      )
  }
  my_button(mt,"append",function(){
    new<-lp()
    data_plot<<-c(data_plot,list(new))
    tkinsert(wave,'end',plot_string(new))
    data_eval(plot_all())
    tkselection.clear(wave,0,'end')
    tkselection.set(wave,'end')
  },side='left')
  my_button(mt,"modify",function(){
    i<-my_value(wave)
    new<-lp()
    data_plot[[i+1]]<<-new
    tkdelete(wave,i)
    tkinsert(wave,i,plot_string(new))
    data_eval(plot_all())
    tkselection.set(wave,i)
  },side="left")
  my_button(mt,"up",function(){
    i<-my_value(wave)
    if(i>0){
      tmp0<-data_plot[[i]]
      tmp1<-data_plot[[i+1]]
      data_plot[[i]]<<-tmp1
      data_plot[[i+1]]<<-tmp0
      tkdelete(wave,i)
      tkinsert(wave,i-1,plot_string(tmp1))
      data_eval(plot_all())
      tkselection.set(wave,i-1)
    }
  },side="left")
  my_button(mt,"down",function(){
    i<-my_value(wave)
    if(i<length(data_plot)-1){
      tmp0<-data_plot[[i+1]]
      tmp1<-data_plot[[i+2]]
      data_plot[[i+1]]<<-tmp1
      data_plot[[i+2]]<<-tmp0
      tkdelete(wave,i)
      tkinsert(wave,i+1,plot_string(tmp0))
      data_eval(plot_all())
      tkselection.set(wave,i+1)
    }
  },side="left")
  my_button(mt,"remove",function(){
    i<-my_value(wave)
    data_plot<<-data_plot[-i-1]
    tkdelete(wave,i)
    data_eval(plot_all())
  },side="left")
}
menu_plot_axis <- function(parent){
  mt<-my_toplevel(parent,title="plot axis")
  side<-my_listbox(mt,plot_side,default=NA)
  tick<-my_checkbutton(mt,"tick")
  tcl<-my_radiobutton(mt,plot_tcl_string)
  label<-my_checkbutton(mt,"numerical label")
  las<-my_listbox(mt,plot_las,default=1)
  lf<-my_frame(mt)
  my_label(lf,"range",side="left")
  lim1<-my_entry(lf,"NA",width=5,side="left")
  lim2<-my_entry(lf,"NA",width=5,side="left")
  autorange<-my_button(lf,"auto",function(){
    my_value(lim1)<-"NA";my_value(lim2)<-"NA"},side="right")
  log<-my_checkbutton(mt,"log")
  lf2<-my_frame(mt)
  my_label(lf2,"position",side="left")
  padj<-my_entry(lf2,"0")
  tkbind(side,"<<ListboxSelect>>",function(){
    i<-my_value(side)+1
    p<-data_axis[[i]]
    if( ! is.na(p)[1] ){
      my_value(tcl)<-p$tcl
      my_value(las)<-p$las
      my_value(label)<-p$label
      my_value(tick)<-p$tick
      my_value(log)<-p$log
      my_value(padj)<-p$padj
      if(! is.na(p$lim)[1] ){
        my_value(lim1)<-p$lim[1]
        if(! is.na(p$lim)[2] ){
          my_value(lim2)<-p$lim[2]
        }else{
          my_value(lim2)<-"NA"
      }
      }else{
        my_value(lim1)<-"NA"
        my_value(lim2)<-"NA"
      }
    }
    else{
      my_value(label)<-0
      my_value(tick)<-0
      my_value(log)<-0
      my_value(lim1)<-"NA"
      my_value(lim2)<-"NA"
    }
  })
  my_button(mt,"close",function()tkdestroy(mt),side="right")
  my_button(mt,"update",function(){
    lim12<-c(as.numeric(my_value(lim1)),as.numeric(my_value(lim2)))
#    if(any(is.na(lim12))){lim12<-NA}
    new<-list_axis(
      tcl=my_value(tcl),
      las=my_value(las),
      labels=as.integer(my_value(label)),
      tick=my_value(tick),
      lim=lim12,
      log=my_value(log),
      padj=as.numeric(my_value(padj)) )
    data_axis[[my_value(side)+1]]<<-new
    data_eval(plot_all())
  },side="left")
}
menu_plot_label <- function(parent){
  mt<-my_toplevel(parent,title="plot label")
  side<-my_listbox(mt,plot_side,default=NA)
  flb<-my_frame(mt)
  my_label(flb,"label",side="left")
  text<-my_entry(flb,"",side="left")
  las<-my_listbox(mt,plot_las,default=0)
  fln<-my_frame(mt)
  my_label(fln,"line")
  line<-my_entry(fln,"3")
  tkbind(side,"<<ListboxSelect>>",function(){
    p<-data_label[[i<-my_value(side)+1]]
    if( ! is.na(p)[1] ){
      my_value(text)<-p$text
      my_value(las)<-p$las
      my_value(line)<-p$line
    }
    else{
      my_value(text)<-""
      my_value(line)<-"3"
    }
  })
  my_button(mt,"close",function()tkdestroy(mt),side="right")
  my_button(mt,"update",function(){
    new<-list_label(
      text=my_value(text),
      las=my_value(las),
      line=as.numeric(my_value(line)) )
    data_label[[my_value(side)+1]]<<-new
    data_eval(plot_all())
  },side="left")
}
menu_plot_legend <- function(parent){
  mt<-my_toplevel(parent,title="plot legend")
  fxy<-my_frame(mt)
  my_label(fxy,"x",side="left")
  x<-my_entry(fxy,data_legend$x,width=10,side="left")
  my_label(fxy,"y",side="left")
  y<-my_entry(fxy,data_legend$y,width=10,side="left")
  lc<-my_button(fxy,"set",function(){
    xy<-locator(1)
    my_value(x)<-xy$x
    my_value(y)<-xy$y
    },side="left")
  fb<-my_frame(mt)
  my_label(fb,"box",side="left")
  bty<-my_listbox(fb,plot_box_string,default=data_legend$bty)
  ps<-c()
  for(p in data_plot){
    ps<-c(ps,sprintf("%s vs %s",p$x,p$y))
  }
  wave<-my_listbox(mt,ps,default=NA)
  text<-my_entry(mt,"",width=20)
  tkbind(wave,"<<ListboxSelect>>",function(){
    i<-my_value(wave)
    temp<-data_legend$legend[i+1]
    if(is.null(temp) || is.na(temp)){temp<-""}
    my_value(text)<-temp
  })
  my_button(mt,"close",function()tkdestroy(mt),side="right")
  my_button(mt,"clear",function(){
    data_legend<<-list_legend()
    data_eval(plot_all())
  },side="right")
  my_button(mt,"update",function(){
    i<-my_value(wave)
    data_legend$x<<-as.numeric(my_value(x))
    data_legend$y<<-as.numeric(my_value(y))
    data_legend$legend[i+1]<<-my_value(text)
    data_legend$bty<<-my_value(bty)
    data_eval(plot_all())
  },side="left")
}
menu_plot_text <- function(parent){
  list_string<-function(p){return(sprintf("(%.2f,%.2f) %s",p$x,p$y,p$label))}
  mt<-my_toplevel(parent,title="plot text")
  ps<-c()
  for(p in data_text){
    ps<-c(ps,list_string(p))
  }
  texts<-my_listbox(mt,ps,default=NA)
  fxy<-my_frame(mt)
  my_label(fxy,"x",side="left")
  x<-my_entry(fxy,"0",width=10,side="left")
  my_label(fxy,"y",side="left")
  y<-my_entry(fxy,"0",width=10,side="left")
  lc<-my_button(fxy,"set",function(){
    xy<-locator(1)
    my_value(x)<-xy$x
    my_value(y)<-xy$y
    },side="left")
  label<-my_entry(mt,"text",width=20)
  tkbind(texts,"<<ListboxSelect>>",function(){
    p<-data_text[[my_value(texts)+1]]
    my_value(x)<-p$x
    my_value(y)<-p$y
    my_value(label)<-p$label
  })
  new_text<-function(){
    return(list_text(
      x=as.numeric(my_value(x)),y=as.numeric(my_value(y)),
      label=my_value(label) ))
  }
  my_button(mt,"add",function(){
    p<-new_text()
    data_text<<-c(data_text,list(p))
    tkinsert(texts,'end',list_string(p))
    data_eval(plot_all())
    tkselection.clear(texts,0,'end')
    tkselection.set(texts,'end')
  },side="left")
  my_button(mt,"modify",function(){
    p<-new_text()
    i<-my_value(texts)
    data_text[[i+1]]<<-p
    tkdelete(texts,i)
    tkinsert(texts,i,list_string(p))
    data_eval(plot_all())
    tkselection.set(texts,i)
  },side="left")
  my_button(mt,"remove",function(){
    i=my_value(texts)
    data_text<<-data_text[-i-1]
    tkdelete(texts,i)
    data_eval(plot_all())
  },side="left")
  my_button(mt,"close",function()tkdestroy(mt),side="left")
}
menu_plot_expand <- function(es){
#  rng<-locator(2)
#  xyl<-list(sort(rng$x),sort(rng$y),sort(rng$x),sort(rng$y))
  rng<-menu_plot_sub()
  xx<-sort(rng[1:2]); yy<-sort(rng[3:4])
  xyl<-list(xx,yy,xx,yy)
  for(i in 1:4){
    if(!is.na(data_axis[[i]])[1]){
      old<-plot_range(i)
      if(data_axis[[i]]$log==1){old<-log(old)}
      lim<-c()
      switch(es,
        {lim[1]<-old[1]*(1-xyl[[i]][1])+old[2]*xyl[[i]][1]
         lim[2]<-old[1]*(1-xyl[[i]][2])+old[2]*xyl[[i]][2]
     	},
  	{lim[1]<-old[1]*xyl[[i]][2]-old[2]*xyl[[i]][1]
         lim[2]<-old[1]*(-1+xyl[[i]][2])+old[2]*(1-xyl[[i]][1])
         lim<-lim/((1-xyl[[i]][1])*xyl[[i]][2]-xyl[[i]][1]*(1-xyl[[i]][2]))
	})
      if(data_axis[[i]]$log==1){lim<-exp(lim)}
      data_axis[[i]]$lim<<-lim
    }
  }
  data_eval(plot_all())
}
menu_plot_move <- function(){
  tempenv<-new.env()
  down <- function(buttons, x, y) {
    assign("sx",x,envir=tempenv)
    assign("sy",y,envir=tempenv)
    eventEnv$onMouseMove<-drag
    NULL
  }
  drag <- function(buttons, x, y) {
    dx <- diff(grconvertX(c(get("sx",envir=tempenv), x), "ndc", "user"))
    dy <- diff(grconvertY(c(get("sy",envir=tempenv), y), "ndc", "user"))
    if (abs(dx) + abs(dy) > 0) {
      for(i in 1:4){
        if(!is.na(data_axis[[i]])[1]){
          old<-plot_range(i)
          if(data_axis[[i]]$log==1){old<-log(old)}
          lim<-old-c(dx,dy,dx,dy)[i]*(old[2]-old[1])
          if(data_axis[[i]]$log==1){lim<-exp(lim)}
          data_axis[[i]]$lim<<-lim
        }
      }
      data_eval(plot_all())
      assign("sx",x,envir=tempenv)
      assign("sy",y,envir=tempenv)
    }
    NULL
  }
  up <- function(buttons, x, y) {
    eventEnv$onMouseMove <- NULL
    NULL
  }	
  keydown <- function(key) {
    if (key == "q") return(invisible(1))
    NULL
  }
  setGraphicsEventHandlers(prompt = "",
    onMouseDown=down, onMouseMove=NULL, onMouseUp=up, onKeybd=keydown)
  eventEnv <- getGraphicsEventEnv()
  cat("hit q to quit.\n")
  getGraphicsEvent()
}
menu_plot_size <- function(parent){
  wh<-menu_sub_size()
  mt<-my_toplevel(parent,title="plot size")
  fw<-my_frame(mt)
  my_label(fw,"width",side="left")
  w<-my_entry(fw,wh[1],side="left")
  my_label(fw,"inch",side="left")
  fh<-my_frame(mt)
  my_label(fh,"height",side="left")
  h<-my_entry(fh,wh[2],side="left")
  my_label(fh,"inch",side="left")
  my_button(mt,"close",function()tkdestroy(mt),side="right")
  my_button(mt,"apply",function(){
    if(as.numeric(my_value(w))<=0 || as.numeric(my_value(h))<=0){break}
    dev.off()
    cmd<-menu_sub_x11(as.numeric(my_value(w)),as.numeric(my_value(h)))
    data_eval(cmd)
    data_load<<-c(data_load,cmd)
    menu_plot_redraw()
  },side="left")
}

menu_library_default <- function(parent){
  mt<-my_toplevel(parent,title="library default")
  dfs<-data_frame()
  mtrx<-my_listbox(mt,dfs)
  xyz<-my_frame(mt)
  my_label(xyz,"ratio",side="left")
  x<-my_entry(xyz,"1",width=4,side="left")
  y<-my_entry(xyz,"1",width=4,side="left")
  z<-my_entry(xyz,"1",width=4,side="left")
  pls<-c("image","persp","contour")
  pl<-my_radiobutton(mt,pls)
  cols<-c("rainbow","heat.colors","terrain.colors","topo.colors","cm.colors")
  col<-my_listbox(mt,cols)
  my_button(mt,"cancel",function()tkdestroy(mt),side="right")
  my_button(mt,"OK",function(){
    i<-my_value(mtrx)
    m<-data.matrix(get(dfs[i+1]))
    xr<-as.integer(my_value(x))
    yr<-as.integer(my_value(y))
    zr<-as.integer(my_value(z))
    zlim<-range(m)
    cdiv<-50
    cola<-get(cols[my_value(col)+1])(cdiv)
    get(pls[my_value(pl)+1])(1:nrow(m)/nrow(m)*xr,
      1:ncol(m)/ncol(m)*yr,m/max(m)*zr,
      col=cola)
    tkdestroy(mt)
  },side="left")
}
menu_library_rgl <- function(parent){
  library(rgl)
  mt<-my_toplevel(parent,title="library rgl")
  dfs<-data_frame()
  mtrx<-my_listbox(mt,dfs)
  xyz<-my_frame(mt)
  my_label(xyz,"ratio",side="left")
  x<-my_entry(xyz,"1",width=4,side="left")
  y<-my_entry(xyz,"1",width=4,side="left")
  z<-my_entry(xyz,"1",width=4,side="left")
  cols<-c("rainbow","heat.colors","terrain.colors","topo.colors","cm.colors")
  col<-my_listbox(mt,cols)
  my_button(mt,"cancel",function()tkdestroy(mt),side="bottom")
  my_button(mt,"OK",function(){
    i<-my_value(mtrx)
    m<-data.matrix(get(dfs[i+1]))
    xr<-as.integer(my_value(x))
    yr<-as.integer(my_value(y))
    zr<-as.integer(my_value(z))
    zlim<-range(m)
    cdiv<-50
    cola<-get(cols[my_value(col)+1])(cdiv)
    rgl.surface(1:nrow(m)/nrow(m)*xr,1:ncol(m)/ncol(m)*yr,m/max(m)*zr,
      col=cola[(cdiv-1)*(m-zlim[1])/(zlim[2]-zlim[1])+1])
    tkdestroy(mt)
  },side="bottom")
}

menu_help_string <- function(parent){
  mt<-my_toplevel(parent,title="help string")
  my_label(mt,"\\pm{}, \\times{}, \\div{}, \\propto{}, \\perp{}")
  my_label(mt,"\\alpha{}, \\beta{}, \\gamma,...")
  my_label(mt,"\\degree{}, \\infty{}")
  my_label(mt,"_{2}, ^{2}")
  my_label(mt,"\\italic{abc}, \\bold{abc}, \\sqrt{abc}, \\bar{abc}")
}
menu_help_function <- function(parent){
  mt<-my_toplevel(parent,title="help function")
  my_label(mt,"+, -, *, /, %/%, %%, abs()")
  my_label(mt,"^, sqrt(), exp(), log(), log2(), log10()")
  my_label(mt,"sin(), cos(), tan(), asin(), acos(), atan()")
  my_label(mt,"sinh(), cosh(), tanh(), asinh(), acosh(), atanh()")
  my_label(mt,"dnorm(x,mean,sd):gaussian")
}

menu_file_new()
data_top <- my_toplevel(title="graphtk",x=300,y=1)
my_menu(data_top,data_menu)

data_eval(menu_sub_x11(6,4))


# change logs
# 2009.8.15 alpha version
# 2010.8.25-9.3 basic functions
# 2010.9.5 expand,shrink (without log)
# 2010.9.6 head skip in data-load
# 2010.9.9 use my_value instead of tclvalue, some bug fix
# 2010.9.10 data-edit, data-browse-add and delete
# 2010.9.11 analysis-linear
# 2012.5.1 update and redraw after file-load, selection after add or modify
# 2012.5.5 add help menu for string, correct file-new
# 2015.9.10 autoscale button, autoscale from zero, adjust axis position
# 2016.6.29 add help menu
# 2016.10.5 graphic output (pdf,png,jpeg), some bug fix
# 2016.10.7 add fitting range and result in linear fitting
# 2016.10.8 add analysis-nonlinear, data-duplicate
# 2016.10.9 add analysis-polynomial, help-function
# 2016.10.10 add plot-size and some minor sub-routines
# 2016.10.15 add plot-move, modify plot-size,expand,shrink, bug fix
# 2016.10.29 plot up, down
# 2017.10.11 output size of png,jpg