R/generic.interface.R

In FSAtools: Fragment Analysis and Capillary Sequencing Tool Kit

# Generic .fsa collection processing pipeline interface
generic.interface <- function() {
	
	# Version name
	verName <- paste("FSAtools", as.character(packageVersion("FSAtools")), sep=" ")
	
	
	## FUNCTIONS ##
	
	inputBrowse <- function() {
		tcltk::tclvalue(inputValue) <- tk.folder(
			title = "Input directory",
			mustexist = TRUE,
			mandatory = TRUE
		)
		
		# Guess output
		if(tcltk::tclvalue(outputValue) == "") tcltk::tclvalue(outputValue) <- basename(tcltk::tclvalue(inputValue))
		
		# Guess design
		if(tcltk::tclvalue(designValue) == "") {
			conf <- dir(tcltk::tclvalue(inputValue), recursive=TRUE, pattern=".+\\.conf$", full.names=TRUE)
			if(length(conf) == 1) tcltk::tclvalue(designValue) <- conf
		}
	}
	
	designBrowse <- function() {
		tcltk::tclvalue(designValue) <- tk.file(
			title = "Design file",
			typeNames = "Configuration file",
			typeExt = "*.conf",
			multiple = FALSE,
			mandatory = TRUE,
			type = "open",
			parent = topLevel
		)
	}

	outputBrowse <- function() {
		tcltk::tclvalue(outputValue) <- tk.file(
			title = "Output file names",
			typeNames = "Output log file",
			typeExt = "*.log",
			multiple = FALSE,
			mandatory = TRUE,
			type = "open",
			parent = topLevel
		)
	}
	
	process <- function() {
		# Watch cursor
		tcltk::tkconfigure(topLevel, cursor="watch")
		
		# Log file
		logFile <- sprintf("%s.log", tcltk::tclvalue(outputValue))
		
		# Error-catching processing
		status <- generic.log(
			input = tcltk::tclvalue(inputValue),
			design = tcltk::tclvalue(designValue),
			output = tcltk::tclvalue(outputValue),
			progressBar = progressBar,
			logFile = logFile
		)
		
		# Status
		if(is(status, "error"))            { tcltk::tkmessageBox(parent=topLevel, icon="error", type="ok", title="R error", message=sprintf("An error occured, check the log file for details.\n(%s)", conditionMessage(status)))
		} else if(identical(status, TRUE)) { tcltk::tkmessageBox(parent=topLevel, parent=topLevel, icon="info", type="ok", title="Done", message="Processing achieved without warning.")
		} else                             { tcltk::tkmessageBox(parent=topLevel, parent=topLevel, icon="warning", type="ok", title="Done", message=sprintf("Processing achieved with %i warning(s), please refer to the log file.", status))            
		}
		
		# Normal cursor
		tcltk::tkconfigure(topLevel, cursor="arrow")
	}
	
	replaceEntry = function(widget) {
		tcltk::tkfocus("-force", widget)
		tcltk::tcl(widget, "delete", "0", "end")
		tcltk::tcl(widget, "icursor", "end")
	}
	
	
	## INTERFACE ##
	
	# Top level
	topLevel <- tcltk::tktoplevel()
	tcltk::tktitle(topLevel) <- "FSAtools processor"
	
	# Horizontal resizing
	tcltk::tkgrid.columnconfigure(topLevel, 1, weight=1)
		
		# Preprocessing frame
		allFrame <- tcltk::ttklabelframe(parent=topLevel, relief="groove", borderwidth=2, text=verName)
		tcltk::tkgrid.columnconfigure(allFrame, 2, weight=1)
		
			# Input directory
			inputValue <- tcltk::tclVar("")
			inputButton <- tcltk::tkbutton(parent=allFrame, text="Input directory", command=inputBrowse, width=20)
			inputEntry <- tcltk::tkentry(parent=allFrame, textvariable=inputValue, width=70)
			tcltk::tkgrid(inputButton, column=1, row=1, padx=c(8,2), pady=c(8,2))
			tcltk::tkgrid(inputEntry, column=2, row=1, padx=c(2,8), pady=c(8,2), sticky="ew")
			
			# Design file
			designValue <- tcltk::tclVar("")
			designButton <- tcltk::tkbutton(parent=allFrame, text="Design file", command=designBrowse, width=20)
			designEntry <- tcltk::tkentry(parent=allFrame, textvariable=designValue, width=70)
			tcltk::tkgrid(designButton, column=1, row=2, padx=c(8,2), pady=2)
			tcltk::tkgrid(designEntry, column=2, row=2, padx=c(2,8), pady=2, sticky="ew")
			
			# Output files
			outputValue <- tcltk::tclVar("")
			outputButton <- tcltk::tkbutton(parent=allFrame, text="Output files", command=outputBrowse, width=20)
			outputEntry <- tcltk::tkentry(parent=allFrame, textvariable=outputValue, width=70)
			tcltk::tkgrid(outputButton, column=1, row=3, padx=c(8,2), pady=2)
			tcltk::tkgrid(outputEntry, column=2, row=3, padx=c(2,8), pady=2, sticky="ew")
			
			# Progression
			progressButton <- tcltk::tkbutton(parent=allFrame, text="Process", command=process, width=20)
			progressBar <- tcltk::ttkprogressbar(parent=allFrame, value=0, maximum=101, length=300)
			tcltk::tkgrid(progressButton, column=1, row=6, padx=c(8,2), pady=c(2,8))
			tcltk::tkgrid(progressBar, column=2, row=6, padx=c(2,8), pady=c(2,8), sticky="ew")
		
		tcltk::tkgrid(allFrame, column=1, row=1, padx=5, pady=5, sticky="nsew")
		
		# Help frame
		helpFrame <- tcltk::ttklabelframe(parent=topLevel, relief="groove", borderwidth=2, text="How to", width=100)
			
			# Help message
			helpMessage <- tcltk::tkmessage(parent=helpFrame, width=650, text="- Click buttons to select files and directories, or type their paths directly.\n- The \"Input directory\" must contain \".fsa\" files to process (sub-directories will be explored too).\n- A design file (.conf) stored with the data files (.fsa) will be detected automatically.")
			tcltk::tkgrid(helpMessage, column=1, row=1, padx=8, pady=8)
		
		tcltk::tkgrid(helpFrame, column=1, row=2, padx=5, pady=5, sticky="nsew")
		
	# Freeze size
	tcltk::tkwm.minsize(topLevel, 720, 260)
	tcltk::tkwm.resizable(topLevel, 1, 0)
	
	# Entry events
	tcltk::tkbind(inputEntry,  "<ButtonPress-3>", function(){ replaceEntry(inputEntry) })
	tcltk::tkbind(designEntry, "<ButtonPress-3>", function(){ replaceEntry(designEntry) })
	tcltk::tkbind(outputEntry, "<ButtonPress-3>", function(){ replaceEntry(outputEntry) })
	
	# Wait for closing
	tcltk::tkwait.window(topLevel)
}