#########################################################
## Copyright (c) 2005
## University of Washington
## Licensed under the terms set forth by University of
## Washington. If you did not sign such a license, you
## are using this software/code illegally and you do not
## have permission to use, modify, or redistribute
## this or any files in this software package.
##
## File: includeui.r
## Utility functions for Tcl/Tk GUIs.
#########################################################
source("include.r")

## Existence of this function indicates that the file has been loaded before
includeui.r <- function()
{
}

#########################################################################
## This function posts information for the user.                      
## Arguments:
##   message.txt : A Tcl/Tk text area
##   msg : The text to show
##   bell : Whether to beep after showing the message
##   newline : Whether to add a newline to msg
#########################################################################
post.txt.msg <<- function(message.txt, msg, bell=FALSE,newline=TRUE) {
  tkconfigure(message.txt, state="normal")
  if(newline)
    tkinsert(message.txt,"end",paste(msg, "\n"))
  tkyview.moveto(message.txt,1)
  tkconfigure(message.txt,state="disabled")
  if(require(tcltk, quietly = TRUE, keep.source = FALSE) && bell) tkbell()
  .Tcl("update idletasks")
}

#########################################################################
## Creates a list specifying text size, colors, etc. that can be reused.
#########################################################################
new.uidefaults <- function(
  titleFont = "Helvetica 18",
  background="Black",
  bigForeground="Green",
  normalFont="Helvetica 14",
  buttonBackground="Green",
  buttonForeground="Black",
  foreground="Green",
  listForeground="White",
  listBackground="Black",
  littleFont="Helvetica 11",
  tableFont="Courier 11",
  disabledForeground="Gray"
  )
{
  uidefaults <- list(titleFont=titleFont, 
                     background=background,
		     foreground=foreground,
		     bigForeground=bigForeground,
		     normalFont=normalFont,
		     buttonBackground=buttonBackground,
		     buttonForeground=buttonForeground,
		     listForeground=listForeground,
		     listBackground=listBackground,
		     littleFont=littleFont,
		     tableFont=tableFont,
                     disabledForeground=disabledForeground)
  return(uidefaults)
}

#########################################################################
## Creates a Tcl/Tk frame with a scrollable text area inside of it.
## Arguments:
##   parentwindow: The parent window for the frame (all frames must have
##     a parent)
##   uidefaults: A "uidefaults" structure describing the formatting
##     for the frame (text size, colors, etc)
#########################################################################
create.message.frame <- function(parentwindow, uidefaults) {
  message.frm <- tkframe(parentwindow, bd = 2, bg = uidefaults$background )
  message.txt <- tktext(message.frm, bg = uidefaults$background, fg = uidefaults$foreground,
    font = uidefaults$normalFont, height = 10, width = 60, wrap="word")
  message.scr <- tkscrollbar(message.frm, command = function(...) tkyview(message.txt, ...))
  tkconfigure(message.txt, yscrollcommand = function(...) tkset(message.scr, ...))
  tkpack(message.txt, side = "left", fill = "both")
  tkpack(message.scr, side = "right", fill = "y")
  return(list(frame=message.frm, textarea=message.txt))
}

  
#########################################################################
## Creates a Tcl/Tk frame containing a checkbox and some text, and
## formats it using a uidefaults list.
##
## Arguments:
##   parent : the parent window for the new frame
##   text : text to display next to the checkbutton
##   uidefaults : a list created by "new.uidefaults" specifying the
##     formatting for the checkbutton
##   variable : the Tcl/Tk variable containing the current state of
##     the checkbox (use tclVar() to create one)
##   font : if non-null, use this font rather than the one in uidefaults
##   command : if non-null, run this command when the checkbox is clicked
##
## Returns:
##   An object of class "edge.checkbutton", with the following members:
##   frame : the frame containing the checkbox and text label
##   label : the actual Tcl/Tk label
##   checkbutton : the actual Tcl/Tk checkbox
#########################################################################
new.checkbutton <- function(parent, text="", uidefaults, variable=NULL, font=NULL, command=NULL)
{
  cbfrm <- tkframe(parent, bg=uidefaults$background)
  cb <- tkcheckbutton(cbfrm, 
                      bg = uidefaults$background, 
		      selectcolor = uidefaults$bigForeground,
		      fg = uidefaults$background,
		      variable = variable)
  if (!is.null(command))
    tkconfigure(cb, command = command)

  if (is.null(font))
    font = uidefaults$normalFont

  cblbl <- tklabel(cbfrm, bg = uidefaults$background,
                   fg = uidefaults$foreground, font = font)

  if(!is.null(text) && !is.na(text))
    tkconfigure(cblbl, text = text)

  tkgrid(cb, cblbl)
  ret <- list(frame = cbfrm, label = cblbl, checkbutton = cb)
  class(ret) <- "edge.checkbutton"
  return(ret)
}

