R/gui_functions.R

.womNotebookPages <- function(name)
{
COLUMNS <- c(intro=0,data=1,models=2,analysis=3,diagnostics=4,results=5,save=6)
as.integer(COLUMNS[name])
}

womExtractModel <- function(name=1)
{
	return(wommbatAnalysis$Models[[name]])
}

.womCharVectorToAlternatingCol <- function(v)
{
	cols = c("#FFFFFF","#AAAAAA")
	r = rle(v)
	x = r$values
	r$values = (0:(length(x)-1))%%2 + 1
	v = inverse.rle(r)
	cols[v]
}
.womChooseAccCol <- function(accRate)
{
	# good, medium, bad
	cols = c("#339900","#AA7700","#CC0000")
	cols[ (accRate<0.5 | accRate>0.9) + (accRate<0.6 | accRate>0.8) + 1 ]
}

.womFileSafeString <- function(string)
{
	gsub("[^\\w-\\s]","_",string,perl=TRUE)
}


theWidget <- function(name) {
	return(StateEnv$GUI$getObject(name))
}

freezeGUI <- function(echo.to.log=T) {
	StateEnv$win$setSensitive(F)
	StateEnv$win$getWindow()$setCursor(gdkCursorNew("watch"))
	#StateEnv$echo.to.log <- echo.to.log
	#setStatusBar("")
}

thawGUI <- function() {
	StateEnv$win$setSensitive(T)
	StateEnv$win$getWindow()$setCursor(NULL)
	#StateEnv$echo.to.log <- T # default
}

getpackagefile <- function(filename) {
	## Try firstly to load from the installed wommbat package
	## Otherwise, look locally.
	myPath <- system.file("etc", filename, package = "WMCapacity")
	if (identical(myPath, "")) 
		myPath <- file.path("WMCapacity", "WMCapacity", "inst", 
			"etc", filename)
	if (!file.exists(myPath)) stop("could not find file ", filename)
	myPath
}

.womSetStatusBarText <- function(text1=NULL,context="General")
{
	status = theWidget("statusbar1")
	context.id=gtkStatusbarGetContextId(status,context)
	if(!is.null(text1)){
		gtkStatusbarPop(status, context.id)
		gtkStatusbarPush(status, context.id, text1)
	}
}

.present_main_window_after_destroy<-function(widget)
{
	StateEnv$win$present()
}

.womSaneNum <- function(x,prec=0)
{
	if(is.null(x)) return(NULL)
	as.character(round(x,prec))
}


.womSetInitialSensitivity<-function()
{
	.womActiveColumnSelection(FALSE)
	.womActiveModelTab(FALSE)
	.womActiveAnalysisTab(FALSE)
	.womActiveDiagnosticsTab(FALSE)
	.womActiveResultsTab(FALSE)
	.womActiveSaveTab(FALSE)

}

.womGetDataFrameList<-function(envir=globalenv())
{
	n =  sapply(ls(env=envir),function(x){
			eval(parse(text=paste("is.data.frame(",x,")",sep="")),env=globalenv())
				}
	)
	n=n[n]
	data.frame(Name=names(n))
}


.womSelectDataFrame <- function(envir = .GlobalEnv) 
{
	listOfObjects <- .womGetDataFrameList(envir=envir)
	if(dim(listOfObjects)[1]<1){
		gmessage(paste("There are no data frames in the R global environment."), title="Data error",
		icon="error",toolkit=guiToolkit("RGtk2"))
		return(0)

	}
	toplevel = gwindow("Select R data.frame...")
	gtable(listOfObjects,
		container = toplevel,
		action=NULL,
		handler = function(h,...) {
			.womSetDataForColumnSelection(eval(parse(text=as.character(svalue(h$obj)))))
			dispose(toplevel)
		},toplevel=toplevel)
}

.womGetDataFrame <- function(name)
{
	if(length(name)>1) return(NULL)
	z = eval(parse(text=name),env=globalenv())
	if(is.data.frame(z)){
		return(z)
	}else{
		return(NULL)
	}
}

.womIntegerMatrix<-function(m){
  dims=dim(m)
  m2=as.integer(as.matrix(m))
  if(is.null(dims)){
    dim(m2)=c(length(m),1)
  }else{  
    dim(m2)=dims
  }
  return(m2)
}


.notebook_changed_page <- function(notebook,page,page_num)
{
	workingDir = getwd()
	theWidget("saveWorkingDirectoryEntry")$setText(workingDir)
}

.womTreeModelGetNthCol<-function(treemodel,n=0)
{
	totalIters = gtkTreeModelIterNChildren(treemodel, NULL)
	if(totalIters==0) return(NULL)


	retval = 1:totalIters * NA
	
	for(i in 1:totalIters)
	{
		iter = gtkTreeModelGetIterFromString(treemodel, as.character(i-1))$iter
		retval[i] = gtkTreeModelGetValue(treemodel,iter,as.integer(n))$value
	}
	
	return(retval)
}

fileChoose <- function(action="cat", text = "Select a file...", type="open", ...) 
{
	gfile(text=text, type=type, ..., action = action, handler =
		function(h,...) { do.call(h$action, list(h$file)) }, toolkit=guiToolkit("RGtk2")
		)
			
}

.clicked_menu_open <- function(menuitem)
{
	gtkNotebookSetCurrentPage(theWidget("notebook1"), .womNotebookPages("data"))
}


.clicked_menu_saveas <- function(menuitem)
{
	gtkNotebookSetCurrentPage(theWidget("notebook1"), .womNotebookPages("save"))
}

.clicked_menu_help <- function(menuitem)
{
	browseURL(url="http://wmcapacity.r-forge.r-project.org/")
}

clearComboModel <- function(combo)
{
	gtkComboBoxSetActive(combo,-1)
	model = gtkComboBoxGetModel(StateEnv$itersCombo)
	Nelements = gtkTreeModelIterNChildren(model)
	for(i in 1:Nelements)
	{
		gtkComboBoxRemoveText(combo, 0)
	}
}


# Next four functions taken from rattle
Rtxt <- function(...)
{
  # Currently, on Windows we are waiting for 2.12.17 of  RGtk2 with
  # rgtk2_bindtextdomain().

#  if (.Platform$OS.type == "windows")
#    paste(...)
#  else
    gettext(paste(...), domain="R-WMCapacity")
}

# This is used to avoid the string being identified as a translation, as in
# RtxtNT(paste(vals ...))

RtxtNT <- Rtxt


packageIsAvailable <- function(pkg, msg=NULL)
{
  #if (pkg %notin% rownames(installed.packages()))
  if (!require(pkg, quietly=TRUE))
  {
    if (not.null(msg))
      if (questionDialog(sprintf(Rtxt("The package '%s' is required to %s.",
                                      "It does not appear to be installed.",
                                      "A package can be installed",
                                      "with the following R command:",
                                      "\n\ninstall.packages('%s')",
                                      "\n\nThis will allow access to use",
                                      "the full functionality of %s.",
                                      "\n\nWould you like the package to be installed now?"),
                                 pkg, msg, pkg, crv$appname)))
      {
        install.packages(pkg)
        return(TRUE)
      }
    return(FALSE)
  }
  else
    return(TRUE)
}


"%notin%" <- function(x,y) ! x %in% y

Try the WMCapacity package in your browser

Any scripts or data that you put into this service are public.

WMCapacity documentation built on May 2, 2019, 6:15 p.m.