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

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

data_frame <- function(){
  l<-ls(env=.GlobalEnv)
  r<-c()
  for(i in l){
    if( is.data.frame(get(i)) ){ r<-c(r,i) }
  }
  return(r)
}
data_frame_element <- function(){
  dfs<-data_frame()
  r<-c()
  for(i in dfs){
    e<-colnames(get(i))
    for(j in e){
      r<-c(r,sprintf("%s$%s",i,j))
    }
  }
  return(r)
}
eval_command <- 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('Load',function()menu_file_load(data_top)),
  list('Save',function()menu_file_save(data_top)),
  list('Export',function()menu_file_export(data_top)),
  list('Eps',function()menu_file_eps(data_top)),
  list('quit',function()tkdestroy(data_top))
  ),
list('Data',
  list('Update',function()menu_data_update()),
  list('Load',function()menu_data_load(data_top)),
  list('Browse',function()menu_data_browse(data_top))
  ),
list('Plot',
  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('Redraw',function()menu_plot_redraw()),
  list('Expand',function()menu_plot_expand()),
  list('Shrink',function()menu_plot_shrink())
  ),
list('Library',
  list('default',function()menu_library_default(data_top)),
  list('rgl',function()menu_library_rgl(data_top))
  )
)

menu_file_load <- function(parent){
  fl<-tclvalue(tkgetOpenFile())
  source(fl)
}
menu_file_save <- function(parent){
  fl<-tclvalue(tkgetSaveFile())
  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_export <- function(parent){
  fl<-tclvalue(tkgetSaveFile())
  r<-paste(data_load,plot_all(),collapse="")
  cat(r,file=fl)
}
menu_file_eps <- function(parent){
  fl<-tclvalue(tkgetSaveFile())
  dev.copy2eps(file=fl)
}


menu_data_update <-function(){
  eval_command(data_load)
}
menu_data_load <- function(parent){
  fl<-tclvalue(tkgetOpenFile())
  if(fl==""){return()}
  mt<-my_toplevel(parent,title="data load")
  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)
  hdr<-my_checkbutton(mt,"header",1)
  if(regexpr(",",num)!=-1){dlmv<-1}
  else{dlmv<-0}
  dlm<-my_radiobutton(mt,c("space","comma","tab"),dlmv)
  my_label(mt,"data frame")
  dfv<-0
  while(sprintf("df%d",dfv) %in% data_frame()){dfv<-dfv+1}
  df<-my_entry(mt,sprintf("df%d",dfv))
  my_button(mt,"OK",function(){
    hdr <- (my_value(hdr)==1)
    dlm<-c("table","csv","delim")[my_value(dlm)+1]
    cmd<-sprintf("%s<<-read.%s(\"%s\",header=%s,comment.char='#')\n",
      my_value(df),dlm,fl,hdr)
    eval_command(cmd)
    data_load<<-c(data_load,cmd)
    tkdestroy(mt)
  })
  my_button(mt,"cancel",function()tkdestroy(mt))
}
menu_data_browse <- function(parent){
  mt<-my_toplevel(parent,title="data browse")
  df<-data_frame()
  ml<-my_listbox(mt,df)
  tempenv<-new.env()
  tkbind(ml,"<<ListboxSelect>>",function(){
    tkdestroy(get("mf",env=tempenv))
    cn<-eval(parse(text=sprintf("colnames(%s)",
      df[my_value(ml)+1]
      )))
    assign("mf",my_frame(mt),env=tempenv)
    my_listbox(get("mf",env=tempenv),cn)
  })
  assign("mf",my_frame(mt),env=tempenv)
}

menu_plot_plot <- function(parent){
  plot_string<-function(p){
    return(sprintf("%s vs %s",p$x,p$y))}
  mt<-my_toplevel(parent,title="plot")
  ft<-my_frame(mt,side="top")
  fxy<-my_frame(ft,side="left")
  fm<-my_frame(ft,side="right")
  ps<-c()
  for(p in data_plot){
    ps<-c(ps,plot_string(p))
  }
  wave<-my_listbox(fxy,ps,default=NA)
  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()
  fx<-my_frame(fxy)
  my_label(fx,"x",side="left")
  xt<-my_entry(fx,width=20,side="left")
  x<-my_listbox(fxy,dfe,default=NA)
  tkbind(x,"<<ListboxSelect>>",function(){
    i<-my_value(x)
    my_value(xt)<-dfe[[i+1]]
  })
#  xdate<-my_checkbutton(fxy,"x date")
  xside<-my_radiobutton(fxy,plot_side[c(1,3)],0)
  fy<-my_frame(fxy)
  my_label(fy,"y",side="left")
  yt<-my_entry(fy,width=20,side="left")
  y<-my_listbox(fxy,dfe,default=NA)
  tkbind(y,"<<ListboxSelect>>",function(){
    i<-my_value(y)
    my_value(yt)<-dfe[[i+1]]
  })
  yside<-my_radiobutton(fxy,plot_side[c(2,4)],0)
  type<-my_listbox(fm,plot_type_string)
  lwd<-my_listbox(fm,plot_lwd)
  lty<-my_listbox(fm,plot_lty,default=1)
  pch<-my_listbox(fm,plot_pch)
  col<-my_listbox(fm,plot_col)
  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))
    eval_command(plot_all())
  },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))
    eval_command(plot_all())
  },side="left")
  my_button(mt,"remove",function(){
    i<-my_value(wave)
    data_plot<<-data_plot[-i-1]
    tkdelete(wave,i)
    eval_command(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")
#  padj<-my_entry(mt,"0")
  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")
  log<-my_checkbutton(mt,"log")
  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(padj)<-p$padj
      my_value(log)<-p$log
      if(! is.na(p$lim)[1] ){
        my_value(lim1)<-p$lim[1]
        my_value(lim2)<-p$lim[2]
      }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),
#      padj=as.numeric(my_value(padj)),
      lim=lim12,
      log=my_value(log) )
    data_axis[[my_value(side)+1]]<<-new
    eval_command(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
    eval_command(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()
    eval_command(plot_all())
  },side="right")
  my_button(mt,"update",function(){
    i<-my_value(wave)
    data_legend$x<<-my_value(x)
    data_legend$y<<-my_value(y)
    data_legend$legend[i+1]<<-my_value(text)
    data_legend$bty<<-my_value(bty)
    eval_command(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=my_value(x),y=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))
    eval_command(plot_all())
  },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))
    eval_command(plot_all())
  },side="left")
  my_button(mt,"remove",function(){
    i=my_value(texts)
    data_text<<-data_text[-i-1]
    tkdelete(texts,i)
    eval_command(plot_all())
  },side="left")
  my_button(mt,"close",function()tkdestroy(mt),side="left")
}
menu_plot_redraw <- function(){
  eval_command(plot_all())
}
menu_plot_expand <- function(){
  rng<-locator(2)
  xyl<-list(sort(rng$x),sort(rng$y),sort(rng$x),sort(rng$y))
  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()
      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]
      if(data_axis[[i]]$log==1){lim<-exp(lim)}
      data_axis[[i]]$lim<<-lim
    }
  }
  eval_command(plot_all())
}
menu_plot_shrink <- function(){
  rng<-locator(2)
  xyl<-list(sort(rng$x),sort(rng$y),sort(rng$x),sort(rng$y))
  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()
      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
    }
  }
  eval_command(plot_all())
}


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")
}


plot_new() #initialization
data_load<-c()
data_top <- my_toplevel(title="graphtk",x=300,y=1)
my_menu(data_top,data_menu)


# 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