#########################################################################
## Creates a Tcl/Tk frame containing a radio button and some text, and
## formats it using a uidefaults list.
##
## Arguments:
##   parent : the parent window for the new frame
##   text : text to display next to the radiobutton
##   uidefaults : a list created by "new.uidefaults" specifying the
##     formatting for the radiobutton
##   variable : the Tcl/Tk variable containing the current state of
##     the radio button (use tclVar() to create one)
##   font : if non-null, use this font rather than the one in uidefaults
##   command : if non-null, run this command when the radiobutton is clicked
##
## Returns:
##   An object of class "edge.radiobutton", with the following members:
##   frame : the frame containing the radiobox and text label
##   label : the actual Tcl/Tk label
##   radiobutton : the actual Tcl/Tk radiobutton
##   uidefaults : the uidefaults used to format the object
#########################################################################
new.radiobutton <- function(parent, text=NULL, uidefaults, variable=NULL, value=NULL, font=NULL, command=NULL)
{
  if(is.null(variable) || is.na(variable))
    stop("argument 'variable' required")

  if(is.null(value) || is.na(value))
    stop("argument 'value' required")

  rbfrm <- tkframe(parent, bg=uidefaults$background)
  rb <- tkradiobutton(rbfrm, 
		      bd = 2, 
                      bg = uidefaults$background, 
		      selectcolor = uidefaults$bigForeground,
		      fg = uidefaults$background,
		      variable = variable,
		      value = value)
  if (!is.null(command))
    tkconfigure(rb, command = command)

  if (is.null(font))
    font = uidefaults$normalFont
  rblbl <- tklabel(rbfrm, bg = uidefaults$background,
                   fg = uidefaults$foreground, font = font)
  if(!is.null(text) && !is.na(text))
    tkconfigure(rblbl, text = text)

  tkgrid(rb, rblbl)
  ret <- list(frame = rbfrm, label = rblbl, radiobutton = rb, uidefaults=uidefaults)
  class(ret) <- "edge.radiobutton"
  return(ret)
}

#########################################################################
## Creates a tklabel with a PNG image as its content.
##
## Arguments:
##   parent : the parent window or frame
##   imagefile : path to the image file to be displayed
##   uidefaults : formatting information list, as created by new.uidefaults()
#########################################################################
new.png <- function(parent, imagefile, uidefaults)
{
  if(get.os() == "macosx") {
    ext <- ".dylib"
  } else {
    ext <- .Platform$dynlib.ext
  }
  
  libname <- paste("libtkpng0.7", ext, sep="")
  .Tcl(paste("package ifneeded tkpng 0.7  [list load [file join . ", libname, "]]", sep=""))
  .Tcl("package require tkpng")
  tclImage <- paste("image create photo", imagefile, "-format png -file", imagefile)
  .Tcl(tclImage)
  lbl <- tklabel(parent, image=imagefile, bg=uidefaults$background)
}

#########################################################################
## Disable a radiobutton or checkbutton created by new.radiobutton
## or new.checkbutton
#########################################################################
disable <- function(x)
{
  if(class(x) == "edge.radiobutton")
    disable.edge.radiobutton(x)
  if(class(x) == "edge.checkbutton")
    disable.edge.checkbutton(x)
}

#########################################################################
## Enable a radiobutton or checkbutton created by new.radiobutton
## or new.checkbutton
#########################################################################
enable <- function(x)
{
  if(class(x) == "edge.radiobutton")
    enable.edge.radiobutton(x)
  if(class(x) == "edge.checkbutton")
    enable.edge.checkbutton(x)
}
  
disable.edge.radiobutton <- function(rb)
{
  tkconfigure(rb$label, state="disabled")
  tkconfigure(rb$radiobutton, state="disabled")
}

enable.edge.radiobutton <- function(rb)
{
  tkconfigure(rb$label, state="normal")
  tkconfigure(rb$radiobutton, state="normal")
}

disable.edge.checkbutton <- function(cb)
{
  tkconfigure(cb$label, state="disabled")
  tkconfigure(cb$checkbutton, state="disabled")
}

enable.edge.checkbutton <- function(cb)
{
  tkconfigure(cb$label, state="normal")
  tkconfigure(cb$checkbutton, state="normal")
}

###############################################################
## Function: tcl.callback.with.args
##
## Extends ".Tcl.callback" to include function arguments.
## Say you have a function:
## f <- function(a, b) { print(a); print(b); }
##
## Then tcl.callback.with.args(f, a=5, b=6) will return
## a string resembling
##
## "R_call 0x1d7b060 5 6"
##
## which can be passed directly to .Tcl()
##
## See the Tcl/Tk documentation for more information on callbacks.
###############################################################
tcl.callback.with.args <-function(f, ...)
{
  cmd <- .Tcl.callback(f)
  args <- list(...)
  argnames <- names(args)
  for(i in 1:length(args))
  {
    name <- argnames[i]
    if("" == name)
      stop(paste("Argument", i, "is not named"))

    arg <- args[[i]]
    if(class(arg) == "tclVar")
    {
      argstr <- paste("$", sub(" ", "", .Tcl.args(arg)), sep="")
    }
    else if (is.numeric(arg) || is.character(arg))
      argstr <- paste(arg)
    else
      stop(paste("cannot handle args of type", class(arg)))
    cmd = sub(paste("%", name, sep=""), argstr, cmd)
  }
  return(cmd)
}

#########################################################################
## secsToString                                                          
## Converts a number of seconds to a string
## with hours, minutes, seconds.
##       Arguments:                                                      
##         secs - the number of seconds                              
#########################################################################
secsToString <- function(secs)
{
  hh <- as.integer(secs %/% 3600)
  secs <- secs %% 3600
  mm <- as.integer(secs %/% 60)
  secs <- round(secs %% 60, 2)


  return(sprintf("%02d:%02d:%02.0f", hh, mm, secs))
}

if(!exists("tclServiceMode"))
{
##  warning("R version is previous to 2.1.1, so tclServiceMode is absent. We recommend upgrading to the latest version of R.")
  tclServiceMode <- function(on = NULL)
  {
  }
} 


################################################################
## Attempts to use dyn.load to load a dynamic library.
################################################################
try.load <- function(libname, printmsg=function(msg) stop(msg))
{
  tryCatch(dyn.load(libname), error=
           function(e)
           printmsg(paste("The operation requires the dynamic library '",
                          libname,
                          "', which could not be loaded. Please check for this library's existence and try again.",
                          sep="")))
}

################################################################
## Calls tkpack(), then generates a Tk event named "<<Pack>>"
################################################################
tkpack.withevent <- function(...)
{
  tkpack(...)
  args <- list(...)
  for(i in 1:length(args)) {
    if(names(args)[i] == "")
      tkevent.generate(args[[i]], "<<Pack>>")
  }
}

################################################################
## Calls tkpack.forget(), then generates a Tk event named "<<PackForget>>"
################################################################
tkpack.forget.withevent <- function(...)
{
  tkpack.forget(...)
  args <- list(...)
  for(i in 1:length(args)) {
    if(names(args)[i] == "")
      tkevent.generate(args[[i]], "<<PackForget>>")
  }
}

