R/XPSCompareGUI.r
In GSperanza/RxpsG_2.3-1: Processing Tool for X-ray Photoelectron Spectroscopy Data
Defines functions
XPSCompare
Documented in
XPSCompare
#XPSCompare() function to create plots in multi-panel mode
#'
#' @title XPSCompare is used to compare Core-Line spectra
#' @description XPSCompare provides a userfriendly interface to select
#' the XPS-Core-Lines together with their best fit to be plotted in
#' individual panels. XPSCompare permits the selection of plotting options
#' for a personalized data representation.
#' This function is based on the (/code{Lattice}) Package.
#' @examples
#' \dontrun{
#' XPSCompare()
#' }
#' @export
#'
XPSCompare <- function(){
#---- calls the function to plot spectra folloowing option selection -----
CtrlPlot <- function(){
N.XS <- length(FNamesCoreLines$XPSSample)
N.CL <- length(FNamesCoreLines$CoreLines)
if (N.XS == 0) {
gmessage(msg="Please select XPS Samples!", title="NO XPS SAMPLES SELECTED", icon="warning")
return()
}
if (length(FNamesCoreLines$Ampli) == 0){
N <- N.XS * N.CL
FNamesCoreLines$Ampli <<- rep(1,N)
}
SelectedNames <- FNamesCoreLines
SelectedNames$CoreLines <- svalue(T1CLineListCK)
LL <- length(SelectedNames$CoreLines)
if (LL == 0) {
gmessage(msg="Please select The Core Lines to plot!", title="NO CORE-LINES SELECTED", icon="warning")
return()
}
if (length(PanelTitles) == 0) {
for (ii in 1:LL){
PanelTitles <- c(PanelTitles, SelectedNames$CoreLines[ii]) #List of Titles for the Multipanel
}
} else {
PanelTitles <- SelectedNames$CoreLines
}
Plot_Args$PanelTitles <<- PanelTitles
Limits <- XPScompEngine(PlotParameters, Plot_Args, SelectedNames, Xlim, Ylim)
}
#----- Update table containing the selected XPSSample names and corelines
RefreshTab <- function(FNamesCoreLines){
delete(T1group1, NameTable)
#If Compare.Coreline is selected likely the number of elements of FNamesCoreLines$XPSSample != FNamesCoreLines$CoreLines
LL.X <- length(FNamesCoreLines$XPSSample)
LL.CL <- length(FNamesCoreLines$CoreLines)
if (LL.X < LL.CL){
tmp <- rep(" ", (LL.CL-LL.X))
FNamesCoreLines$XPSSample <- c(FNamesCoreLines$XPSSample, tmp)
}
if (LL.CL < LL.X){
tmp <- rep(" ", (LL.X-LL.CL))
FNamesCoreLines$CoreLines <- c(FNamesCoreLines$CoreLines, tmp)
}
if (LL.X == 0) {
dummy <- list(XPSSample=c(" ", " "),CoreLines=c(" ", " ")) #dummy list to begin: NB each column has 2 initial element otherwise error...
dummy$XPSSample <- encodeString(dummy$XPSSample, width=40, justify="right")
dummy$CoreLines <- encodeString(dummy$CoreLines, width=40, justify="right")
NameTable <<- gtable(dummy, expand=TRUE, fill=TRUE, container=T1group1) #table with the selected FNames
} else {
TabNames <- list(XPSSample=c(FNamesCoreLines$XPSSample, " "), CoreLines=c(FNamesCoreLines$CoreLines, " "))
LL <- length(TabNames$XPSSample)
for(ii in 1:LL){
TabNames$XPSSample[ii] <- encodeString(TabNames$XPSSample[ii], width=40, justify="right")
TabNames$CoreLines[ii] <- encodeString(TabNames$CoreLines[ii], width=40, justify="right")
}
NameTable <<- gtable(TabNames, expand=TRUE, container=T1group1) #Table with the list of selected names
}
names(NameTable) <<- c("XPSSample", "CoreLines")
}
#--- Routine for drawing Custom Axis
CustomAx <- function(CustomDta){
AxWin <- gwindow(title="CUSTOM AXIS", visible=FALSE)
AxGroup1 <- ggroup(horizontal=FALSE, container=AxWin)
txt1="1) Set Axis min, Axis max values: es. min=0, max=10, Nticks=5"
txt2="2) Set desired Number of Ticks: es. 5"
glabel(txt1, container=AxGroup1)
glabel(txt2, container=AxGroup1)
AxFrame <- gframe("Set Axis Elements", horizontal=FALSE, container=AxGroup1)
AxLayout <- glayout(homogeneous=FALSE, spacing=3, container=AxFrame)
axMin <- as.character(round(CustomDta[[1]], 2))
axMax <- as.character(round(CustomDta[[2]], 2))
msg1 <- paste("Xmin (min value=", axMin, "):", sep="")
msg2 <- paste("Xmax (max value=", axMax, "):", sep="")
if (CustomDta[[3]] == "Y") {
msg1 <- paste("Ymin (min value=", axMin, "):", sep="")
msg2 <- paste("Ymax (max value=", axMax, "):", sep="")
}
AxLayout[1,1] <- EditXmin <- gedit(initial.msg =msg1, width=40, container=AxLayout)
AxLayout[1,2] <- EditXmax <- gedit(initial.msg =msg2, width=40, container=AxLayout)
AxLayout[3,1] <- EditNTicks <- gedit(initial.msg ="N.Ticks", container=AxLayout)
gbutton(" SAVE & EXIT ", handler=function(h,...){
axMin <- as.numeric(svalue(EditXmin)) #X or Y scale min value
axMax <- as.numeric(svalue(EditXmax)) #X or Y scale max value
axRange <- sort(c(axMin, axMax)) #X or R scale range
NTicks <- as.numeric(svalue(EditNTicks))
if (is.na(axMin*axMax)) {
gmessage("ATTENTION: plase set all the min, max values!", title = "CHANGE X Y RANGE", icon = "error")
}
if (is.null(NTicks)){
gmessage("Please N. Major Ticks required!", icon="warning")
} else {
dx <- (axMax-axMin)/NTicks
axStp <- seq(from=axMin, to=axMax, by=dx)
Ticklabels <- as.character(round(axStp,digits=1))
if (CustomDta[[3]] == "X") {
if (FName[[SpectIndx]]@Flags) { #Binding energy set reverse X axis
axRange <- sort(c(axMin, axMax), decreasing=TRUE)
} else {
axRange <- sort(c(axMin, axMax))
}
Plot_Args$scales$x <<- list(at=axStp, labels=Ticklabels)
Plot_Args$xlim <<- axRange
Xlim <<- axRange
} else if (CustomDta[[3]] == "Y") {
Plot_Args$scales$y <<- list(at=axStp, labels=Ticklabels)
Plot_Args$ylim <<- axRange
Ylim <<- axRange
}
dispose(AxWin)
CtrlPlot()
Plot_Args$scales$relation <<- "free"
}
}, container = AxFrame)
visible(AxWin) <- TRUE
}
SetLinesPoints <- function(){
if ( svalue(T3_SetLines) == "OFF" && svalue(T3_SetSymbols) == "OFF") {
Plot_Args$type <<- "l" #cancel line and symbols and legends
AutoKey_Args$lines <<- FALSE
AutoKey_Args$points <<- FALSE
AutoKey_Args$col <<- rep("white", 20)
PlotParameters$Colors <<- rep("white", 20)
Plot_Args$lty <<- LType
Plot_Args$par.settings$superpose.symbol$col <<- rep("white", 20)
Plot_Args$par.settings$superpose.symbol$pch <<- rep(STypeIndx[1], 20)
Plot_Args$par.settings$superpose.line$col <<- rep("white", 20)
}
if ( svalue(T3_SetLines) == "ON" && svalue(T3_SetSymbols) == "OFF") {
Plot_Args$type <<- "l" # lines only
AutoKey_Args$lines <<- TRUE
AutoKey_Args$points <<- FALSE
AutoKey_Args$col <<- Colors
PlotParameters$Colors <<- Colors
Plot_Args$lty <<- LType
Plot_Args$par.settings$superpose.line$col <<- Colors #Rainbow plot
Plot_Args$par.settings$superpose.line$lty <<- rep("solid", 20)
if (svalue(T3F_SetLines) == "pattern") {
Plot_Args$par.settings$superpose.line$lty <<- LType
}
if (svalue(T3_BW_Col)=="B/W") {
AutoKey_Args$col <<- rep("black", 20)
PlotParameters$Colors <<- "black"
Plot_Args$par.settings$superpose.line$col <<- rep("black", 20) #B/W plot
Plot_Args$par.settings$superpose.line$lty <<- LType
}
}
if ( svalue(T3_SetLines) == "OFF" && svalue(T3_SetSymbols) == "ON") {
Plot_Args$type <<- "p" # symbols only
AutoKey_Args$lines <<- FALSE
AutoKey_Args$points <<- TRUE
AutoKey_Args$col <<- Colors
PlotParameters$Colors <<- Colors
Plot_Args$pch <<- rep(STypeIndx[1], 20)
Plot_Args$par.settings$superpose.symbol$pch <<- rep(STypeIndx[1], 20)
Plot_Args$par.settings$superpose.symbol$col <<- Colors
if (svalue(T3F_SetSymbols) == "multi-symbols") {
Plot_Args$pch <<- STypeIndx
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
}
if (svalue(T3_BW_Col) == "B/W") {
PlotParameters$Colors <<- "black"
Plot_Args$pch <<- STypeIndx
Plot_Args$par.settings$superpose.symbol$col <<- rep("black", 20)
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
AutoKey_Args$col <<- rep("black", 20)
}
}
if ( svalue(T3_SetLines) == "ON" && svalue(T3_SetSymbols) == "ON") {
Plot_Args$type <<- "b" #both: line and symbols
AutoKey_Args$lines <<- TRUE
AutoKey_Args$points <<- TRUE
Plot_Args$lty <<- LType
Plot_Args$pch <<- STypeIndx
if (svalue(T3_BW_Col)=="B/W") {
AutoKey_Args$col <<- rep("black", 20)
PlotParameters$Colors <<- "black"
Plot_Args$par.settings$superpose.line$lty <<- LType
Plot_Args$par.settings$superpose.line$col <<- rep("black", 20) #B/W plot
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
Plot_Args$par.settings$superpose.symbol$col <<- rep("black", 20)
} else {
AutoKey_Args$col <<- Colors
PlotParameters$Colors <<- Colors
Plot_Args$par.settings$superpose.line$col <<- Colors #Rainbow plot
Plot_Args$par.settings$superpose.line$lty <<- rep("solid", 20)
if (svalue(T3F_SetLines) == "pattern") {
Plot_Args$par.settings$superpose.line$lty <<- LType
}
Plot_Args$par.settings$superpose.symbol$col <<- Colors
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx[1]
if (svalue(T3F_SetSymbols) == "multi-symbols") {
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
}
}
}
CtrlPlot()
}
CheckCL <- function(){
CommonCL <- sapply(CLlist[[1]], function(x) unlist(strsplit(x, "\\."))[2] )
N.CL <- length(CommonCL) #N. Corelines in the reference XPS-Sample (first selected sample)
N.XS <- length(FNamesCoreLines$XPSSample) #Number of N. XPSSpectra selected
XpSamp <- get(FNamesCoreLines$XPSSample[1], envir=.GlobalEnv)
RngX <- RngY <- list(CLName=NULL, min=NULL, max=NULL)
for(jj in 1:N.CL){ #Range of CoreLines of XPSSample1
RngX[[1]][jj] <- CommonCL[jj]
RngX[[2]][jj] <- range(XpSamp[[CommonCL[jj]]]@.Data[1])[1] #First col RngX contains range min value
RngX[[3]][jj] <- range(XpSamp[[CommonCL[jj]]]@.Data[1])[2] #Second col RngX contains range max value
RngY[[1]][jj] <- CommonCL[jj]
RngY[[2]][jj] <- range(XpSamp[[CommonCL[jj]]]@.Data[2])[1]
RngY[[3]][jj] <- range(XpSamp[[CommonCL[jj]]]@.Data[2])[2]
}
#Here we load selected XPSSample to see which CoreLines contains.
#The X and Y range OK for all the common corelines of all XPSSamples
if (N.XS > 1) {
for (ii in 2:N.XS){
XpSamp <- get(FNamesCoreLines$XPSSample[ii], envir=.GlobalEnv)
CoreLines <- names(XpSamp) #set the CL of the first XPSSample as a reference
for (jj in 1:N.CL){
xx <- grep(CommonCL[jj], CoreLines) #is CL string present in CLlist?
if (length(xx)==0) { #pattern CommonCL[jj] not present in CoreLines vector
CommonCL <- CommonCL[-jj] #drop the elements non common element
}
#work out the X-range Y-range common to the selected Core Lines
RngXmin <- range(XpSamp[[CommonCL[jj]]]@.Data[1])[1]
RngXmax <- range(XpSamp[[CommonCL[jj]]]@.Data[1])[2]
if (RngXmin < RngX[[2]][jj]) {RngX[[2]][jj] <- RngXmin}
if (RngXmax > RngX[[3]][jj]) {RngX[[3]][jj] <- RngXmax}
RngYmin <- range(XpSamp[[CommonCL[jj]]]@.Data[2])[1]
RngYmax <- range(XpSamp[[CommonCL[jj]]]@.Data[2])[2]
if (RngYmin < RngY[[2]][jj]) {RngY[[2]][jj] <- RngYmin}
if (RngYmax > RngY[[3]][jj]) {RngY[[3]][jj] <- RngYmax}
}
}
}
FNamesCoreLines$CoreLines <<- CommonCL
Xlim <<- RngX
Ylim <<- RngY
}
CtrlRepCL <- function(ii){ #CTRL for repeated CL: search for core-lines with same name
LL <- length(CLlist[[ii]])
jj <- 1
while(jj < LL){
SpectName <- CLlist[[ii]][jj]
SpectName <- unlist(strsplit(SpectName, "\\."))
SpectName <- SpectName[2]
Indx <- grep(SpectName, CLlist[[ii]]) #The selected CoreLine name could be in any posiiton in the Destination XPSSample => source Samp Index could be different from Dest Samp index
if (length(Indx) > 1){ #The same coreline can be present more than one time
winCL <- gwindow("SELECT CORELINE", visible=FALSE)
size(winCL) <- c(100, 200)
groupCL <- ggroup(horizontal=FALSE, container=winCL)
N.CL <- length(Indx)
msg <- paste(" Found ", N.CL," ",SpectName, "spectra.\n Please select the coreline to compare")
txt <- glabel(text=msg, container=groupCL)
font(txt) <- list(family="sans",size=12)
gseparator(horizontal=TRUE, container=groupCL)
selectCL <- gradio(CLlist[[ii]][Indx], selected=1, horizontal=TRUE, container=groupCL)
gbutton(" OK ", handler=function(h, ...){
zz <- as.numeric(svalue(selectCL, index=TRUE))
Indx <<- Indx[-zz] #in Indx remain the component to eliminiate
CLlist[[ii]] <<- CLlist[[ii]][-Indx] #eliminate the repeated spectra
LL <<- length(CLlist[[ii]]) #update CLlist length
dispose(winCL)
}, container=groupCL)
visible(winCL) <- TRUE
winCL$set_modal(TRUE) #nothing can be done while running this macro
} #modal mode takes the control of the 'return' value which CANNOT be used to return variable values
jj <- jj+1
}
}
#----- reset parameters to the initial values -----
ResetPlot <- function(){
svalue(T1FNameListCK) <<- NULL
CLlist <<- list()
delete(T1frameCLine, T1CLineListCK)
T1CLineListCK <<- gcheckboxgroup(CLlist,checked=FALSE, container=T1frameCLine) #at beginning CLlist==list()
NamesList <<- list(XPSSample=NULL, CoreLines=NULL)
FNamesCoreLines <<- list(XPSSample=c(" ", " "),CoreLines=c(" "," "), Ampli=NULL) #dummy lists to begin: NB each lcolumn contains 2 element otherwise error
RefreshTab(FNamesCoreLines) #update the table with the name of the selected FNames
FNamesCoreLines <<- list(XPSSample=NULL,CoreLines=NULL,Ampli=NULL ) #dummy lists to begin: NB each lcolumn contains 2 element otherwise error
delete(XSGroup11, objXSamp)
objXSamp <<- gcombobox(c(" "), selected=-1, editable=FALSE, handler=function(h,...){enabled(objScaleFact) <- TRUE}, container=XSGroup11)
delete(CLGroup22, objCLine)
objCLine <<- gcombobox(c(" "), selected=-1, editable=FALSE, handler=function(h,...){enabled(objScaleFact) <- TRUE}, container=CLGroup22)
SaveSelection <<- TRUE
svalue(T1FNameListCK) <<- FALSE
svalue(objFunctNorm) <<- FALSE
svalue(objFunctAlign) <<- FALSE
svalue(objFunctRev) <<- TRUE
svalue(objFunctSwitch) <<- FALSE
svalue(objCLine) <<- -1
svalue(objScaleFact) <<- ""
enabled(objScaleFact) <<- FALSE
svalue(XOffsetobj) <<- 0
svalue(YOffsetobj) <<- 0
svalue(xx1) <<- ""
svalue(xx2) <<- ""
svalue(yy1) <<- ""
svalue(yy2) <<- ""
svalue(T3_BW_Col) <<- "B/W"
svalue(T3_Grid) <<- "Grid OFF"
svalue(T3_SetLines) <<- "ON"
svalue(T3_SetSymbols) <<- "OFF"
svalue(T3_LineType) <<- "patterns"
svalue(T3_LinWidth) <<- 1
svalue(T3_SymType) <<- "single-symbol"
svalue(T3_SymSize) <<- 0.8
svalue(T3_PanStripCol) <<- ""
svalue(T4_XScale) <<- "Regular"
svalue(T4_YScale) <<- "Regular"
svalue(T4_TitSize) <<- 1.4
svalue(T4_AxNumSize) <<- 1
svalue(T4_AxLabSize) <<- 1
svalue(T4_XAxNameChange) <<- ""
svalue(T4_YAxNameChange) <<- ""
svalue(T4_XStep) <<- ""
svalue(T4_YStep) <<- ""
svalue(legendCK) <<- TRUE
svalue(LegColCK) <<- 1
svalue(TSizeCK) <<- 1
svalue(LineWdhCK) <<- 1
svalue(TxtColCK) <<- "B/W"
XPSSettings <<- get("XPSSettings", envir=.GlobalEnv)
Colors <<- XPSSettings$Colors
LType <<- XPSSettings$LType
SType <<- XPSSettings$Symbols
STypeIndx <<- XPSSettings$SymIndx
FitColors <<- c(XPSSettings$BaseColor[1], XPSSettings$ComponentsColor[1], XPSSettings$FitColor[1])
CLPalette <<- data.frame(Colors=Colors, stringsAsFactors=FALSE)
FitPalette <<- data.frame(FitColors=FitColors, stringsAsFactors=FALSE)
PlotParameters <<- DefaultPlotParameters
Plot_Args <<- list( x=formula("y ~ x"), data=NULL, PanelTitles=list(), groups=NULL,layout=NULL,
xlim=NULL,ylim=NULL,
pch=STypeIndx,cex=1,lty=LType,lwd=1,type="l",
background="transparent", col="black",
main=list(label=NULL,cex=1.5),
xlab=list(label=NULL, rot=0, cex=1.2),
ylab=list(label=NULL, rot=90, cex=1.2),
zlab=NULL,
PanelTitles=NULL,
scales=list(cex=1, tck=c(1,0), alternating=c(1), tick.number=NULL, relation="free",
x=list(log=FALSE), y=list(log=FALSE), axs="i"),
xscale.components = xscale.components.subticks,
yscale.components = yscale.components.subticks,
las=0,
par.settings = list(superpose.symbol=list(pch=STypeIndx, fill="black"), #set the symbol fill color
superpose.line=list(lty=LType, col="black"), #needed to set the legend colors
par.strip.text=list(cex=1),
strip.background=list(col="grey90") ),
auto.key = TRUE,
grid = FALSE
)
AutoKey_Args <<- list(space="top",
text=" ",
cex = 1,
type= "l",
lines=TRUE,
points=FALSE,
col="black",
columns=1, #leggends organized in a column
list(corner=NULL,x=NULL,y=NULL)
)
Xlim <<- NULL #reset Xlim
Ylim <<- NULL #reset Ylim
plot.new()
}
#----- Variables -----
if (exists("activeFName", envir=.GlobalEnv)==FALSE){
gmessage("No data present: please load and XPS Sample", title="XPS SAMPLES MISSING", icon="error")
return()
}
FName <- get(activeFName, envir=.GlobalEnv) #load the active FName
ActiveFName <- get("activeFName", envir=.GlobalEnv) #load the name of the active FNamw (string)
SpectIndx <- get("activeSpectIndx", envir=.GlobalEnv)#index of the active coreline
SpectList <- XPSSpectList(ActiveFName) #list of the active XPSSample core lines
NComp=length(FName[[SpectIndx]]@Components)
NCorelines <- NULL
FitComp1 <- ""
for (ii in 1:NComp){
FitComp1[ii] <- paste("C",ii, sep="")
}
FNameListTot <- as.array(XPSFNameList()) #List of all XPSSamples loaded in the workspace
LL <- length(FNameListTot)
jj <- 1
FNamesCoreLines <- list(XPSSample=NULL, CoreLines=NULL, Ampli=NULL)
NamesList <- list(XPSSample=NULL, CoreLines=NULL)
CLlist <- list()
SpectName <- ""
plotted <- FALSE
#--- list of graphical variables
PatternList <- NULL
FontSize <- c(0.6,0.8,1,1.2,1.4,1.6,1.8,2,2.2,2.4,2.6,2.8,3)
AxLabOrient <- c("Horizontal", "Rot-20", "Rot-45", "Rot-70", "Vertical")
XPSSettings <- get("XPSSettings", envir=.GlobalEnv)
Colors <- XPSSettings$Colors
LType <- XPSSettings$LType
SType <- XPSSettings$Symbols
STypeIndx <- XPSSettings$SymIndx
CLPalette <- as.matrix(Colors)
CLPalette <- data.frame(Colors=CLPalette, stringsAsFactors=FALSE)
FitColors <- as.matrix(c(XPSSettings$BaseColor[1], XPSSettings$ComponentsColor[1], XPSSettings$FitColor[1]))
VarNames <- c("BasLnCol", "CompCol", "FitCol")
FitPalette <- data.frame(Object=VarNames, Colors=FitColors, stringsAsFactors=FALSE)
#-------------------------------------------------------------------------------------------------
# LType <- c("solid", "dashed", "dotted", "dotdash", "longdash", #definisco 20 tipi divesi di line pattern
# "twodash", "F8", "431313", "22848222", "12126262",
# "12121262", "12626262", "52721272", "B454B222", "F313F313",
# "71717313", "93213321", "66116611", "23111111", "222222A2" )
#
# SType <- c("VoidCircle", "VoidSquare", "VoidTriangleUp", "VoidTriangleDwn", "Diamond",
# "X", "Star", "CrossSquare", "CrossCircle", "CrossDiamond",
# "SolidSquare", "SolidCircle", "SolidTriangleUp", "SolidTriangleDwn", "SolidDiamond",
# "DavidStar", "SquareCross", "SquareTriang", "CircleCross", "Cross")
# STypeIndx <- c(1, 0, 2, 6, 5,
# 4, 8, 7, 10, 9,
# 15, 16, 17, 25, 18,
# 11, 12, 14, 13, 3)
#
# Colors <- c("black", "red", "limegreen", "blue", "magenta", "orange", "cadetblue", "sienna",
# "darkgrey", "forestgreen", "gold", "darkviolet", "greenyellow", "cyan", "lightblue",
# "turquoise", "deeppink3", "wheat", "thistle", "grey40")
#-------------------------------------------------------------------------------------------------
LWidth <- c(1,1.25,1.5,1.75,2,2.25,2.5,3, 3.5,4)
SymSize <- c(0.2,0.4,0.6,0.8,1,1.2,1.4,1.6,1.8,2) #lattice prende indici simboli piuttosto che nomesimbolo
PanelTitles <- NULL
LegPos <- c("OutsideTop","OutsideRight","OutsideLeft", "OutsideBottom",
"InsideTopRight","InsideTopLeft","InsideBottomRight","InsideBottomLeft")
LegOrient <- c("Vertical", "Horizontal")
LegLineWdh <- c(1,1.5,2,2.5,3,3.5,4,4.5,5)
LegTxtCol <- c("RainBow", "Black")
LegTxtSize <- c(0.4,0.6,0.8,1,1.2,1.4,1.6,1.8,2,2.2,2.4,2.6,2.8,3)
LegDist <- c(0,0.01,0.02,0.04,0.08,0.1,0.12,0.14,0.16,0.18,0.2)
ColorList <- NULL
Xlim <- NULL
Ylim <- NULL
#--- general options
PlotParameters <- list()
PlotParameters$Align <- FALSE
PlotParameters$RTFLtd <- FALSE #restrict plot to RTF region
PlotParameters$Normalize <- NULL
PlotParameters$Reverse <- TRUE #reversed X axes for Bind. Energy
PlotParameters$SwitchE <- FALSE
PlotParameters$XOffset <- list(CL=NA, Shift=0)
PlotParameters$YOffset <- list(CL=NA, Shift=0)
PlotParameters$ScaleFact <- list(XS=NA, CL=NA, ScFact=0)
PlotParameters$CustomXY <- NULL
PlotParameters$OverlayType <- "Compare.CoreLines" #Compare.Corelines and Multi-Panel are fixed options
PlotParameters$OverlayMode <- "Multi-Panel"
PlotParameters$Colors <- "B/W"
#--- legend options
PlotParameters$Labels <- NULL
PlotParameters$Legenda <- FALSE
PlotParameters$LegPos <- "left" #Out side left legend position
PlotParameters$LegLineWdh <- 1
PlotParameters$LegTxtCol <- "RainBow"
PlotParameters$LegTxtSize <- 1
PlotParameters$LegDist <- 0
DefaultPlotParameters <- PlotParameters
#--- comands for Lattice options
Plot_Args <- list( x=formula("y ~ x"), data=NULL, PanelTitles=list(), groups=NULL,layout=NULL,
xlim=NULL, ylim=NULL,
pch=STypeIndx,cex=1,lty=LType,lwd=1,type="l",
background="transparent", col="black",
main=list(label=NULL,cex=1.5),
xlab=list(label=NULL, rot=0, cex=1.2),
ylab=list(label=NULL, rot=90, cex=1.2),
zlab=NULL,
PanelTitles=NULL,
scales=list(cex=1, tck=c(1,0), alternating=c(1), tick.number=NULL, relation="free",
x=list(log=FALSE), y=list(log=FALSE), axs="i"),
xscale.components = xscale.components.subticks,
yscale.components = yscale.components.subticks,
las=0,
par.settings = list(superpose.symbol=list(pch=STypeIndx,fill="black"), #set symbol filling color
superpose.line=list(lty=LType, col="black"), #needed to set legend colors
par.strip.text=list(cex=1),
strip.background=list(col="grey90") ),
auto.key = TRUE,
grid = FALSE
)
AutoKey_Args <- list( space="top",
text=" ",
cex = 1,
type= "l",
lines=TRUE,
points=FALSE,
col="black",
columns=1, #legends organized in a column
list(corner=NULL,x=NULL,y=NULL)
)
SaveSelection <- TRUE #at beginning force the control of the selection to TRUE to avoid error messages
#--- Reset graphical window
plot.new()
assign("MatPlotMode", FALSE, envir=.GlobalEnv) #basic matplot function used to plot data
#===== NoteBook =====
win <- gwindow(" COMPARE SPECTRA ", parent=c(50,10), visible=FALSE)
size(win) <- c(400,400)
maingroup <- ggroup(horizontal=FALSE, container=win)
nb <- gnotebook(expand=TRUE, container = maingroup)
# --- TAB1 ---
#XPS Sample/Coreline selection
T1group1 <- ggroup(label="XPS SAMPLE SELECTION", spacing=5, horizontal=FALSE, container=nb)
layoutT1 <- glayout(homogeneous=FALSE, spacing=5, container=T1group1)
layoutT1[1,1] <- T1frameButtT1 <- gframe(text="PLOT", spacing=5, container=layoutT1)
T1groupButtons <- ggroup(horizontal=FALSE, container = T1frameButtT1)
gbutton("PLOT", handler=function(h,...){
CtrlPlot() #plot selected XPS-SAmples
plotted <<- TRUE
}, container=T1groupButtons)
gbutton("RESET PLOT", handler=function(h,...){
ResetPlot()
}, container=T1groupButtons)
gbutton("UPDATE XPS-SAMPLE LIST", handler=function(h,...){
svalue(T1FNameListCK) <<- NULL
FName <<- get(activeFName, envir=.GlobalEnv)
ActiveFName <<- get("activeFName", envir=.GlobalEnv)
SpectIndx <<- get("activeSpectIndx", envir=.GlobalEnv)
SpectList <<- XPSSpectList(ActiveFName) #sCoreLine list of the XPSSample
NComp <<- length(FName[[SpectIndx]]@Components)
NCorelines <<- NULL
FitComp1 <<- "" #build vector containing names of the fit components on the Active Spectrum
for (ii in 1:NComp){
FitComp1[ii] <- paste("C",ii, sep="")
}
FNameListTot <- as.array(XPSFNameList()) #list of all XPSSample in Envir=.GlobalEnv
LL=length(FNameListTot)
jj <- 1
FNamesCoreLines <<- list(XPSSample=NULL, CoreLines=NULL, Ampli=NULL)
NamesList <<- list(XPSSample=NULL, CoreLines=NULL)
SaveSelection <<- TRUE
delete(T1frameFName, T1FNameListCK) #update panel
T1FNameListCK <<- gcheckboxgroup(FNameListTot,checked=FALSE, handler=function(h,...){
FNamesCoreLines$XPSSample <<- svalue(T1FNameListCK)
FNamesCoreLines$CoreLines <<- list()
LL <- length(FNamesCoreLines$XPSSample)
if (LL > 3) LL <- 3
Plot_Args$auto.key$columns <<- LL
AutoKey_Args$columns <<- LL
Plot_Args$auto.key$text <<- unlist(FNamesCoreLines$XPSSample)
for (ii in 1:LL){
CLlist[[ii]] <<- XPSSpectList(FNamesCoreLines$XPSSample[ii])
}
#checks for corelines common to selected XPSSamples
CheckCL() # CheckCL() defines FNamesCoreLines$CoreLines
delete(T1frameCLine,T1CLineListCK)
T1CLineListCK <<- gcheckboxgroup(FNamesCoreLines$CoreLines, container=T1frameCLine) #refresh gcheckboxgroup for coreline selection
RefreshTab(FNamesCoreLines) #update the table with the name of the selected FNames
delete(XSGroup11, objXSamp)
objXSamp <<- gcombobox(c(" "), selected=-1, editable=FALSE, container=XSGroup11)
delete(T2CLgroup, CLPanel) #clear CLPanel
CLPanel <<- gcombobox(FNamesCoreLines$CoreLines, selected = -1, editable = FALSE, container=T2CLgroup) #refresh combobox for custom XY scale
}, container=T1frameFName)
ResetPlot()
plot.new()
}, container=T1groupButtons)
gbutton(" EXIT ", handler=function(h,...){
dispose(win)
}, container=T1groupButtons)
layoutT1[1,2] <- T1frameFName <- gframe(text="SELECT XPS-SAMPLE", spacing=5, container=layoutT1)
T1FNameListCK <- gcheckboxgroup(FNameListTot,checked=FALSE, handler=function(h,...){
FNamesCoreLines$XPSSample <<- svalue(T1FNameListCK)
if (length(FNamesCoreLines$XPSSample) == 0 ){
FNamesCoreLines$XPSSample <<- list() #checkbox deselection
FNamesCoreLines$CoreLines <<- list()
Plot_Args$PanelTitles <<- list()
CLlist <<- list()
} else {
FNamesCoreLines$CoreLines <<- list()
LL <- length(FNamesCoreLines$XPSSample)
if (LL > 3) {
Plot_Args$auto.key$columns <<- 3
AutoKey_Args$columns <<- 3
}
Plot_Args$auto.key$text <<- unlist(FNamesCoreLines$XPSSample)
# Define only the CLlist for the new selected XPSSample
CLlist[[LL]] <<- XPSSpectList(FNamesCoreLines$XPSSample[LL])
CtrlRepCL(LL) #controls if same spectra are repeated in CLlist[[LL]]
CheckCL() #check for corelines common to selected XPSSamples
}
delete(XSGroup11, objXSamp)
objXSamp <<- gcombobox(FNamesCoreLines$XPSSample, selected=-1, editable=FALSE, container=XSGroup11)
delete(T1frameCLine,T1CLineListCK)
T1CLineListCK <<- gcheckboxgroup(FNamesCoreLines$CoreLines, handler=function(h, ...) {
SelectedCL <- svalue(T1CLineListCK) #update objCLineobject
delete(CLGroup22,objCLine)
objCLine <<- gcombobox(SelectedCL, selected=-1, editable=FALSE, handler=function(h,...){
PlotParameters$XOffset <- list(CL=NA, Offset=0)
PlotParameters$YOffset <- list(CL=NA, Offset=0)
PlotParameters$ScaleFact <- list(XS=NA, CL=NA, ScFact=0)
enabled(objScaleFact) <- !is_empty(svalue(objXSamp)) #TRUE only if an XPSSample was selected
enabled(XOffsetobj) <- TRUE
enabled(YOffsetobj) <- TRUE
}, container=CLGroup22)
}, container=T1frameCLine) #refresh gcheckboxgroup for coreline selection
add(T1frameCLine, T1CLineListCK)
RefreshTab(FNamesCoreLines) #update the table with the name of the selected FNames
delete(T2CLgroup, CLPanel)
CLPanel <<- gcombobox(FNamesCoreLines$CoreLines, selected = -1, editable = FALSE, container=T2CLgroup) #refresh combobox for custom XY scale
}, container=T1frameFName)
layoutT1[1,3] <- T1frameCLine <- gframe(text="SELECT SPECTRA", spacing=5, container=layoutT1)
T1CLineListCK <- gcheckboxgroup(CLlist,checked=FALSE, container=T1frameCLine) #at beginning CLlist==list()
glabel("SELECTED XPS-SAMPLES AND COMMON CORE LINES", container=T1group1)
dummy <- list(XPSSample=c(" ", " "),CoreLines=c(" ", " ")) #dummy list to begin: NB each column has 2 initial element otherwise error...
dummy$XPSSample <- encodeString(dummy$XPSSample, width=40, justify="right")
dummy$CoreLines <- encodeString(dummy$CoreLines, width=40, justify="right")
NameTable <<- gtable(dummy, expand=TRUE, fill=TRUE, container=T1group1) #table with the selected FNames
names(NameTable) <<- c("XPSSample", "CoreLines")
# --- TAB2 ---
T2group1 <- ggroup(label="PLOT FUNCTIONS",horizontal=FALSE, container=nb)
T2frame1 <- gframe(" FUNCTIONS ", horizontal=FALSE, spacing=5, container=T2group1)
# layoutT2 <- glayout(homogeneous=FALSE, spacing=5, container=T2frame1)
XSGroup1 <- ggroup(horizontal=TRUE, spacing=5, container=T2frame1)
glabel("XPSSamp.", container=XSGroup1)
XSGroup11 <- ggroup(horizontal=TRUE, spacing=5, container=XSGroup1)
objXSamp <- gcombobox(c(" "), selected=-1, editable=FALSE, handler=function(h,...){
enabled(objScaleFact) <- TRUE
}, container=XSGroup11)
###Funct3: Reverse X axis
objFunctRev <- gcheckbox("Reverse X axis",checked=TRUE, handler=function(h,...){
PlotParameters$Reverse <<- svalue(objFunctRev)
CtrlPlot() ####PLOT FOLLOWING SELECTIONS
}, container=XSGroup1)
###Funct4: Switch Binding to Kinetic Energy scale
objFunctSwitch <- gcheckbox("Switch BE to KE scale",checked=FALSE, handler=function(h,...){
PlotParameters$SwitchE <<- svalue(objFunctSwitch)
CtrlPlot() ####PLOT FOLLOWING SELECTIONS
}, container=XSGroup1)
CLGroup2 <- ggroup(horizontal=TRUE, spacing=5, container=T2frame1)
glabel("Core-Line ", spacinig=3, container=CLGroup2)
CLGroup22 <- ggroup(horizontal=TRUE, spacing=5, container=CLGroup2)
objCLine <- gcombobox(c(" "), selected=-1, editable=FALSE, container=CLGroup22)
###Funct1: Normalize
objFunctNorm <- gcheckbox("Normalize",checked=FALSE, handler=function(h,...){
if ( svalue(objFunctNorm) == FALSE) { PlotParameters$Normalize <<- NULL }
FName <- get(FNamesCoreLines$XPSSample[1], envir=.GlobalEnv) #retrieve a generic XPSSample from the selected ones
Plot_Args$ylab$label <<- FName[[FNamesCoreLines$CoreLines[1]]]@units[2] #retrieve the Y axis label
SelectedCL <- svalue(T1CLineListCK)
if ( svalue(objFunctNorm)) { #Normalize option TRUE
NormWin <- gwindow("NORMALIZATION", parent=c(10, 10), visible=FALSE)
size(NormWin) <- c(350, 200)
Normgroup <- ggroup(horizontal=FALSE, container=NormWin)
glabel("Select the Core-Lines to Normalize", container=Normgroup)
NormCL <- gcheckboxgroup(SelectedCL, checked=FALSE, horizontal=TRUE, handler=function(h,...){
PlotParameters$Normalize <<- as.integer(svalue(NormCL, index=TRUE))
if (length(PlotParameters$Normalize) == 0) { PlotParameters$Normalize <<- NULL } #all Core-Line de-selected
}, container=Normgroup)
gbutton(" EXIT ", handler = function(h, ...){
dispose(NormWin)
CtrlPlot()
}, container=Normgroup)
visible(NormWin) <- TRUE
Plot_Args$ylab$label <<- "Intensity [a.u.]"
}
CtrlPlot() ####PLOT FOLLOWING SELECTIONS
}, container=CLGroup2)
###Funct2: Y-Align
objFunctAlign <- gcheckbox("Align bkg to 0",checked=FALSE, handler=function(h,...){
PlotParameters$Align <<- svalue(objFunctAlign)
CtrlPlot() ####PLOT FOLLOWING SELECTIONS
}, container=CLGroup2)
###Funct5: Amplify
CLGroup3 <- ggroup(horizontal=TRUE, spacing=5, container=T2frame1)
glabel("ScaleFact.", spacinig=3, container=CLGroup3)
objScaleFact <- gedit("", handler=function(h,...){
XS <- as.numeric(svalue(objXSamp, index=TRUE))
CL <- as.numeric(svalue(objCLine, index=TRUE))
if (XS == 0 || CL == 0){
gmessage("Please select the XPSSample and the Core-Line", title="WARNING", icon="warning")
return()
}
indx <- as.numeric(svalue(objCLine, index=TRUE))
PlotParameters$ScaleFact$XS <<- XS
PlotParameters$ScaleFact$CL <<- CL
PlotParameters$ScaleFact$ScFact <<- as.numeric(svalue(objScaleFact))
CtrlPlot() ####PLOT FOLLOWING SELECTIONS
}, container=CLGroup3)
tkconfigure(objScaleFact$widget, width=8)
###Funct6: X, Y offset
glabel("X-Offset", spacinig=3, container=CLGroup3)
XOffsetobj <- gedit("", initial.msg = "X_Off= ", width=7, handler=function(h,...){
PlotParameters$XOffset$CL <<- as.numeric(svalue(objCLine, index=TRUE))
PlotParameters$XOffset$Shift <<- as.numeric(svalue(XOffsetobj))
if (is.na(PlotParameters$XOffset)){
gmessage("Please enter a numeric value for the X-shift", title="WARNING", icon="warning")
PlotParameters$XOffset$Shift <<- 0
return()
}
CtrlPlot()
}, container=CLGroup3)
tkconfigure(XOffsetobj$widget, width=8)
enabled(XOffsetobj) <- FALSE
glabel("Y-Offset", spacinig=3, container=CLGroup3)
YOffsetobj <- gedit("", initial.msg = "Y_Off= ", width=7, handler=function(h,...){
PlotParameters$YOffset$CL <<- as.numeric(svalue(objCLine, index=TRUE))
PlotParameters$YOffset$Shift <<- as.numeric(svalue(YOffsetobj))
if (is.na(PlotParameters$YOffset)){
gmessage("Please enter a numeric value for the Y-shift", title="WARNING", icon="warning")
PlotParameters$YOffset$Shift <<- 0
return()
}
CtrlPlot()
}, container=CLGroup3)
tkconfigure(YOffsetobj$widget, width=8)
enabled(YOffsetobj) <- FALSE
###Funct8: Custom XY scale
T2frame2 <- gframe(text="EXACT X, Y RANGE", horizontal=FALSE, spacing=5, container=T2group1)
glabel(text="Select the Spectrum", spacing=3, container=T2frame2)
T2CLgroup <- ggroup(horizontal=TRUE, container=T2frame2)
CLPanel <- gcombobox(" ", selected = -1, editable = FALSE, container=T2CLgroup)
T2XYgroup <- ggroup(horizontal=TRUE, container=T2frame2)
xx1 <- gedit("", initial.msg = "Xmin= ", container=T2XYgroup)
xx2 <- gedit("", initial.msg = "Xmax= ", container=T2XYgroup)
yy1 <- gedit("", initial.msg = "Ymin= ", container=T2XYgroup)
yy2 <- gedit("", initial.msg = "Ymax= ", container=T2XYgroup)
tkconfigure(xx1$widget, width=15)
tkconfigure(xx2$widget, width=15)
tkconfigure(yy1$widget, width=15)
tkconfigure(yy2$widget, width=15)
T2_ButtGroup <- ggroup(horizontal=TRUE, container=T2frame2) #needed only to have a small OK button
gbutton(" OK ", width=25, handler=function(h,...){
panel <- svalue(CLPanel, index=TRUE)
xx1 <- as.numeric(svalue(xx1))
xx2 <- as.numeric(svalue(xx2))
yy1 <- as.numeric(svalue(yy1))
yy2 <- as.numeric(svalue(yy2))
if (is.na(xx1*xx2*yy1*yy2)) {
gmessage("ATTENTION: plase set all the xmin, xmax, ymin, ymax values!", title = "CHANGE X Y RANGE", icon = "error")
}
PlotParameters$CustomXY <<- c(panel, xx1, xx2, yy1, yy2)
CtrlPlot()
}, container = T2_ButtGroup)
gbutton(" RESET PLOT ", handler=function(h,...){
ResetPlot()
CtrlPlot()
}, container = T2_ButtGroup)
gbutton(" EXIT ", handler=function(h,...){
dispose(win)
}, container = T2_ButtGroup)
# --- TAB3 ---
# Rendering options
T3group1 <- ggroup(label="RENDERING", horizontal=FALSE, container=nb)
T3group2 <- ggroup(horizontal=TRUE, container=T3group1)
T3group3 <- ggroup(horizontal=FALSE, container=T3group2)
T3F_CL_Colors <- gframe("SET CORELINE PALETTE", spacing=5, container=T3group3)
T3_CL_Colors <- gdf(CLPalette, container=T3F_CL_Colors)
size(T3_CL_Colors) <- c(110, 250)
addHandlerChanged(T3_CL_Colors, handler=function(h,...){ #edit Palette preferences
CLPalette$Colors <<- Colors <<- h$obj[]
PlotParameters$Colors <<- Colors
Plot_Args$par.settings$superpose.symbol$fill <<- Colors
Plot_Args$par.settings$superpose.line$col <<- Colors
AutoKey_Args$col <<- Colors
Plot_Args$par.settings$superpose.symbol$col <<- Colors
CtrlPlot()
} )
layoutRend <- glayout(homogeneous=FALSE, spacing=3, container=T3group2)
layoutRend[1,1] <- T3F_BW_Col <- gframe("COLOR", spacing=5, container=layoutRend)
T3_BW_Col <- gcombobox(c("B/W", "RainBow"), selected=1, editable=FALSE, handler=function(h,...){
Plot_Args$type <<- "l"
if(svalue(T3_SetSymbols) == "ON") {Plot_Args$type <<- "b"}
if(svalue(T3_BW_Col)=="B/W") {
svalue(T3_SetLines) <- "ON"
svalue(T3_LineType) <<- "pattern"
svalue(T3_SymType) <<- "multi-symbols"
svalue(TxtColCK) <<- "B/W"
PlotParameters$Colors <<- "black"
Plot_Args$lty <<- rep("solid", 20)
Plot_Args$pch <<- STypeIndx
Plot_Args$cex <<- as.numeric(svalue(T3_SymSize))
Plot_Args$par.settings$superpose.symbol$col <<- "black"
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
Plot_Args$par.settings$superpose.line$col <<- "black"
Plot_Args$par.settings$superpose.line$lty <<- rep("solid", 20)
Plot_Args$par.settings$strip.background$col <<- "grey90"
if(svalue(T3_LineType) == "patterns"){
Plot_Args$lty <<- LType
Plot_Args$par.settings$superpose.line$lty <<- LType
}
AutoKey_Args$col <<- "black"
} else {
svalue(TxtColCK) <<- "RainBow"
Plot_Args$lty <<- rep("solid", 20)
Plot_Args$pch <<- rep(STypeIndx[1], 20)
Plot_Args$cex <<- as.numeric(svalue(T3_SymSize))
PlotParameters$Colors <<- Colors
Plot_Args$par.settings$superpose.line$col <<- Colors
Plot_Args$par.settings$superpose.line$lty <<- rep("solid", 20)
Plot_Args$par.settings$superpose.symbol$col <<- Colors
Plot_Args$par.settings$superpose.symbol$pch <<- rep(STypeIndx[1], 20)
Plot_Args$par.settings$strip.background$col <<- "lightskyblue1"
AutoKey_Args$col <<- Colors
if(svalue(T3_LineType) == "patterns"){
Plot_Args$lty <<- LType
Plot_Args$par.settings$superpose.line$lty <<- LType
}
if(svalue(T3_SymType) == "multi-symbols"){
Plot_Args$pch <<- STypeIndx
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
}
}
CtrlPlot() }, container=T3F_BW_Col)
layoutRend[1,2] <- T3F_Grid <- gframe("GRID", spacing=5, container=layoutRend)
T3_Grid <- gcombobox(c("Grid ON", "Grid OFF"), selected=-1, editable=FALSE, handler=function(h,...){
if(svalue(T3_Grid)=="Grid ON") {
Plot_Args$grid <<- TRUE
} else {
Plot_Args$grid <<- FALSE
}
CtrlPlot() }, container=T3F_Grid)
layoutRend[2,1] <- T3F_SetLines <- gframe("SET LINES", spacing=5, container=layoutRend)
T3_SetLines <- gradio(c("ON", "OFF"), selected=1, horizontal = TRUE, handler=function(h,...){
SetLinesPoints()
}, container=T3F_SetLines)
layoutRend[2,2] <- T3F_SetSymbols <- gframe("SET SYMBOLS", horizontal=TRUE, spacing=5, container=layoutRend)
T3_SetSymbols <- gradio(c("ON", "OFF"), selected=2, horizontal=TRUE, handler=function(h,...){
SetLinesPoints()
}, container=T3F_SetSymbols)
layoutRend[3,1] <- T3F_SetLines <- gframe("LINE TYPE", spacing=5, container=layoutRend)
T3_LineType <- gcombobox(c("solid", "patterns"), selected=2, editable=FALSE, handler=function(h,...){
Plot_Args$type <<- "l"
if(svalue(T3_SetSymbols) == "ON") {Plot_Args$type <<- "b"}
palette <- svalue(T3_BW_Col)
if (svalue(T3_LineType)=="solid") {
svalue(T3_BW_Col) <<- "RainBow"
Plot_Args$lty <<- rep("solid", 20)
Plot_Args$pch <<- rep(STypeIndx[1], 20)
Plot_Args$cex <<- as.numeric(svalue(T3_SymSize))
PlotParameters$Colors <<- Colors
Plot_Args$par.settings$superpose.line$col <<- Colors
Plot_Args$par.settings$superpose.line$lty <<- rep("solid", 20)
Plot_Args$par.settings$superpose.symbol$col <<- Colors
Plot_Args$par.settings$superpose.symbol$pch <<- rep(STypeIndx[1], 20)
Plot_Args$par.settings$strip.background$col <<- "lightskyblue"
AutoKey_Args$col <<- Colors
if (svalue(T3F_SetSymbols) == "multi-symbols"){
Plot_Args$pch <<- STypeIndx
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
}
}
if (svalue(T3_LineType)=="patterns") {
ColStyle <- svalue(T3_BW_Col)
PlotParameters$Colors <<- "black"
Plot_Args$lty <<- LType
Plot_Args$pch <<- rep(STypeIndx[1], 20)
Plot_Args$cex <<- as.numeric(svalue(T3_SymSize))
Plot_Args$par.settings$superpose.line$col <<- rep("black", 20)
Plot_Args$par.settings$superpose.line$lty <<- LType
Plot_Args$par.settings$superpose.symbol$col <<- rep("black", 20)
Plot_Args$par.settings$superpose.symbol$pch <<- rep(STypeIndx[1], 20)
Plot_Args$par.settings$strip.background$col <<- "gray90"
AutoKey_Args$col <<- rep("black", 20)
if (ColStyle == "RainBow"){
PlotParameters$Colors <<- Colors
Plot_Args$par.settings$superpose.symbol$col <<- Colors
Plot_Args$par.settings$superpose.line$col <<- Colors
Plot_Args$par.settings$strip.background$col <<- "lightskyblue"
AutoKey_Args$col <<- Colors
}
if (svalue(T3_SymType) == "multi-symbols"){
Plot_Args$pch <<- STypeIndx
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
}
}
CtrlPlot()
}, container=T3F_SetLines)
layoutRend[3,2] <- T3F_LinWidth <- gframe("LINE WIDTH", spacing=5, container=layoutRend)
T3_LinWidth <- gcombobox(LWidth, selected=1, editable=FALSE, handler= function(h,...){
Plot_Args$lwd <<- as.numeric(svalue(T3_LinWidth))
CtrlPlot()
}, container=T3F_LinWidth)
layoutRend[4,1] <- T3F_Symbols <- gframe("SYMBOLS", spacing=5, container=layoutRend)
T3_SymType <- gcombobox(c("single-symbol", "multi-symbols"), selected=2, editable=FALSE, handler=function(h,...){
Plot_Args$type <<- "p"
if(svalue(T3_SetLines) == "ON") {Plot_Args$type <<- "b"}
if (svalue(T3_SymType)=="single-symbol") {
svalue(T3_BW_Col) <<- "RainBow"
Plot_Args$lty <<- rep("solid", 20)
Plot_Args$pch <<- rep(STypeIndx[1], 20)
Plot_Args$cex <<- as.numeric(svalue(T3_SymSize))
PlotParameters$Colors <<- Colors
Plot_Args$par.settings$superpose.line$col <<- Colors
Plot_Args$par.settings$superpose.line$lty <<- rep("solid", 20)
Plot_Args$par.settings$superpose.symbol$col <<- Colors
Plot_Args$par.settings$superpose.symbol$pch <<- rep(STypeIndx[1], 20)
Plot_Args$par.settings$strip.background$col <<- "lightskyblue"
AutoKey_Args$col <<- Colors
if(svalue(T3_LineType) == "patterns"){
Plot_Args$lty <<- LType
Plot_Args$par.settings$superpose.line$lty <<- LType
}
}
if (svalue(T3_SymType)=="multi-symbols") {
PlotParameters$Colors <<- "black"
Plot_Args$lty <<- rep("solid", 20)
Plot_Args$pch <<- STypeIndx
Plot_Args$cex <<- as.numeric(svalue(T3_SymSize))
Plot_Args$par.settings$superpose.line$col <<- rep("black", 20)
Plot_Args$par.settings$superpose.line$lty <<- rep("solid", 20)
Plot_Args$par.settings$superpose.symbol$col <<- rep("black", 20)
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
Plot_Args$par.settings$strip.background$col <<- "gray90"
AutoKey_Args$col <<- rep("black", 20)
ColStyle <- svalue(T3_BW_Col)
if (ColStyle == "RainBow"){
PlotParameters$Colors <<- Colors
Plot_Args$par.settings$superpose.symbol$col <<- Colors
Plot_Args$par.settings$superpose.line$col <<- Colors
Plot_Args$par.settings$strip.background$col <<- "lightskyblue"
AutoKey_Args$col <<- Colors
}
if(svalue(T3_LineType) == "patterns"){
Plot_Args$lty <<- LType
Plot_Args$par.settings$superpose.line$lty <<- LType
}
}
CtrlPlot()
}, container=T3F_Symbols)
layoutRend[4,2] <- T3F_SymSize <- gframe("SYMSIZE", spacing=5, container=layoutRend)
T3_SymSize <- gcombobox(SymSize, selected=4, editable=FALSE, handler= function(h,...){
Plot_Args$cex <<- as.numeric(svalue(T3_SymSize))
CtrlPlot()
}, container=T3F_SymSize)
layoutRend[5,1] <- T3F_PanStripCol <- gframe("PANEL STRIP COLOR", spacing=5, container=layoutRend)
T3_PanStripCol <- gcombobox(c("white","grey", "darkgrey","lightblue","blue","darkblue","deepskyblue","lightbeige","beige","darkbeige","lightpink","pink","darkpink","lightgreen","green","darkgreen"), selected=-1, editable=FALSE, handler= function(h,...){
StripCol <- svalue(T3_PanStripCol)
if(StripCol=="grey") { StripCol <- "grey90"
} else if (StripCol=="darkgrey") { StripCol <- "gray60"
} else if (StripCol=="lightblue") { StripCol <- "lightskyblue1"
} else if(StripCol=="blue") { StripCol <- "lightskyblue3"
} else if(StripCol=="darkblue") { StripCol <- "steelblue3"
} else if (StripCol=="lightbeige") { StripCol <- "beige"
} else if(StripCol=="beige") { StripCol <- "bisque2"
} else if(StripCol=="darkbeige") { StripCol <- "navajowhite4"
} else if (StripCol=="pink") { StripCol <- "lightpink2"
} else if(StripCol=="darkpink") { StripCol <- "lightpink4"
} else if (StripCol=="lightgreen") { StripCol <- "darkseagreen1"
} else if(StripCol=="green") { StripCol <- "darkseagreen2"
} else if(StripCol=="darkgreen") { StripCol <- "mediumseagreen"
}
Plot_Args$par.settings$strip.background$col <<- StripCol
CtrlPlot() }, container=T3F_PanStripCol)
T3group2 <- ggroup(horizontal=TRUE, container=T3group1)
gbutton(" RESET PLOT ", handler=function(h,...){
ResetPlot()
CtrlPlot()
}, container=T3group2)
gbutton(" EXIT ", handler=function(h,...){
dispose(win)
}, container = T3group2)
# --- TAB4 ---
# Axis Rendering options
T4group1 <- ggroup(label="AXES", horizontal=FALSE, container=nb)
layoutAxis <- glayout(homogeneous=FALSE, spacing=3, container=T4group1)
layoutAxis[1,1] <- T4F_XScale <- gframe("X SCALE", spacing=5, container=layoutAxis)
T4_XScale <- gcombobox(c("Standard", "Power", "Log.10", "Log.e", "X*10^n", "Xe+0n"), selected=1, editable=FALSE, handler= function(h,...){
if (svalue(T4_XScale, index = TRUE) == 1) {
Plot_Args$scales$x$log <<- FALSE
Plot_Args$xscale.components <<- xscale.components.subticks
} else if (svalue(T4_XScale, index = TRUE) == 2) {
Plot_Args$scales$x$log <<- 10 # 10^ power scale
Plot_Args$xscale.components <<- xscale.components.logpower
} else if (svalue(T4_XScale, index = TRUE) == 3) {
Plot_Args$scales$x$log <<- 10 # log10 scale
Plot_Args$xscale.components <<- xscale.components.log10ticks
} else if (svalue(T4_XScale, index = TRUE) == 4) {
Plot_Args$scales$x$log <<- "e" # log e scale
Plot_Args$xscale.components <<- xscale.components.subticks
} else if (svalue(T4_XScale, index = TRUE) == 5) {
Plot_Args$scales$x$log <<- "Xpow10"
Plot_Args$scales$x$rot <<- 0
Plot_Args$scales$y$rot <<- 90
} else if (svalue(T4_XScale, index = TRUE) == 6) {
Plot_Args$scales$x$log <<- "Xe+0n"
Plot_Args$scales$x$rot <<- 0
Plot_Args$scales$y$rot <<- 90
}
CtrlPlot() }, container=T4F_XScale)
layoutAxis[1,2] <- T4F_YScale <- gframe("Y SCALE", spacing=5, container=layoutAxis)
T4_YScale <- gcombobox(c("Standard", "Power", "Log.10", "Log.e", "Y*10^n", "Ye+0n"), selected=1, editable=FALSE, handler= function(h,...){
if (svalue(T4_YScale, index = TRUE) == 1) {
Plot_Args$scales$y$log <<- FALSE
Plot_Args$yscale.components <<- yscale.components.subticks
} else if (svalue(T4_YScale, index = TRUE) == 2) {
Plot_Args$scales$y$log <<- 10
Plot_Args$yscale.components <<- yscale.components.logpower
} else if (svalue(T4_YScale, index = TRUE) == 3) {
Plot_Args$scales$y$log <<- 10
Plot_Args$yscale.components <<- yscale.components.log10ticks
} else if (svalue(T4_YScale, index = TRUE) == 4) {
Plot_Args$scales$y$log <<- "e"
Plot_Args$yscale.components <<- yscale.components.subticks
} else if (svalue(T4_YScale, index = TRUE) == 5) {
Plot_Args$scales$y$log <<- "Ypow10"
Plot_Args$scales$x$rot <<- 0
Plot_Args$scales$y$rot <<- 90
} else if (svalue(T4_YScale, index = TRUE) == 6) {
Plot_Args$scales$y$log <<- "Ye+0n"
Plot_Args$scales$x$rot <<- 0
Plot_Args$scales$y$rot <<- 90
}
CtrlPlot() }, container=T4F_YScale)
layoutAxis[1,3] <- T4F_XStep <- gframe("X STEP", spacing=5, container=layoutAxis)
T4_XStep <- gcheckbox("Custom X ticks", checked=FALSE, handler=function(h,...){
if(svalue(T4_XStep)==FALSE) {return()}
Core.Line <- svalue(T1CLineListCK)
NCL <- length(Core.Line)
RngXmin <- round(unlist(Xlim[[2]]), digits=0) #I need identify XRange components using the CoreLine names
RngXmax <- round(unlist(Xlim[[3]]), digits=0)
names(RngXmin) <- Xlim[[1]]
names(RngXmax) <- Xlim[[1]]
winTick <- gwindow(" X AXIS TICK INCREMENT ", parent=c(50,10), visible=FALSE)
DFgroup <- ggroup(horizontal=FALSE, container=winTick)
glabel("Please, give the increment between ticks", container=DFgroup)
Tick.Increment <- rep("?",NCL) #this is needed to construct correctly the data.frame
Tick.Increment <- data.frame(Core.Line,Tick.Increment, stringsAsFactors=FALSE) #in the dataframe add a column with variable names
DFrame <- gdf(items=Tick.Increment, container=DFgroup)
addHandlerChanged(DFrame, handler=function(h,...){ #addHandlerChanged dowload the dataFrame with modified parameters in NewFirParam (global variable)
Tick.Increment <<- h$obj[]
})
gbutton(text=" EXIT ", handler= function(h, ...){
dispose(winTick)
Tick.Increment <- as.numeric(unlist(Tick.Increment[2])) #first element of Tick.Increment is the CL-names
x_at <- list()
x_labels <- list()
for(ii in 1:NCL){
x_at[[ii]] <- seq(from=RngXmin[[Core.Line[ii]]], to=RngXmax[[Core.Line[ii]]], by=Tick.Increment[ii])
x_labels[[ii]] <- as.character(x_at[[ii]])
}
Plot_Args$scales$x <<- list(at = x_at, labels = x_labels, log=FALSE)
CtrlPlot()
}, container=DFgroup)
visible(winTick) <- TRUE
}, container=T4F_XStep)
layoutAxis[2,1] <- T4F_TitSize <- gframe("TITLE SIZE", spacing=5, container=layoutAxis)
T4_TitSize <- gcombobox(FontSize, selected=5, editable=FALSE, handler= function(h,...){
if (PlotParameters$OverlayMode=="Single-Panel" || PlotParameters$OverlayMode=="TreD") {
Plot_Args$main$cex <<- svalue(T4_TitSize)
} else if (PlotParameters$OverlayMode=="Multi-Panel") {
Plot_Args$par.strip.text$cex <<- as.numeric(svalue(T4_TitSize))
}
CtrlPlot() }, container=T4F_TitSize)
layoutAxis[2,2] <- T4F_PanelTitles <- gframe("CHANGE PANEL TITLES", spacing=5, container=layoutAxis)
T4_PanelTitles <- gbutton(text="Change Titles", spacing=5, handler=function(h,...){
TitleWin <- gwindow(title="MultiPanel Labels", visible=FALSE) #open a new window to contain a gdf() to change the titles of the panels
TitleGroup <- ggroup(horizontal=FALSE, container=TitleWin)
glabel(" EDIT TITLES ", container=TitleGroup) #long lable to obtain a reasonable window dimension
LL=length(PanelTitles)
PTitles <- data.frame(TITLES=PanelTitles, stringsAsFactors=FALSE)
TitleDFrame <- gdf(items=PTitles, container=TitleGroup) #here no handler it does not work in linux
size(TitleDFrame) <- c(100,200) #size needed to obtain a non-null size for the gdf()
addHandlerChanged(TitleDFrame, handler=function(h,...){ #addHandlerChanged to add a handler to gdf() working also in linux
PanelTitles <<- h$obj[]
})
gbutton(" SAVE TITLES AND EXIT ", handler=function(h,...){
Plot_Args$PanelTitles <<- PanelTitles
dispose(TitleWin)
CtrlPlot()
}, container = TitleGroup)
visible(TitleWin) <- TRUE
}, container=T4F_PanelTitles)
layoutAxis[2,3] <- T4F_YStep <- gframe("Y STEP", spacing=5, container=layoutAxis)
T4_YStep <- gcheckbox("Custom Y ticks ", checked=FALSE, handler=function(h,...){
if(svalue(T4_YStep)==FALSE) {return()}
Core.Line <- svalue(T1CLineListCK)
NCL <- length(Core.Line)
RngYmin <- round(unlist(Ylim[[2]]), digits=0) #I need identify XRange components using the CoreLine names
RngYmax <- round(unlist(Ylim[[3]]), digits=0)
names(RngYmin) <- Xlim[[1]]
names(RngYmax) <- Xlim[[1]]
winTick <- gwindow(" Y AXIS TICK INCREMENT ", parent=c(50,10), visible=FALSE)
DFgroup <- ggroup(horizontal=FALSE, container=winTick)
glabel("Please, give the increment between ticks", container=DFgroup)
Tick.Increment <- rep("?",NCL) #this is needed to construct correctly the data.frame
Tick.Increment <- data.frame(Core.Line,Tick.Increment, stringsAsFactors=FALSE) #in the dataframe add a column with variable names
DFrame <- gdf(items=Tick.Increment, container=DFgroup)
addHandlerChanged(DFrame, handler=function(h,...){ #addHandlerChanged dowload the dataFrame with modified parameters in NewFirParam (global variable)
Tick.Increment <<- h$obj[]
})
gbutton(text=" EXIT ", handler= function(h, ...){
dispose(winTick)
Tick.Increment <- as.numeric(unlist(Tick.Increment[2])) #first element of Tick.Increment is the CL-names
y_at <- list()
y_labels <- list()
for(ii in 1:NCL){ #reshape the Y limits using rounded values
Ndigit <- nchar(RngYmin[[Core.Line[ii]]])
Y1 <- as.integer(RngYmin[[Core.Line[ii]]]/(10^(Ndigit-1)))* 10^(Ndigit-1)
Ndigit <- nchar(RngYmax[[Core.Line[ii]]])
Y2 <- as.integer(RngYmax[[Core.Line[ii]]]/(10^(Ndigit-2)))* 10^(Ndigit-2)+10^(Ndigit-2)
y_at[[ii]] <- seq(from=Y1, to=Y2, by=Tick.Increment[ii])
y_labels[[ii]] <- as.character(y_at[[ii]])
}
Plot_Args$scales$y <<- list(at = y_at, labels = y_labels, log=FALSE)
CtrlPlot()
}, container=DFgroup)
visible(winTick) <- TRUE
}, container=T4F_YStep)
layoutAxis[3,1] <- T4F_AxNumSize <- gframe("AXIS NUMBER SIZE", spacing=5, container=layoutAxis)
T4_AxNumSize <- gcombobox(FontSize, selected=3, editable=FALSE, handler= function(h,...){
Plot_Args$scales$cex <<- svalue(T4_AxNumSize)
CtrlPlot() }, container=T4F_AxNumSize)
layoutAxis[3,2] <- T4F_AxLabSize <- gframe("AXIS LABEL SIZE", spacing=5, container=layoutAxis)
T4_AxLabSize <- gcombobox(FontSize, selected=3, editable=FALSE, handler= function(h,...){
Plot_Args$xlab$cex <<- svalue(T4_AxLabSize)
Plot_Args$ylab$cex <<- svalue(T4_AxLabSize)
CtrlPlot() }, container=T4F_AxLabSize)
layoutAxis[3,3] <- T4F_AxLabOrient <- gframe("AXIS NUMBER ORIENTATION", spacing=5, container=layoutAxis)
T4_AxLabOrient <- gcombobox(AxLabOrient, selected=1, editable=FALSE, handler= function(h,...){
LabOrient <- svalue(T4_AxLabOrient)
if (LabOrient == "Horizontal"){Plot_Args$scales$rot <<- 0}
if (LabOrient == "Rot-20"){Plot_Args$scales$rot <<- 20}
if (LabOrient == "Rot-45"){Plot_Args$scales$rot <<- 45}
if (LabOrient == "Rot-70"){Plot_Args$scales$rot <<- 70}
if (LabOrient == "Vertical"){Plot_Args$scales$rot <<- 90}
if (LabOrient == "Parallel"){
Plot_Args$scales$x$rot <<- 0
Plot_Args$scales$y$rot <<- 90
}
CtrlPlot() }, container=T4F_AxLabOrient)
layoutAxis[4,1] <- T4F_XAxNameChange <- gframe("CHANGE X-LABEL", spacing=5, container=layoutAxis)
T4_XAxNameChange <- gedit("", handler=function(h,...){
if(svalue(T4_XAxNameChange)==""){return()}
Plot_Args$xlab$label <<- svalue(T4_XAxNameChange)
CtrlPlot() } , container=T4F_XAxNameChange)
layoutAxis[4,2] <- T4F_YAxNameChange <- gframe("CHANGE Y-LABEL", spacing=5, container=layoutAxis)
T4_YAxNameChange <- gedit("",handler=function(h,...){
if(svalue(T4_YAxNameChange)==""){return()}
Plot_Args$ylab$label <<- svalue(T4_YAxNameChange) # in 2D Y is the vertical axis
CtrlPlot() }, container=T4F_YAxNameChange)
T4group2 <- ggroup(horizontal=TRUE, container=T4group1)
gbutton(" RESET PLOT ", handler=function(h,...){
ResetPlot()
CtrlPlot()
}, container=T4group2)
gbutton(" EXIT ", handler=function(h,...){
dispose(win)
}, container = T4group2)
# --- TAB5 ---
### LEGEND SETTINGS
T5group1 <- ggroup(label="LEGEND", horizontal=FALSE, container=nb)
layoutLeg <- glayout(homogeneous=FALSE, spacing=3, container=T5group1)
layoutLeg[1,1] <- T5F_legendCK <- gframe(text="Enable Legend", spacing=5, container=layoutLeg)
legendCK <- gcheckbox("Enable Legend ON/OFF", checked=TRUE,handler=function(h,...){
AutoKey_Args$text <<- unlist(FNamesCoreLines$XPSSample) #load the Legends in the slot of the AutoKey_Args = List of parameters defining legend properties
Plot_Args$auto.key <<- AutoKey_Args #Save the AutoKey_Args list of par in Plot_Args$auto.key
if (svalue(legendCK)==TRUE) {
if (svalue(T3_SetLines)=="ON") { #selezionate LINEE
Plot_Args$par.settings$superpose.line$col <<- "black" #B/W plot
Plot_Args$par.settings$superpose.line$lty <<- LType
Plot_Args$scales$relation <<- "free"
if (svalue(T3_BW_Col)=="RainBow") { #COLOR plot
Plot_Args$par.settings$superpose.line$col <<- Colors
Plot_Args$par.settings$superpose.line$lty <<- "solid"
}
}
if (svalue(T3_SetSymbols)=="ON") { #selezionate SIMBOLI
Plot_Args$par.settings$superpose.symbol$col <<- "black" #B/W plot
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
Plot_Args$par.settings$superpose.symbol$pch <<- 1
Plot_Args$scales$relation <<- "free"
if (svalue(T3_BW_Col)=="RainBow") { #COLOR plot
Plot_Args$par.settings$superpose.symbol$col <<- Colors
}
}
} else {
Plot_Args$auto.key <<- FALSE
}
CtrlPlot()
}, container=T5F_legendCK)
layoutLeg[1,2] <- T5F_LegFNameCK <- gframe(text="Add XPSSamp Name", spacing=5, container=layoutLeg)
LegFNameCK <- gcheckbox("XPSSamp.Name ON/OFF", checked=TRUE,handler=function(h,...){
if (is.logical(Plot_Args$auto.key)){
gmessage("PLEASE ENABLE LEGENDS", icon="warning")
svalue(LegFNameCK) <- FALSE
} else {
if (svalue(LegFNameCK)==TRUE) {
Legends <- FNamesCoreLines$CoreLines
for (ii in seq_along(FNamesCoreLines$XPSSample)){
tmp <- unlist(strsplit(Legends[ii], "\\.")) #skip the number at beginning coreline name
Legends[ii] <- paste(tmp[2], "_", FNamesCoreLines$XPSSample[ii], sep="")
}
Plot_Args$auto.key$text <<- as.vector(Legends)
} else {
Legends <- FNamesCoreLines$CoreLines
for(ii in seq_along(Legends)){
tmp <- unlist(strsplit(Legends[ii], "\\.")) #skip the number at beginning coreline name
Legends[ii] <- tmp[2]
}
Plot_Args$auto.key$text <<- as.vector(Legends)
}
}
CtrlPlot()
}, container=T5F_LegFNameCK)
layoutLeg[2,1] <- T5F_TSizeCK <- gframe(text="Text Size", spacing=5, container=layoutLeg)
TSizeCK <- gcombobox(LegTxtSize,selected=1, toolkit = guiToolkit(), handler=function(h,...){
Plot_Args$auto.key$cex <<- as.numeric(svalue(TSizeCK))
CtrlPlot()
}, container=T5F_TSizeCK)
layoutLeg[2,2] <- T5F_LegColCK <- gframe(text="Group Legend and organize in columns", spacing=5, container=layoutLeg)
LegColCK <- gedit(initial.msg ="Col. numb.", selected=1, editable=FALSE, handler=function(h,...){
columns <- svalue(LegColCK)
Plot_Args$auto.key$columns <<- as.numeric(svalue(LegColCK))
CtrlPlot()
}, container=T5F_LegColCK)
layoutLeg[3,1] <- T5F_LineWdhCK <- gframe(text="Line/Symbol weight", spacing=5, container=layoutLeg)
LineWdhCK <- gcombobox(LWidth,selected=1, toolkit = guiToolkit(), handler=function(h,...){
weight <- as.numeric(svalue(LineWdhCK))
if (svalue(T3_SetLines)=="ON") { #Lines selected
Plot_Args$par.settings$superpose.line$lwd <<- weight
}
if (svalue(T3_SetSymbols)=="ON") { #Symbol selected
Plot_Args$par.settings$superpose.symbol$cex <<- weight
}
CtrlPlot()
}, container=T5F_LineWdhCK)
layoutLeg[3,2] <- T5F_TxtColCK <- gframe(text="Legend text Color", spacing=5, container=layoutLeg)
TxtColCK <- gcombobox(c("B/W", "RainBow"),selected=1, toolkit = guiToolkit(), handler=function(h,...){
if (svalue(TxtColCK)=="B/W"){
Plot_Args$auto.key$col <<- "black"
} else {
Plot_Args$auto.key$col <<- Colors
}
CtrlPlot()
}, container=T5F_TxtColCK)
layoutLeg[4,1] <- T5F_ChangLeg <- gbutton(text="Change Legend", spacing=5, handler=function(h,...){
LegWin <- gwindow(title="XPS Sample Legends", visible=FALSE) #open a new window to contain the list of new labels
LegGroup <- ggroup(horizontal=FALSE, container=LegWin)
glabel(" EDIT LEGENDS ", container=LegGroup) #This label long to get a reasonable window dimension
LL=length(FNamesCoreLines$XPSSample)
Legends <- data.frame(LEGENDS=rep("-", LL), stringsAsFactors=FALSE)
LegDFrame <- gdf(items=Legends, container=LegGroup) #here no handler: it does not work in linux
size(LegDFrame) <- c(150,150) #size needed to generate a window with a non null-size window
addHandlerChanged(LegDFrame, handler=function(h,...){ #addHandlerChanged to add the handler to gdf() working also in linux.
Legends <<- h$obj[]
})
gbutton(" SAVE LEGENDS & EXIT ", handler=function(h,...){
Plot_Args$auto.key$text <<- as.vector(Legends)
dispose(LegWin)
unblockHandler(Annotate)
CtrlPlot()
}, container = LegGroup)
visible(LegWin) <- TRUE
CtrlPlot()
}, container=layoutLeg)
T5group2 <- ggroup(horizontal=TRUE, container=T5group1)
gbutton(" RESET PLOT ", handler=function(h,...){
ResetPlot()
CtrlPlot()
}, container=T5group2)
gbutton(" EXIT ", handler=function(h,...){
dispose(win)
}, container = T5group2)
#----- END NOTEBOOK -----
svalue(nb) <- 5
svalue(nb) <- 4
svalue(nb) <- 3
svalue(nb) <- 2
svalue(nb) <- 1
addHandlerChanged(nb, handler=function(h, ...){
if (svalue(nb) > 1 || plotted==FALSE) {
CtrlPlot()
plotted <<- TRUE
return()
}
})
tcl("update", "idletasks")
visible(win) <- TRUE
}
GSperanza/RxpsG_2.3-1 documentation built on Feb. 11, 2024, 5:09 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions XPSCompare
Documented in XPSCompare
#XPSCompare() function to create plots in multi-panel mode
#'
#' @title XPSCompare is used to compare Core-Line spectra
#' @description XPSCompare provides a userfriendly interface to select
#' the XPS-Core-Lines together with their best fit to be plotted in
#' individual panels. XPSCompare permits the selection of plotting options
#' for a personalized data representation.
#' This function is based on the (/code{Lattice}) Package.
#' @examples
#' \dontrun{
#' XPSCompare()
#' }
#' @export
#'
XPSCompare <- function(){
#---- calls the function to plot spectra folloowing option selection -----
CtrlPlot <- function(){
N.XS <- length(FNamesCoreLines$XPSSample)
N.CL <- length(FNamesCoreLines$CoreLines)
if (N.XS == 0) {
gmessage(msg="Please select XPS Samples!", title="NO XPS SAMPLES SELECTED", icon="warning")
return()
}
if (length(FNamesCoreLines$Ampli) == 0){
N <- N.XS * N.CL
FNamesCoreLines$Ampli <<- rep(1,N)
}
SelectedNames <- FNamesCoreLines
SelectedNames$CoreLines <- svalue(T1CLineListCK)
LL <- length(SelectedNames$CoreLines)
if (LL == 0) {
gmessage(msg="Please select The Core Lines to plot!", title="NO CORE-LINES SELECTED", icon="warning")
return()
}
if (length(PanelTitles) == 0) {
for (ii in 1:LL){
PanelTitles <- c(PanelTitles, SelectedNames$CoreLines[ii]) #List of Titles for the Multipanel
}
} else {
PanelTitles <- SelectedNames$CoreLines
}
Plot_Args$PanelTitles <<- PanelTitles
Limits <- XPScompEngine(PlotParameters, Plot_Args, SelectedNames, Xlim, Ylim)
}
#----- Update table containing the selected XPSSample names and corelines
RefreshTab <- function(FNamesCoreLines){
delete(T1group1, NameTable)
#If Compare.Coreline is selected likely the number of elements of FNamesCoreLines$XPSSample != FNamesCoreLines$CoreLines
LL.X <- length(FNamesCoreLines$XPSSample)
LL.CL <- length(FNamesCoreLines$CoreLines)
if (LL.X < LL.CL){
tmp <- rep(" ", (LL.CL-LL.X))
FNamesCoreLines$XPSSample <- c(FNamesCoreLines$XPSSample, tmp)
}
if (LL.CL < LL.X){
tmp <- rep(" ", (LL.X-LL.CL))
FNamesCoreLines$CoreLines <- c(FNamesCoreLines$CoreLines, tmp)
}
if (LL.X == 0) {
dummy <- list(XPSSample=c(" ", " "),CoreLines=c(" ", " ")) #dummy list to begin: NB each column has 2 initial element otherwise error...
dummy$XPSSample <- encodeString(dummy$XPSSample, width=40, justify="right")
dummy$CoreLines <- encodeString(dummy$CoreLines, width=40, justify="right")
NameTable <<- gtable(dummy, expand=TRUE, fill=TRUE, container=T1group1) #table with the selected FNames
} else {
TabNames <- list(XPSSample=c(FNamesCoreLines$XPSSample, " "), CoreLines=c(FNamesCoreLines$CoreLines, " "))
LL <- length(TabNames$XPSSample)
for(ii in 1:LL){
TabNames$XPSSample[ii] <- encodeString(TabNames$XPSSample[ii], width=40, justify="right")
TabNames$CoreLines[ii] <- encodeString(TabNames$CoreLines[ii], width=40, justify="right")
}
NameTable <<- gtable(TabNames, expand=TRUE, container=T1group1) #Table with the list of selected names
}
names(NameTable) <<- c("XPSSample", "CoreLines")
}
#--- Routine for drawing Custom Axis
CustomAx <- function(CustomDta){
AxWin <- gwindow(title="CUSTOM AXIS", visible=FALSE)
AxGroup1 <- ggroup(horizontal=FALSE, container=AxWin)
txt1="1) Set Axis min, Axis max values: es. min=0, max=10, Nticks=5"
txt2="2) Set desired Number of Ticks: es. 5"
glabel(txt1, container=AxGroup1)
glabel(txt2, container=AxGroup1)
AxFrame <- gframe("Set Axis Elements", horizontal=FALSE, container=AxGroup1)
AxLayout <- glayout(homogeneous=FALSE, spacing=3, container=AxFrame)
axMin <- as.character(round(CustomDta[[1]], 2))
axMax <- as.character(round(CustomDta[[2]], 2))
msg1 <- paste("Xmin (min value=", axMin, "):", sep="")
msg2 <- paste("Xmax (max value=", axMax, "):", sep="")
if (CustomDta[[3]] == "Y") {
msg1 <- paste("Ymin (min value=", axMin, "):", sep="")
msg2 <- paste("Ymax (max value=", axMax, "):", sep="")
}
AxLayout[1,1] <- EditXmin <- gedit(initial.msg =msg1, width=40, container=AxLayout)
AxLayout[1,2] <- EditXmax <- gedit(initial.msg =msg2, width=40, container=AxLayout)
AxLayout[3,1] <- EditNTicks <- gedit(initial.msg ="N.Ticks", container=AxLayout)
gbutton(" SAVE & EXIT ", handler=function(h,...){
axMin <- as.numeric(svalue(EditXmin)) #X or Y scale min value
axMax <- as.numeric(svalue(EditXmax)) #X or Y scale max value
axRange <- sort(c(axMin, axMax)) #X or R scale range
NTicks <- as.numeric(svalue(EditNTicks))
if (is.na(axMin*axMax)) {
gmessage("ATTENTION: plase set all the min, max values!", title = "CHANGE X Y RANGE", icon = "error")
}
if (is.null(NTicks)){
gmessage("Please N. Major Ticks required!", icon="warning")
} else {
dx <- (axMax-axMin)/NTicks
axStp <- seq(from=axMin, to=axMax, by=dx)
Ticklabels <- as.character(round(axStp,digits=1))
if (CustomDta[[3]] == "X") {
if (FName[[SpectIndx]]@Flags) { #Binding energy set reverse X axis
axRange <- sort(c(axMin, axMax), decreasing=TRUE)
} else {
axRange <- sort(c(axMin, axMax))
}
Plot_Args$scales$x <<- list(at=axStp, labels=Ticklabels)
Plot_Args$xlim <<- axRange
Xlim <<- axRange
} else if (CustomDta[[3]] == "Y") {
Plot_Args$scales$y <<- list(at=axStp, labels=Ticklabels)
Plot_Args$ylim <<- axRange
Ylim <<- axRange
}
dispose(AxWin)
CtrlPlot()
Plot_Args$scales$relation <<- "free"
}
}, container = AxFrame)
visible(AxWin) <- TRUE
}
SetLinesPoints <- function(){
if ( svalue(T3_SetLines) == "OFF" && svalue(T3_SetSymbols) == "OFF") {
Plot_Args$type <<- "l" #cancel line and symbols and legends
AutoKey_Args$lines <<- FALSE
AutoKey_Args$points <<- FALSE
AutoKey_Args$col <<- rep("white", 20)
PlotParameters$Colors <<- rep("white", 20)
Plot_Args$lty <<- LType
Plot_Args$par.settings$superpose.symbol$col <<- rep("white", 20)
Plot_Args$par.settings$superpose.symbol$pch <<- rep(STypeIndx[1], 20)
Plot_Args$par.settings$superpose.line$col <<- rep("white", 20)
}
if ( svalue(T3_SetLines) == "ON" && svalue(T3_SetSymbols) == "OFF") {
Plot_Args$type <<- "l" # lines only
AutoKey_Args$lines <<- TRUE
AutoKey_Args$points <<- FALSE
AutoKey_Args$col <<- Colors
PlotParameters$Colors <<- Colors
Plot_Args$lty <<- LType
Plot_Args$par.settings$superpose.line$col <<- Colors #Rainbow plot
Plot_Args$par.settings$superpose.line$lty <<- rep("solid", 20)
if (svalue(T3F_SetLines) == "pattern") {
Plot_Args$par.settings$superpose.line$lty <<- LType
}
if (svalue(T3_BW_Col)=="B/W") {
AutoKey_Args$col <<- rep("black", 20)
PlotParameters$Colors <<- "black"
Plot_Args$par.settings$superpose.line$col <<- rep("black", 20) #B/W plot
Plot_Args$par.settings$superpose.line$lty <<- LType
}
}
if ( svalue(T3_SetLines) == "OFF" && svalue(T3_SetSymbols) == "ON") {
Plot_Args$type <<- "p" # symbols only
AutoKey_Args$lines <<- FALSE
AutoKey_Args$points <<- TRUE
AutoKey_Args$col <<- Colors
PlotParameters$Colors <<- Colors
Plot_Args$pch <<- rep(STypeIndx[1], 20)
Plot_Args$par.settings$superpose.symbol$pch <<- rep(STypeIndx[1], 20)
Plot_Args$par.settings$superpose.symbol$col <<- Colors
if (svalue(T3F_SetSymbols) == "multi-symbols") {
Plot_Args$pch <<- STypeIndx
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
}
if (svalue(T3_BW_Col) == "B/W") {
PlotParameters$Colors <<- "black"
Plot_Args$pch <<- STypeIndx
Plot_Args$par.settings$superpose.symbol$col <<- rep("black", 20)
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
AutoKey_Args$col <<- rep("black", 20)
}
}
if ( svalue(T3_SetLines) == "ON" && svalue(T3_SetSymbols) == "ON") {
Plot_Args$type <<- "b" #both: line and symbols
AutoKey_Args$lines <<- TRUE
AutoKey_Args$points <<- TRUE
Plot_Args$lty <<- LType
Plot_Args$pch <<- STypeIndx
if (svalue(T3_BW_Col)=="B/W") {
AutoKey_Args$col <<- rep("black", 20)
PlotParameters$Colors <<- "black"
Plot_Args$par.settings$superpose.line$lty <<- LType
Plot_Args$par.settings$superpose.line$col <<- rep("black", 20) #B/W plot
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
Plot_Args$par.settings$superpose.symbol$col <<- rep("black", 20)
} else {
AutoKey_Args$col <<- Colors
PlotParameters$Colors <<- Colors
Plot_Args$par.settings$superpose.line$col <<- Colors #Rainbow plot
Plot_Args$par.settings$superpose.line$lty <<- rep("solid", 20)
if (svalue(T3F_SetLines) == "pattern") {
Plot_Args$par.settings$superpose.line$lty <<- LType
}
Plot_Args$par.settings$superpose.symbol$col <<- Colors
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx[1]
if (svalue(T3F_SetSymbols) == "multi-symbols") {
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
}
}
}
CtrlPlot()
}
CheckCL <- function(){
CommonCL <- sapply(CLlist[[1]], function(x) unlist(strsplit(x, "\\."))[2] )
N.CL <- length(CommonCL) #N. Corelines in the reference XPS-Sample (first selected sample)
N.XS <- length(FNamesCoreLines$XPSSample) #Number of N. XPSSpectra selected
XpSamp <- get(FNamesCoreLines$XPSSample[1], envir=.GlobalEnv)
RngX <- RngY <- list(CLName=NULL, min=NULL, max=NULL)
for(jj in 1:N.CL){ #Range of CoreLines of XPSSample1
RngX[[1]][jj] <- CommonCL[jj]
RngX[[2]][jj] <- range(XpSamp[[CommonCL[jj]]]@.Data[1])[1] #First col RngX contains range min value
RngX[[3]][jj] <- range(XpSamp[[CommonCL[jj]]]@.Data[1])[2] #Second col RngX contains range max value
RngY[[1]][jj] <- CommonCL[jj]
RngY[[2]][jj] <- range(XpSamp[[CommonCL[jj]]]@.Data[2])[1]
RngY[[3]][jj] <- range(XpSamp[[CommonCL[jj]]]@.Data[2])[2]
}
#Here we load selected XPSSample to see which CoreLines contains.
#The X and Y range OK for all the common corelines of all XPSSamples
if (N.XS > 1) {
for (ii in 2:N.XS){
XpSamp <- get(FNamesCoreLines$XPSSample[ii], envir=.GlobalEnv)
CoreLines <- names(XpSamp) #set the CL of the first XPSSample as a reference
for (jj in 1:N.CL){
xx <- grep(CommonCL[jj], CoreLines) #is CL string present in CLlist?
if (length(xx)==0) { #pattern CommonCL[jj] not present in CoreLines vector
CommonCL <- CommonCL[-jj] #drop the elements non common element
}
#work out the X-range Y-range common to the selected Core Lines
RngXmin <- range(XpSamp[[CommonCL[jj]]]@.Data[1])[1]
RngXmax <- range(XpSamp[[CommonCL[jj]]]@.Data[1])[2]
if (RngXmin < RngX[[2]][jj]) {RngX[[2]][jj] <- RngXmin}
if (RngXmax > RngX[[3]][jj]) {RngX[[3]][jj] <- RngXmax}
RngYmin <- range(XpSamp[[CommonCL[jj]]]@.Data[2])[1]
RngYmax <- range(XpSamp[[CommonCL[jj]]]@.Data[2])[2]
if (RngYmin < RngY[[2]][jj]) {RngY[[2]][jj] <- RngYmin}
if (RngYmax > RngY[[3]][jj]) {RngY[[3]][jj] <- RngYmax}
}
}
}
FNamesCoreLines$CoreLines <<- CommonCL
Xlim <<- RngX
Ylim <<- RngY
}
CtrlRepCL <- function(ii){ #CTRL for repeated CL: search for core-lines with same name
LL <- length(CLlist[[ii]])
jj <- 1
while(jj < LL){
SpectName <- CLlist[[ii]][jj]
SpectName <- unlist(strsplit(SpectName, "\\."))
SpectName <- SpectName[2]
Indx <- grep(SpectName, CLlist[[ii]]) #The selected CoreLine name could be in any posiiton in the Destination XPSSample => source Samp Index could be different from Dest Samp index
if (length(Indx) > 1){ #The same coreline can be present more than one time
winCL <- gwindow("SELECT CORELINE", visible=FALSE)
size(winCL) <- c(100, 200)
groupCL <- ggroup(horizontal=FALSE, container=winCL)
N.CL <- length(Indx)
msg <- paste(" Found ", N.CL," ",SpectName, "spectra.\n Please select the coreline to compare")
txt <- glabel(text=msg, container=groupCL)
font(txt) <- list(family="sans",size=12)
gseparator(horizontal=TRUE, container=groupCL)
selectCL <- gradio(CLlist[[ii]][Indx], selected=1, horizontal=TRUE, container=groupCL)
gbutton(" OK ", handler=function(h, ...){
zz <- as.numeric(svalue(selectCL, index=TRUE))
Indx <<- Indx[-zz] #in Indx remain the component to eliminiate
CLlist[[ii]] <<- CLlist[[ii]][-Indx] #eliminate the repeated spectra
LL <<- length(CLlist[[ii]]) #update CLlist length
dispose(winCL)
}, container=groupCL)
visible(winCL) <- TRUE
winCL$set_modal(TRUE) #nothing can be done while running this macro
} #modal mode takes the control of the 'return' value which CANNOT be used to return variable values
jj <- jj+1
}
}
#----- reset parameters to the initial values -----
ResetPlot <- function(){
svalue(T1FNameListCK) <<- NULL
CLlist <<- list()
delete(T1frameCLine, T1CLineListCK)
T1CLineListCK <<- gcheckboxgroup(CLlist,checked=FALSE, container=T1frameCLine) #at beginning CLlist==list()
NamesList <<- list(XPSSample=NULL, CoreLines=NULL)
FNamesCoreLines <<- list(XPSSample=c(" ", " "),CoreLines=c(" "," "), Ampli=NULL) #dummy lists to begin: NB each lcolumn contains 2 element otherwise error
RefreshTab(FNamesCoreLines) #update the table with the name of the selected FNames
FNamesCoreLines <<- list(XPSSample=NULL,CoreLines=NULL,Ampli=NULL ) #dummy lists to begin: NB each lcolumn contains 2 element otherwise error
delete(XSGroup11, objXSamp)
objXSamp <<- gcombobox(c(" "), selected=-1, editable=FALSE, handler=function(h,...){enabled(objScaleFact) <- TRUE}, container=XSGroup11)
delete(CLGroup22, objCLine)
objCLine <<- gcombobox(c(" "), selected=-1, editable=FALSE, handler=function(h,...){enabled(objScaleFact) <- TRUE}, container=CLGroup22)
SaveSelection <<- TRUE
svalue(T1FNameListCK) <<- FALSE
svalue(objFunctNorm) <<- FALSE
svalue(objFunctAlign) <<- FALSE
svalue(objFunctRev) <<- TRUE
svalue(objFunctSwitch) <<- FALSE
svalue(objCLine) <<- -1
svalue(objScaleFact) <<- ""
enabled(objScaleFact) <<- FALSE
svalue(XOffsetobj) <<- 0
svalue(YOffsetobj) <<- 0
svalue(xx1) <<- ""
svalue(xx2) <<- ""
svalue(yy1) <<- ""
svalue(yy2) <<- ""
svalue(T3_BW_Col) <<- "B/W"
svalue(T3_Grid) <<- "Grid OFF"
svalue(T3_SetLines) <<- "ON"
svalue(T3_SetSymbols) <<- "OFF"
svalue(T3_LineType) <<- "patterns"
svalue(T3_LinWidth) <<- 1
svalue(T3_SymType) <<- "single-symbol"
svalue(T3_SymSize) <<- 0.8
svalue(T3_PanStripCol) <<- ""
svalue(T4_XScale) <<- "Regular"
svalue(T4_YScale) <<- "Regular"
svalue(T4_TitSize) <<- 1.4
svalue(T4_AxNumSize) <<- 1
svalue(T4_AxLabSize) <<- 1
svalue(T4_XAxNameChange) <<- ""
svalue(T4_YAxNameChange) <<- ""
svalue(T4_XStep) <<- ""
svalue(T4_YStep) <<- ""
svalue(legendCK) <<- TRUE
svalue(LegColCK) <<- 1
svalue(TSizeCK) <<- 1
svalue(LineWdhCK) <<- 1
svalue(TxtColCK) <<- "B/W"
XPSSettings <<- get("XPSSettings", envir=.GlobalEnv)
Colors <<- XPSSettings$Colors
LType <<- XPSSettings$LType
SType <<- XPSSettings$Symbols
STypeIndx <<- XPSSettings$SymIndx
FitColors <<- c(XPSSettings$BaseColor[1], XPSSettings$ComponentsColor[1], XPSSettings$FitColor[1])
CLPalette <<- data.frame(Colors=Colors, stringsAsFactors=FALSE)
FitPalette <<- data.frame(FitColors=FitColors, stringsAsFactors=FALSE)
PlotParameters <<- DefaultPlotParameters
Plot_Args <<- list( x=formula("y ~ x"), data=NULL, PanelTitles=list(), groups=NULL,layout=NULL,
xlim=NULL,ylim=NULL,
pch=STypeIndx,cex=1,lty=LType,lwd=1,type="l",
background="transparent", col="black",
main=list(label=NULL,cex=1.5),
xlab=list(label=NULL, rot=0, cex=1.2),
ylab=list(label=NULL, rot=90, cex=1.2),
zlab=NULL,
PanelTitles=NULL,
scales=list(cex=1, tck=c(1,0), alternating=c(1), tick.number=NULL, relation="free",
x=list(log=FALSE), y=list(log=FALSE), axs="i"),
xscale.components = xscale.components.subticks,
yscale.components = yscale.components.subticks,
las=0,
par.settings = list(superpose.symbol=list(pch=STypeIndx, fill="black"), #set the symbol fill color
superpose.line=list(lty=LType, col="black"), #needed to set the legend colors
par.strip.text=list(cex=1),
strip.background=list(col="grey90") ),
auto.key = TRUE,
grid = FALSE
)
AutoKey_Args <<- list(space="top",
text=" ",
cex = 1,
type= "l",
lines=TRUE,
points=FALSE,
col="black",
columns=1, #leggends organized in a column
list(corner=NULL,x=NULL,y=NULL)
)
Xlim <<- NULL #reset Xlim
Ylim <<- NULL #reset Ylim
plot.new()
}
#----- Variables -----
if (exists("activeFName", envir=.GlobalEnv)==FALSE){
gmessage("No data present: please load and XPS Sample", title="XPS SAMPLES MISSING", icon="error")
return()
}
FName <- get(activeFName, envir=.GlobalEnv) #load the active FName
ActiveFName <- get("activeFName", envir=.GlobalEnv) #load the name of the active FNamw (string)
SpectIndx <- get("activeSpectIndx", envir=.GlobalEnv)#index of the active coreline
SpectList <- XPSSpectList(ActiveFName) #list of the active XPSSample core lines
NComp=length(FName[[SpectIndx]]@Components)
NCorelines <- NULL
FitComp1 <- ""
for (ii in 1:NComp){
FitComp1[ii] <- paste("C",ii, sep="")
}
FNameListTot <- as.array(XPSFNameList()) #List of all XPSSamples loaded in the workspace
LL <- length(FNameListTot)
jj <- 1
FNamesCoreLines <- list(XPSSample=NULL, CoreLines=NULL, Ampli=NULL)
NamesList <- list(XPSSample=NULL, CoreLines=NULL)
CLlist <- list()
SpectName <- ""
plotted <- FALSE
#--- list of graphical variables
PatternList <- NULL
FontSize <- c(0.6,0.8,1,1.2,1.4,1.6,1.8,2,2.2,2.4,2.6,2.8,3)
AxLabOrient <- c("Horizontal", "Rot-20", "Rot-45", "Rot-70", "Vertical")
XPSSettings <- get("XPSSettings", envir=.GlobalEnv)
Colors <- XPSSettings$Colors
LType <- XPSSettings$LType
SType <- XPSSettings$Symbols
STypeIndx <- XPSSettings$SymIndx
CLPalette <- as.matrix(Colors)
CLPalette <- data.frame(Colors=CLPalette, stringsAsFactors=FALSE)
FitColors <- as.matrix(c(XPSSettings$BaseColor[1], XPSSettings$ComponentsColor[1], XPSSettings$FitColor[1]))
VarNames <- c("BasLnCol", "CompCol", "FitCol")
FitPalette <- data.frame(Object=VarNames, Colors=FitColors, stringsAsFactors=FALSE)
#-------------------------------------------------------------------------------------------------
# LType <- c("solid", "dashed", "dotted", "dotdash", "longdash", #definisco 20 tipi divesi di line pattern
# "twodash", "F8", "431313", "22848222", "12126262",
# "12121262", "12626262", "52721272", "B454B222", "F313F313",
# "71717313", "93213321", "66116611", "23111111", "222222A2" )
#
# SType <- c("VoidCircle", "VoidSquare", "VoidTriangleUp", "VoidTriangleDwn", "Diamond",
# "X", "Star", "CrossSquare", "CrossCircle", "CrossDiamond",
# "SolidSquare", "SolidCircle", "SolidTriangleUp", "SolidTriangleDwn", "SolidDiamond",
# "DavidStar", "SquareCross", "SquareTriang", "CircleCross", "Cross")
# STypeIndx <- c(1, 0, 2, 6, 5,
# 4, 8, 7, 10, 9,
# 15, 16, 17, 25, 18,
# 11, 12, 14, 13, 3)
#
# Colors <- c("black", "red", "limegreen", "blue", "magenta", "orange", "cadetblue", "sienna",
# "darkgrey", "forestgreen", "gold", "darkviolet", "greenyellow", "cyan", "lightblue",
# "turquoise", "deeppink3", "wheat", "thistle", "grey40")
#-------------------------------------------------------------------------------------------------
LWidth <- c(1,1.25,1.5,1.75,2,2.25,2.5,3, 3.5,4)
SymSize <- c(0.2,0.4,0.6,0.8,1,1.2,1.4,1.6,1.8,2) #lattice prende indici simboli piuttosto che nomesimbolo
PanelTitles <- NULL
LegPos <- c("OutsideTop","OutsideRight","OutsideLeft", "OutsideBottom",
"InsideTopRight","InsideTopLeft","InsideBottomRight","InsideBottomLeft")
LegOrient <- c("Vertical", "Horizontal")
LegLineWdh <- c(1,1.5,2,2.5,3,3.5,4,4.5,5)
LegTxtCol <- c("RainBow", "Black")
LegTxtSize <- c(0.4,0.6,0.8,1,1.2,1.4,1.6,1.8,2,2.2,2.4,2.6,2.8,3)
LegDist <- c(0,0.01,0.02,0.04,0.08,0.1,0.12,0.14,0.16,0.18,0.2)
ColorList <- NULL
Xlim <- NULL
Ylim <- NULL
#--- general options
PlotParameters <- list()
PlotParameters$Align <- FALSE
PlotParameters$RTFLtd <- FALSE #restrict plot to RTF region
PlotParameters$Normalize <- NULL
PlotParameters$Reverse <- TRUE #reversed X axes for Bind. Energy
PlotParameters$SwitchE <- FALSE
PlotParameters$XOffset <- list(CL=NA, Shift=0)
PlotParameters$YOffset <- list(CL=NA, Shift=0)
PlotParameters$ScaleFact <- list(XS=NA, CL=NA, ScFact=0)
PlotParameters$CustomXY <- NULL
PlotParameters$OverlayType <- "Compare.CoreLines" #Compare.Corelines and Multi-Panel are fixed options
PlotParameters$OverlayMode <- "Multi-Panel"
PlotParameters$Colors <- "B/W"
#--- legend options
PlotParameters$Labels <- NULL
PlotParameters$Legenda <- FALSE
PlotParameters$LegPos <- "left" #Out side left legend position
PlotParameters$LegLineWdh <- 1
PlotParameters$LegTxtCol <- "RainBow"
PlotParameters$LegTxtSize <- 1
PlotParameters$LegDist <- 0
DefaultPlotParameters <- PlotParameters
#--- comands for Lattice options
Plot_Args <- list( x=formula("y ~ x"), data=NULL, PanelTitles=list(), groups=NULL,layout=NULL,
xlim=NULL, ylim=NULL,
pch=STypeIndx,cex=1,lty=LType,lwd=1,type="l",
background="transparent", col="black",
main=list(label=NULL,cex=1.5),
xlab=list(label=NULL, rot=0, cex=1.2),
ylab=list(label=NULL, rot=90, cex=1.2),
zlab=NULL,
PanelTitles=NULL,
scales=list(cex=1, tck=c(1,0), alternating=c(1), tick.number=NULL, relation="free",
x=list(log=FALSE), y=list(log=FALSE), axs="i"),
xscale.components = xscale.components.subticks,
yscale.components = yscale.components.subticks,
las=0,
par.settings = list(superpose.symbol=list(pch=STypeIndx,fill="black"), #set symbol filling color
superpose.line=list(lty=LType, col="black"), #needed to set legend colors
par.strip.text=list(cex=1),
strip.background=list(col="grey90") ),
auto.key = TRUE,
grid = FALSE
)
AutoKey_Args <- list( space="top",
text=" ",
cex = 1,
type= "l",
lines=TRUE,
points=FALSE,
col="black",
columns=1, #legends organized in a column
list(corner=NULL,x=NULL,y=NULL)
)
SaveSelection <- TRUE #at beginning force the control of the selection to TRUE to avoid error messages
#--- Reset graphical window
plot.new()
assign("MatPlotMode", FALSE, envir=.GlobalEnv) #basic matplot function used to plot data
#===== NoteBook =====
win <- gwindow(" COMPARE SPECTRA ", parent=c(50,10), visible=FALSE)
size(win) <- c(400,400)
maingroup <- ggroup(horizontal=FALSE, container=win)
nb <- gnotebook(expand=TRUE, container = maingroup)
# --- TAB1 ---
#XPS Sample/Coreline selection
T1group1 <- ggroup(label="XPS SAMPLE SELECTION", spacing=5, horizontal=FALSE, container=nb)
layoutT1 <- glayout(homogeneous=FALSE, spacing=5, container=T1group1)
layoutT1[1,1] <- T1frameButtT1 <- gframe(text="PLOT", spacing=5, container=layoutT1)
T1groupButtons <- ggroup(horizontal=FALSE, container = T1frameButtT1)
gbutton("PLOT", handler=function(h,...){
CtrlPlot() #plot selected XPS-SAmples
plotted <<- TRUE
}, container=T1groupButtons)
gbutton("RESET PLOT", handler=function(h,...){
ResetPlot()
}, container=T1groupButtons)
gbutton("UPDATE XPS-SAMPLE LIST", handler=function(h,...){
svalue(T1FNameListCK) <<- NULL
FName <<- get(activeFName, envir=.GlobalEnv)
ActiveFName <<- get("activeFName", envir=.GlobalEnv)
SpectIndx <<- get("activeSpectIndx", envir=.GlobalEnv)
SpectList <<- XPSSpectList(ActiveFName) #sCoreLine list of the XPSSample
NComp <<- length(FName[[SpectIndx]]@Components)
NCorelines <<- NULL
FitComp1 <<- "" #build vector containing names of the fit components on the Active Spectrum
for (ii in 1:NComp){
FitComp1[ii] <- paste("C",ii, sep="")
}
FNameListTot <- as.array(XPSFNameList()) #list of all XPSSample in Envir=.GlobalEnv
LL=length(FNameListTot)
jj <- 1
FNamesCoreLines <<- list(XPSSample=NULL, CoreLines=NULL, Ampli=NULL)
NamesList <<- list(XPSSample=NULL, CoreLines=NULL)
SaveSelection <<- TRUE
delete(T1frameFName, T1FNameListCK) #update panel
T1FNameListCK <<- gcheckboxgroup(FNameListTot,checked=FALSE, handler=function(h,...){
FNamesCoreLines$XPSSample <<- svalue(T1FNameListCK)
FNamesCoreLines$CoreLines <<- list()
LL <- length(FNamesCoreLines$XPSSample)
if (LL > 3) LL <- 3
Plot_Args$auto.key$columns <<- LL
AutoKey_Args$columns <<- LL
Plot_Args$auto.key$text <<- unlist(FNamesCoreLines$XPSSample)
for (ii in 1:LL){
CLlist[[ii]] <<- XPSSpectList(FNamesCoreLines$XPSSample[ii])
}
#checks for corelines common to selected XPSSamples
CheckCL() # CheckCL() defines FNamesCoreLines$CoreLines
delete(T1frameCLine,T1CLineListCK)
T1CLineListCK <<- gcheckboxgroup(FNamesCoreLines$CoreLines, container=T1frameCLine) #refresh gcheckboxgroup for coreline selection
RefreshTab(FNamesCoreLines) #update the table with the name of the selected FNames
delete(XSGroup11, objXSamp)
objXSamp <<- gcombobox(c(" "), selected=-1, editable=FALSE, container=XSGroup11)
delete(T2CLgroup, CLPanel) #clear CLPanel
CLPanel <<- gcombobox(FNamesCoreLines$CoreLines, selected = -1, editable = FALSE, container=T2CLgroup) #refresh combobox for custom XY scale
}, container=T1frameFName)
ResetPlot()
plot.new()
}, container=T1groupButtons)
gbutton(" EXIT ", handler=function(h,...){
dispose(win)
}, container=T1groupButtons)
layoutT1[1,2] <- T1frameFName <- gframe(text="SELECT XPS-SAMPLE", spacing=5, container=layoutT1)
T1FNameListCK <- gcheckboxgroup(FNameListTot,checked=FALSE, handler=function(h,...){
FNamesCoreLines$XPSSample <<- svalue(T1FNameListCK)
if (length(FNamesCoreLines$XPSSample) == 0 ){
FNamesCoreLines$XPSSample <<- list() #checkbox deselection
FNamesCoreLines$CoreLines <<- list()
Plot_Args$PanelTitles <<- list()
CLlist <<- list()
} else {
FNamesCoreLines$CoreLines <<- list()
LL <- length(FNamesCoreLines$XPSSample)
if (LL > 3) {
Plot_Args$auto.key$columns <<- 3
AutoKey_Args$columns <<- 3
}
Plot_Args$auto.key$text <<- unlist(FNamesCoreLines$XPSSample)
# Define only the CLlist for the new selected XPSSample
CLlist[[LL]] <<- XPSSpectList(FNamesCoreLines$XPSSample[LL])
CtrlRepCL(LL) #controls if same spectra are repeated in CLlist[[LL]]
CheckCL() #check for corelines common to selected XPSSamples
}
delete(XSGroup11, objXSamp)
objXSamp <<- gcombobox(FNamesCoreLines$XPSSample, selected=-1, editable=FALSE, container=XSGroup11)
delete(T1frameCLine,T1CLineListCK)
T1CLineListCK <<- gcheckboxgroup(FNamesCoreLines$CoreLines, handler=function(h, ...) {
SelectedCL <- svalue(T1CLineListCK) #update objCLineobject
delete(CLGroup22,objCLine)
objCLine <<- gcombobox(SelectedCL, selected=-1, editable=FALSE, handler=function(h,...){
PlotParameters$XOffset <- list(CL=NA, Offset=0)
PlotParameters$YOffset <- list(CL=NA, Offset=0)
PlotParameters$ScaleFact <- list(XS=NA, CL=NA, ScFact=0)
enabled(objScaleFact) <- !is_empty(svalue(objXSamp)) #TRUE only if an XPSSample was selected
enabled(XOffsetobj) <- TRUE
enabled(YOffsetobj) <- TRUE
}, container=CLGroup22)
}, container=T1frameCLine) #refresh gcheckboxgroup for coreline selection
add(T1frameCLine, T1CLineListCK)
RefreshTab(FNamesCoreLines) #update the table with the name of the selected FNames
delete(T2CLgroup, CLPanel)
CLPanel <<- gcombobox(FNamesCoreLines$CoreLines, selected = -1, editable = FALSE, container=T2CLgroup) #refresh combobox for custom XY scale
}, container=T1frameFName)
layoutT1[1,3] <- T1frameCLine <- gframe(text="SELECT SPECTRA", spacing=5, container=layoutT1)
T1CLineListCK <- gcheckboxgroup(CLlist,checked=FALSE, container=T1frameCLine) #at beginning CLlist==list()
glabel("SELECTED XPS-SAMPLES AND COMMON CORE LINES", container=T1group1)
dummy <- list(XPSSample=c(" ", " "),CoreLines=c(" ", " ")) #dummy list to begin: NB each column has 2 initial element otherwise error...
dummy$XPSSample <- encodeString(dummy$XPSSample, width=40, justify="right")
dummy$CoreLines <- encodeString(dummy$CoreLines, width=40, justify="right")
NameTable <<- gtable(dummy, expand=TRUE, fill=TRUE, container=T1group1) #table with the selected FNames
names(NameTable) <<- c("XPSSample", "CoreLines")
# --- TAB2 ---
T2group1 <- ggroup(label="PLOT FUNCTIONS",horizontal=FALSE, container=nb)
T2frame1 <- gframe(" FUNCTIONS ", horizontal=FALSE, spacing=5, container=T2group1)
# layoutT2 <- glayout(homogeneous=FALSE, spacing=5, container=T2frame1)
XSGroup1 <- ggroup(horizontal=TRUE, spacing=5, container=T2frame1)
glabel("XPSSamp.", container=XSGroup1)
XSGroup11 <- ggroup(horizontal=TRUE, spacing=5, container=XSGroup1)
objXSamp <- gcombobox(c(" "), selected=-1, editable=FALSE, handler=function(h,...){
enabled(objScaleFact) <- TRUE
}, container=XSGroup11)
###Funct3: Reverse X axis
objFunctRev <- gcheckbox("Reverse X axis",checked=TRUE, handler=function(h,...){
PlotParameters$Reverse <<- svalue(objFunctRev)
CtrlPlot() ####PLOT FOLLOWING SELECTIONS
}, container=XSGroup1)
###Funct4: Switch Binding to Kinetic Energy scale
objFunctSwitch <- gcheckbox("Switch BE to KE scale",checked=FALSE, handler=function(h,...){
PlotParameters$SwitchE <<- svalue(objFunctSwitch)
CtrlPlot() ####PLOT FOLLOWING SELECTIONS
}, container=XSGroup1)
CLGroup2 <- ggroup(horizontal=TRUE, spacing=5, container=T2frame1)
glabel("Core-Line ", spacinig=3, container=CLGroup2)
CLGroup22 <- ggroup(horizontal=TRUE, spacing=5, container=CLGroup2)
objCLine <- gcombobox(c(" "), selected=-1, editable=FALSE, container=CLGroup22)
###Funct1: Normalize
objFunctNorm <- gcheckbox("Normalize",checked=FALSE, handler=function(h,...){
if ( svalue(objFunctNorm) == FALSE) { PlotParameters$Normalize <<- NULL }
FName <- get(FNamesCoreLines$XPSSample[1], envir=.GlobalEnv) #retrieve a generic XPSSample from the selected ones
Plot_Args$ylab$label <<- FName[[FNamesCoreLines$CoreLines[1]]]@units[2] #retrieve the Y axis label
SelectedCL <- svalue(T1CLineListCK)
if ( svalue(objFunctNorm)) { #Normalize option TRUE
NormWin <- gwindow("NORMALIZATION", parent=c(10, 10), visible=FALSE)
size(NormWin) <- c(350, 200)
Normgroup <- ggroup(horizontal=FALSE, container=NormWin)
glabel("Select the Core-Lines to Normalize", container=Normgroup)
NormCL <- gcheckboxgroup(SelectedCL, checked=FALSE, horizontal=TRUE, handler=function(h,...){
PlotParameters$Normalize <<- as.integer(svalue(NormCL, index=TRUE))
if (length(PlotParameters$Normalize) == 0) { PlotParameters$Normalize <<- NULL } #all Core-Line de-selected
}, container=Normgroup)
gbutton(" EXIT ", handler = function(h, ...){
dispose(NormWin)
CtrlPlot()
}, container=Normgroup)
visible(NormWin) <- TRUE
Plot_Args$ylab$label <<- "Intensity [a.u.]"
}
CtrlPlot() ####PLOT FOLLOWING SELECTIONS
}, container=CLGroup2)
###Funct2: Y-Align
objFunctAlign <- gcheckbox("Align bkg to 0",checked=FALSE, handler=function(h,...){
PlotParameters$Align <<- svalue(objFunctAlign)
CtrlPlot() ####PLOT FOLLOWING SELECTIONS
}, container=CLGroup2)
###Funct5: Amplify
CLGroup3 <- ggroup(horizontal=TRUE, spacing=5, container=T2frame1)
glabel("ScaleFact.", spacinig=3, container=CLGroup3)
objScaleFact <- gedit("", handler=function(h,...){
XS <- as.numeric(svalue(objXSamp, index=TRUE))
CL <- as.numeric(svalue(objCLine, index=TRUE))
if (XS == 0 || CL == 0){
gmessage("Please select the XPSSample and the Core-Line", title="WARNING", icon="warning")
return()
}
indx <- as.numeric(svalue(objCLine, index=TRUE))
PlotParameters$ScaleFact$XS <<- XS
PlotParameters$ScaleFact$CL <<- CL
PlotParameters$ScaleFact$ScFact <<- as.numeric(svalue(objScaleFact))
CtrlPlot() ####PLOT FOLLOWING SELECTIONS
}, container=CLGroup3)
tkconfigure(objScaleFact$widget, width=8)
###Funct6: X, Y offset
glabel("X-Offset", spacinig=3, container=CLGroup3)
XOffsetobj <- gedit("", initial.msg = "X_Off= ", width=7, handler=function(h,...){
PlotParameters$XOffset$CL <<- as.numeric(svalue(objCLine, index=TRUE))
PlotParameters$XOffset$Shift <<- as.numeric(svalue(XOffsetobj))
if (is.na(PlotParameters$XOffset)){
gmessage("Please enter a numeric value for the X-shift", title="WARNING", icon="warning")
PlotParameters$XOffset$Shift <<- 0
return()
}
CtrlPlot()
}, container=CLGroup3)
tkconfigure(XOffsetobj$widget, width=8)
enabled(XOffsetobj) <- FALSE
glabel("Y-Offset", spacinig=3, container=CLGroup3)
YOffsetobj <- gedit("", initial.msg = "Y_Off= ", width=7, handler=function(h,...){
PlotParameters$YOffset$CL <<- as.numeric(svalue(objCLine, index=TRUE))
PlotParameters$YOffset$Shift <<- as.numeric(svalue(YOffsetobj))
if (is.na(PlotParameters$YOffset)){
gmessage("Please enter a numeric value for the Y-shift", title="WARNING", icon="warning")
PlotParameters$YOffset$Shift <<- 0
return()
}
CtrlPlot()
}, container=CLGroup3)
tkconfigure(YOffsetobj$widget, width=8)
enabled(YOffsetobj) <- FALSE
###Funct8: Custom XY scale
T2frame2 <- gframe(text="EXACT X, Y RANGE", horizontal=FALSE, spacing=5, container=T2group1)
glabel(text="Select the Spectrum", spacing=3, container=T2frame2)
T2CLgroup <- ggroup(horizontal=TRUE, container=T2frame2)
CLPanel <- gcombobox(" ", selected = -1, editable = FALSE, container=T2CLgroup)
T2XYgroup <- ggroup(horizontal=TRUE, container=T2frame2)
xx1 <- gedit("", initial.msg = "Xmin= ", container=T2XYgroup)
xx2 <- gedit("", initial.msg = "Xmax= ", container=T2XYgroup)
yy1 <- gedit("", initial.msg = "Ymin= ", container=T2XYgroup)
yy2 <- gedit("", initial.msg = "Ymax= ", container=T2XYgroup)
tkconfigure(xx1$widget, width=15)
tkconfigure(xx2$widget, width=15)
tkconfigure(yy1$widget, width=15)
tkconfigure(yy2$widget, width=15)
T2_ButtGroup <- ggroup(horizontal=TRUE, container=T2frame2) #needed only to have a small OK button
gbutton(" OK ", width=25, handler=function(h,...){
panel <- svalue(CLPanel, index=TRUE)
xx1 <- as.numeric(svalue(xx1))
xx2 <- as.numeric(svalue(xx2))
yy1 <- as.numeric(svalue(yy1))
yy2 <- as.numeric(svalue(yy2))
if (is.na(xx1*xx2*yy1*yy2)) {
gmessage("ATTENTION: plase set all the xmin, xmax, ymin, ymax values!", title = "CHANGE X Y RANGE", icon = "error")
}
PlotParameters$CustomXY <<- c(panel, xx1, xx2, yy1, yy2)
CtrlPlot()
}, container = T2_ButtGroup)
gbutton(" RESET PLOT ", handler=function(h,...){
ResetPlot()
CtrlPlot()
}, container = T2_ButtGroup)
gbutton(" EXIT ", handler=function(h,...){
dispose(win)
}, container = T2_ButtGroup)
# --- TAB3 ---
# Rendering options
T3group1 <- ggroup(label="RENDERING", horizontal=FALSE, container=nb)
T3group2 <- ggroup(horizontal=TRUE, container=T3group1)
T3group3 <- ggroup(horizontal=FALSE, container=T3group2)
T3F_CL_Colors <- gframe("SET CORELINE PALETTE", spacing=5, container=T3group3)
T3_CL_Colors <- gdf(CLPalette, container=T3F_CL_Colors)
size(T3_CL_Colors) <- c(110, 250)
addHandlerChanged(T3_CL_Colors, handler=function(h,...){ #edit Palette preferences
CLPalette$Colors <<- Colors <<- h$obj[]
PlotParameters$Colors <<- Colors
Plot_Args$par.settings$superpose.symbol$fill <<- Colors
Plot_Args$par.settings$superpose.line$col <<- Colors
AutoKey_Args$col <<- Colors
Plot_Args$par.settings$superpose.symbol$col <<- Colors
CtrlPlot()
} )
layoutRend <- glayout(homogeneous=FALSE, spacing=3, container=T3group2)
layoutRend[1,1] <- T3F_BW_Col <- gframe("COLOR", spacing=5, container=layoutRend)
T3_BW_Col <- gcombobox(c("B/W", "RainBow"), selected=1, editable=FALSE, handler=function(h,...){
Plot_Args$type <<- "l"
if(svalue(T3_SetSymbols) == "ON") {Plot_Args$type <<- "b"}
if(svalue(T3_BW_Col)=="B/W") {
svalue(T3_SetLines) <- "ON"
svalue(T3_LineType) <<- "pattern"
svalue(T3_SymType) <<- "multi-symbols"
svalue(TxtColCK) <<- "B/W"
PlotParameters$Colors <<- "black"
Plot_Args$lty <<- rep("solid", 20)
Plot_Args$pch <<- STypeIndx
Plot_Args$cex <<- as.numeric(svalue(T3_SymSize))
Plot_Args$par.settings$superpose.symbol$col <<- "black"
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
Plot_Args$par.settings$superpose.line$col <<- "black"
Plot_Args$par.settings$superpose.line$lty <<- rep("solid", 20)
Plot_Args$par.settings$strip.background$col <<- "grey90"
if(svalue(T3_LineType) == "patterns"){
Plot_Args$lty <<- LType
Plot_Args$par.settings$superpose.line$lty <<- LType
}
AutoKey_Args$col <<- "black"
} else {
svalue(TxtColCK) <<- "RainBow"
Plot_Args$lty <<- rep("solid", 20)
Plot_Args$pch <<- rep(STypeIndx[1], 20)
Plot_Args$cex <<- as.numeric(svalue(T3_SymSize))
PlotParameters$Colors <<- Colors
Plot_Args$par.settings$superpose.line$col <<- Colors
Plot_Args$par.settings$superpose.line$lty <<- rep("solid", 20)
Plot_Args$par.settings$superpose.symbol$col <<- Colors
Plot_Args$par.settings$superpose.symbol$pch <<- rep(STypeIndx[1], 20)
Plot_Args$par.settings$strip.background$col <<- "lightskyblue1"
AutoKey_Args$col <<- Colors
if(svalue(T3_LineType) == "patterns"){
Plot_Args$lty <<- LType
Plot_Args$par.settings$superpose.line$lty <<- LType
}
if(svalue(T3_SymType) == "multi-symbols"){
Plot_Args$pch <<- STypeIndx
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
}
}
CtrlPlot() }, container=T3F_BW_Col)
layoutRend[1,2] <- T3F_Grid <- gframe("GRID", spacing=5, container=layoutRend)
T3_Grid <- gcombobox(c("Grid ON", "Grid OFF"), selected=-1, editable=FALSE, handler=function(h,...){
if(svalue(T3_Grid)=="Grid ON") {
Plot_Args$grid <<- TRUE
} else {
Plot_Args$grid <<- FALSE
}
CtrlPlot() }, container=T3F_Grid)
layoutRend[2,1] <- T3F_SetLines <- gframe("SET LINES", spacing=5, container=layoutRend)
T3_SetLines <- gradio(c("ON", "OFF"), selected=1, horizontal = TRUE, handler=function(h,...){
SetLinesPoints()
}, container=T3F_SetLines)
layoutRend[2,2] <- T3F_SetSymbols <- gframe("SET SYMBOLS", horizontal=TRUE, spacing=5, container=layoutRend)
T3_SetSymbols <- gradio(c("ON", "OFF"), selected=2, horizontal=TRUE, handler=function(h,...){
SetLinesPoints()
}, container=T3F_SetSymbols)
layoutRend[3,1] <- T3F_SetLines <- gframe("LINE TYPE", spacing=5, container=layoutRend)
T3_LineType <- gcombobox(c("solid", "patterns"), selected=2, editable=FALSE, handler=function(h,...){
Plot_Args$type <<- "l"
if(svalue(T3_SetSymbols) == "ON") {Plot_Args$type <<- "b"}
palette <- svalue(T3_BW_Col)
if (svalue(T3_LineType)=="solid") {
svalue(T3_BW_Col) <<- "RainBow"
Plot_Args$lty <<- rep("solid", 20)
Plot_Args$pch <<- rep(STypeIndx[1], 20)
Plot_Args$cex <<- as.numeric(svalue(T3_SymSize))
PlotParameters$Colors <<- Colors
Plot_Args$par.settings$superpose.line$col <<- Colors
Plot_Args$par.settings$superpose.line$lty <<- rep("solid", 20)
Plot_Args$par.settings$superpose.symbol$col <<- Colors
Plot_Args$par.settings$superpose.symbol$pch <<- rep(STypeIndx[1], 20)
Plot_Args$par.settings$strip.background$col <<- "lightskyblue"
AutoKey_Args$col <<- Colors
if (svalue(T3F_SetSymbols) == "multi-symbols"){
Plot_Args$pch <<- STypeIndx
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
}
}
if (svalue(T3_LineType)=="patterns") {
ColStyle <- svalue(T3_BW_Col)
PlotParameters$Colors <<- "black"
Plot_Args$lty <<- LType
Plot_Args$pch <<- rep(STypeIndx[1], 20)
Plot_Args$cex <<- as.numeric(svalue(T3_SymSize))
Plot_Args$par.settings$superpose.line$col <<- rep("black", 20)
Plot_Args$par.settings$superpose.line$lty <<- LType
Plot_Args$par.settings$superpose.symbol$col <<- rep("black", 20)
Plot_Args$par.settings$superpose.symbol$pch <<- rep(STypeIndx[1], 20)
Plot_Args$par.settings$strip.background$col <<- "gray90"
AutoKey_Args$col <<- rep("black", 20)
if (ColStyle == "RainBow"){
PlotParameters$Colors <<- Colors
Plot_Args$par.settings$superpose.symbol$col <<- Colors
Plot_Args$par.settings$superpose.line$col <<- Colors
Plot_Args$par.settings$strip.background$col <<- "lightskyblue"
AutoKey_Args$col <<- Colors
}
if (svalue(T3_SymType) == "multi-symbols"){
Plot_Args$pch <<- STypeIndx
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
}
}
CtrlPlot()
}, container=T3F_SetLines)
layoutRend[3,2] <- T3F_LinWidth <- gframe("LINE WIDTH", spacing=5, container=layoutRend)
T3_LinWidth <- gcombobox(LWidth, selected=1, editable=FALSE, handler= function(h,...){
Plot_Args$lwd <<- as.numeric(svalue(T3_LinWidth))
CtrlPlot()
}, container=T3F_LinWidth)
layoutRend[4,1] <- T3F_Symbols <- gframe("SYMBOLS", spacing=5, container=layoutRend)
T3_SymType <- gcombobox(c("single-symbol", "multi-symbols"), selected=2, editable=FALSE, handler=function(h,...){
Plot_Args$type <<- "p"
if(svalue(T3_SetLines) == "ON") {Plot_Args$type <<- "b"}
if (svalue(T3_SymType)=="single-symbol") {
svalue(T3_BW_Col) <<- "RainBow"
Plot_Args$lty <<- rep("solid", 20)
Plot_Args$pch <<- rep(STypeIndx[1], 20)
Plot_Args$cex <<- as.numeric(svalue(T3_SymSize))
PlotParameters$Colors <<- Colors
Plot_Args$par.settings$superpose.line$col <<- Colors
Plot_Args$par.settings$superpose.line$lty <<- rep("solid", 20)
Plot_Args$par.settings$superpose.symbol$col <<- Colors
Plot_Args$par.settings$superpose.symbol$pch <<- rep(STypeIndx[1], 20)
Plot_Args$par.settings$strip.background$col <<- "lightskyblue"
AutoKey_Args$col <<- Colors
if(svalue(T3_LineType) == "patterns"){
Plot_Args$lty <<- LType
Plot_Args$par.settings$superpose.line$lty <<- LType
}
}
if (svalue(T3_SymType)=="multi-symbols") {
PlotParameters$Colors <<- "black"
Plot_Args$lty <<- rep("solid", 20)
Plot_Args$pch <<- STypeIndx
Plot_Args$cex <<- as.numeric(svalue(T3_SymSize))
Plot_Args$par.settings$superpose.line$col <<- rep("black", 20)
Plot_Args$par.settings$superpose.line$lty <<- rep("solid", 20)
Plot_Args$par.settings$superpose.symbol$col <<- rep("black", 20)
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
Plot_Args$par.settings$strip.background$col <<- "gray90"
AutoKey_Args$col <<- rep("black", 20)
ColStyle <- svalue(T3_BW_Col)
if (ColStyle == "RainBow"){
PlotParameters$Colors <<- Colors
Plot_Args$par.settings$superpose.symbol$col <<- Colors
Plot_Args$par.settings$superpose.line$col <<- Colors
Plot_Args$par.settings$strip.background$col <<- "lightskyblue"
AutoKey_Args$col <<- Colors
}
if(svalue(T3_LineType) == "patterns"){
Plot_Args$lty <<- LType
Plot_Args$par.settings$superpose.line$lty <<- LType
}
}
CtrlPlot()
}, container=T3F_Symbols)
layoutRend[4,2] <- T3F_SymSize <- gframe("SYMSIZE", spacing=5, container=layoutRend)
T3_SymSize <- gcombobox(SymSize, selected=4, editable=FALSE, handler= function(h,...){
Plot_Args$cex <<- as.numeric(svalue(T3_SymSize))
CtrlPlot()
}, container=T3F_SymSize)
layoutRend[5,1] <- T3F_PanStripCol <- gframe("PANEL STRIP COLOR", spacing=5, container=layoutRend)
T3_PanStripCol <- gcombobox(c("white","grey", "darkgrey","lightblue","blue","darkblue","deepskyblue","lightbeige","beige","darkbeige","lightpink","pink","darkpink","lightgreen","green","darkgreen"), selected=-1, editable=FALSE, handler= function(h,...){
StripCol <- svalue(T3_PanStripCol)
if(StripCol=="grey") { StripCol <- "grey90"
} else if (StripCol=="darkgrey") { StripCol <- "gray60"
} else if (StripCol=="lightblue") { StripCol <- "lightskyblue1"
} else if(StripCol=="blue") { StripCol <- "lightskyblue3"
} else if(StripCol=="darkblue") { StripCol <- "steelblue3"
} else if (StripCol=="lightbeige") { StripCol <- "beige"
} else if(StripCol=="beige") { StripCol <- "bisque2"
} else if(StripCol=="darkbeige") { StripCol <- "navajowhite4"
} else if (StripCol=="pink") { StripCol <- "lightpink2"
} else if(StripCol=="darkpink") { StripCol <- "lightpink4"
} else if (StripCol=="lightgreen") { StripCol <- "darkseagreen1"
} else if(StripCol=="green") { StripCol <- "darkseagreen2"
} else if(StripCol=="darkgreen") { StripCol <- "mediumseagreen"
}
Plot_Args$par.settings$strip.background$col <<- StripCol
CtrlPlot() }, container=T3F_PanStripCol)
T3group2 <- ggroup(horizontal=TRUE, container=T3group1)
gbutton(" RESET PLOT ", handler=function(h,...){
ResetPlot()
CtrlPlot()
}, container=T3group2)
gbutton(" EXIT ", handler=function(h,...){
dispose(win)
}, container = T3group2)
# --- TAB4 ---
# Axis Rendering options
T4group1 <- ggroup(label="AXES", horizontal=FALSE, container=nb)
layoutAxis <- glayout(homogeneous=FALSE, spacing=3, container=T4group1)
layoutAxis[1,1] <- T4F_XScale <- gframe("X SCALE", spacing=5, container=layoutAxis)
T4_XScale <- gcombobox(c("Standard", "Power", "Log.10", "Log.e", "X*10^n", "Xe+0n"), selected=1, editable=FALSE, handler= function(h,...){
if (svalue(T4_XScale, index = TRUE) == 1) {
Plot_Args$scales$x$log <<- FALSE
Plot_Args$xscale.components <<- xscale.components.subticks
} else if (svalue(T4_XScale, index = TRUE) == 2) {
Plot_Args$scales$x$log <<- 10 # 10^ power scale
Plot_Args$xscale.components <<- xscale.components.logpower
} else if (svalue(T4_XScale, index = TRUE) == 3) {
Plot_Args$scales$x$log <<- 10 # log10 scale
Plot_Args$xscale.components <<- xscale.components.log10ticks
} else if (svalue(T4_XScale, index = TRUE) == 4) {
Plot_Args$scales$x$log <<- "e" # log e scale
Plot_Args$xscale.components <<- xscale.components.subticks
} else if (svalue(T4_XScale, index = TRUE) == 5) {
Plot_Args$scales$x$log <<- "Xpow10"
Plot_Args$scales$x$rot <<- 0
Plot_Args$scales$y$rot <<- 90
} else if (svalue(T4_XScale, index = TRUE) == 6) {
Plot_Args$scales$x$log <<- "Xe+0n"
Plot_Args$scales$x$rot <<- 0
Plot_Args$scales$y$rot <<- 90
}
CtrlPlot() }, container=T4F_XScale)
layoutAxis[1,2] <- T4F_YScale <- gframe("Y SCALE", spacing=5, container=layoutAxis)
T4_YScale <- gcombobox(c("Standard", "Power", "Log.10", "Log.e", "Y*10^n", "Ye+0n"), selected=1, editable=FALSE, handler= function(h,...){
if (svalue(T4_YScale, index = TRUE) == 1) {
Plot_Args$scales$y$log <<- FALSE
Plot_Args$yscale.components <<- yscale.components.subticks
} else if (svalue(T4_YScale, index = TRUE) == 2) {
Plot_Args$scales$y$log <<- 10
Plot_Args$yscale.components <<- yscale.components.logpower
} else if (svalue(T4_YScale, index = TRUE) == 3) {
Plot_Args$scales$y$log <<- 10
Plot_Args$yscale.components <<- yscale.components.log10ticks
} else if (svalue(T4_YScale, index = TRUE) == 4) {
Plot_Args$scales$y$log <<- "e"
Plot_Args$yscale.components <<- yscale.components.subticks
} else if (svalue(T4_YScale, index = TRUE) == 5) {
Plot_Args$scales$y$log <<- "Ypow10"
Plot_Args$scales$x$rot <<- 0
Plot_Args$scales$y$rot <<- 90
} else if (svalue(T4_YScale, index = TRUE) == 6) {
Plot_Args$scales$y$log <<- "Ye+0n"
Plot_Args$scales$x$rot <<- 0
Plot_Args$scales$y$rot <<- 90
}
CtrlPlot() }, container=T4F_YScale)
layoutAxis[1,3] <- T4F_XStep <- gframe("X STEP", spacing=5, container=layoutAxis)
T4_XStep <- gcheckbox("Custom X ticks", checked=FALSE, handler=function(h,...){
if(svalue(T4_XStep)==FALSE) {return()}
Core.Line <- svalue(T1CLineListCK)
NCL <- length(Core.Line)
RngXmin <- round(unlist(Xlim[[2]]), digits=0) #I need identify XRange components using the CoreLine names
RngXmax <- round(unlist(Xlim[[3]]), digits=0)
names(RngXmin) <- Xlim[[1]]
names(RngXmax) <- Xlim[[1]]
winTick <- gwindow(" X AXIS TICK INCREMENT ", parent=c(50,10), visible=FALSE)
DFgroup <- ggroup(horizontal=FALSE, container=winTick)
glabel("Please, give the increment between ticks", container=DFgroup)
Tick.Increment <- rep("?",NCL) #this is needed to construct correctly the data.frame
Tick.Increment <- data.frame(Core.Line,Tick.Increment, stringsAsFactors=FALSE) #in the dataframe add a column with variable names
DFrame <- gdf(items=Tick.Increment, container=DFgroup)
addHandlerChanged(DFrame, handler=function(h,...){ #addHandlerChanged dowload the dataFrame with modified parameters in NewFirParam (global variable)
Tick.Increment <<- h$obj[]
})
gbutton(text=" EXIT ", handler= function(h, ...){
dispose(winTick)
Tick.Increment <- as.numeric(unlist(Tick.Increment[2])) #first element of Tick.Increment is the CL-names
x_at <- list()
x_labels <- list()
for(ii in 1:NCL){
x_at[[ii]] <- seq(from=RngXmin[[Core.Line[ii]]], to=RngXmax[[Core.Line[ii]]], by=Tick.Increment[ii])
x_labels[[ii]] <- as.character(x_at[[ii]])
}
Plot_Args$scales$x <<- list(at = x_at, labels = x_labels, log=FALSE)
CtrlPlot()
}, container=DFgroup)
visible(winTick) <- TRUE
}, container=T4F_XStep)
layoutAxis[2,1] <- T4F_TitSize <- gframe("TITLE SIZE", spacing=5, container=layoutAxis)
T4_TitSize <- gcombobox(FontSize, selected=5, editable=FALSE, handler= function(h,...){
if (PlotParameters$OverlayMode=="Single-Panel" || PlotParameters$OverlayMode=="TreD") {
Plot_Args$main$cex <<- svalue(T4_TitSize)
} else if (PlotParameters$OverlayMode=="Multi-Panel") {
Plot_Args$par.strip.text$cex <<- as.numeric(svalue(T4_TitSize))
}
CtrlPlot() }, container=T4F_TitSize)
layoutAxis[2,2] <- T4F_PanelTitles <- gframe("CHANGE PANEL TITLES", spacing=5, container=layoutAxis)
T4_PanelTitles <- gbutton(text="Change Titles", spacing=5, handler=function(h,...){
TitleWin <- gwindow(title="MultiPanel Labels", visible=FALSE) #open a new window to contain a gdf() to change the titles of the panels
TitleGroup <- ggroup(horizontal=FALSE, container=TitleWin)
glabel(" EDIT TITLES ", container=TitleGroup) #long lable to obtain a reasonable window dimension
LL=length(PanelTitles)
PTitles <- data.frame(TITLES=PanelTitles, stringsAsFactors=FALSE)
TitleDFrame <- gdf(items=PTitles, container=TitleGroup) #here no handler it does not work in linux
size(TitleDFrame) <- c(100,200) #size needed to obtain a non-null size for the gdf()
addHandlerChanged(TitleDFrame, handler=function(h,...){ #addHandlerChanged to add a handler to gdf() working also in linux
PanelTitles <<- h$obj[]
})
gbutton(" SAVE TITLES AND EXIT ", handler=function(h,...){
Plot_Args$PanelTitles <<- PanelTitles
dispose(TitleWin)
CtrlPlot()
}, container = TitleGroup)
visible(TitleWin) <- TRUE
}, container=T4F_PanelTitles)
layoutAxis[2,3] <- T4F_YStep <- gframe("Y STEP", spacing=5, container=layoutAxis)
T4_YStep <- gcheckbox("Custom Y ticks ", checked=FALSE, handler=function(h,...){
if(svalue(T4_YStep)==FALSE) {return()}
Core.Line <- svalue(T1CLineListCK)
NCL <- length(Core.Line)
RngYmin <- round(unlist(Ylim[[2]]), digits=0) #I need identify XRange components using the CoreLine names
RngYmax <- round(unlist(Ylim[[3]]), digits=0)
names(RngYmin) <- Xlim[[1]]
names(RngYmax) <- Xlim[[1]]
winTick <- gwindow(" Y AXIS TICK INCREMENT ", parent=c(50,10), visible=FALSE)
DFgroup <- ggroup(horizontal=FALSE, container=winTick)
glabel("Please, give the increment between ticks", container=DFgroup)
Tick.Increment <- rep("?",NCL) #this is needed to construct correctly the data.frame
Tick.Increment <- data.frame(Core.Line,Tick.Increment, stringsAsFactors=FALSE) #in the dataframe add a column with variable names
DFrame <- gdf(items=Tick.Increment, container=DFgroup)
addHandlerChanged(DFrame, handler=function(h,...){ #addHandlerChanged dowload the dataFrame with modified parameters in NewFirParam (global variable)
Tick.Increment <<- h$obj[]
})
gbutton(text=" EXIT ", handler= function(h, ...){
dispose(winTick)
Tick.Increment <- as.numeric(unlist(Tick.Increment[2])) #first element of Tick.Increment is the CL-names
y_at <- list()
y_labels <- list()
for(ii in 1:NCL){ #reshape the Y limits using rounded values
Ndigit <- nchar(RngYmin[[Core.Line[ii]]])
Y1 <- as.integer(RngYmin[[Core.Line[ii]]]/(10^(Ndigit-1)))* 10^(Ndigit-1)
Ndigit <- nchar(RngYmax[[Core.Line[ii]]])
Y2 <- as.integer(RngYmax[[Core.Line[ii]]]/(10^(Ndigit-2)))* 10^(Ndigit-2)+10^(Ndigit-2)
y_at[[ii]] <- seq(from=Y1, to=Y2, by=Tick.Increment[ii])
y_labels[[ii]] <- as.character(y_at[[ii]])
}
Plot_Args$scales$y <<- list(at = y_at, labels = y_labels, log=FALSE)
CtrlPlot()
}, container=DFgroup)
visible(winTick) <- TRUE
}, container=T4F_YStep)
layoutAxis[3,1] <- T4F_AxNumSize <- gframe("AXIS NUMBER SIZE", spacing=5, container=layoutAxis)
T4_AxNumSize <- gcombobox(FontSize, selected=3, editable=FALSE, handler= function(h,...){
Plot_Args$scales$cex <<- svalue(T4_AxNumSize)
CtrlPlot() }, container=T4F_AxNumSize)
layoutAxis[3,2] <- T4F_AxLabSize <- gframe("AXIS LABEL SIZE", spacing=5, container=layoutAxis)
T4_AxLabSize <- gcombobox(FontSize, selected=3, editable=FALSE, handler= function(h,...){
Plot_Args$xlab$cex <<- svalue(T4_AxLabSize)
Plot_Args$ylab$cex <<- svalue(T4_AxLabSize)
CtrlPlot() }, container=T4F_AxLabSize)
layoutAxis[3,3] <- T4F_AxLabOrient <- gframe("AXIS NUMBER ORIENTATION", spacing=5, container=layoutAxis)
T4_AxLabOrient <- gcombobox(AxLabOrient, selected=1, editable=FALSE, handler= function(h,...){
LabOrient <- svalue(T4_AxLabOrient)
if (LabOrient == "Horizontal"){Plot_Args$scales$rot <<- 0}
if (LabOrient == "Rot-20"){Plot_Args$scales$rot <<- 20}
if (LabOrient == "Rot-45"){Plot_Args$scales$rot <<- 45}
if (LabOrient == "Rot-70"){Plot_Args$scales$rot <<- 70}
if (LabOrient == "Vertical"){Plot_Args$scales$rot <<- 90}
if (LabOrient == "Parallel"){
Plot_Args$scales$x$rot <<- 0
Plot_Args$scales$y$rot <<- 90
}
CtrlPlot() }, container=T4F_AxLabOrient)
layoutAxis[4,1] <- T4F_XAxNameChange <- gframe("CHANGE X-LABEL", spacing=5, container=layoutAxis)
T4_XAxNameChange <- gedit("", handler=function(h,...){
if(svalue(T4_XAxNameChange)==""){return()}
Plot_Args$xlab$label <<- svalue(T4_XAxNameChange)
CtrlPlot() } , container=T4F_XAxNameChange)
layoutAxis[4,2] <- T4F_YAxNameChange <- gframe("CHANGE Y-LABEL", spacing=5, container=layoutAxis)
T4_YAxNameChange <- gedit("",handler=function(h,...){
if(svalue(T4_YAxNameChange)==""){return()}
Plot_Args$ylab$label <<- svalue(T4_YAxNameChange) # in 2D Y is the vertical axis
CtrlPlot() }, container=T4F_YAxNameChange)
T4group2 <- ggroup(horizontal=TRUE, container=T4group1)
gbutton(" RESET PLOT ", handler=function(h,...){
ResetPlot()
CtrlPlot()
}, container=T4group2)
gbutton(" EXIT ", handler=function(h,...){
dispose(win)
}, container = T4group2)
# --- TAB5 ---
### LEGEND SETTINGS
T5group1 <- ggroup(label="LEGEND", horizontal=FALSE, container=nb)
layoutLeg <- glayout(homogeneous=FALSE, spacing=3, container=T5group1)
layoutLeg[1,1] <- T5F_legendCK <- gframe(text="Enable Legend", spacing=5, container=layoutLeg)
legendCK <- gcheckbox("Enable Legend ON/OFF", checked=TRUE,handler=function(h,...){
AutoKey_Args$text <<- unlist(FNamesCoreLines$XPSSample) #load the Legends in the slot of the AutoKey_Args = List of parameters defining legend properties
Plot_Args$auto.key <<- AutoKey_Args #Save the AutoKey_Args list of par in Plot_Args$auto.key
if (svalue(legendCK)==TRUE) {
if (svalue(T3_SetLines)=="ON") { #selezionate LINEE
Plot_Args$par.settings$superpose.line$col <<- "black" #B/W plot
Plot_Args$par.settings$superpose.line$lty <<- LType
Plot_Args$scales$relation <<- "free"
if (svalue(T3_BW_Col)=="RainBow") { #COLOR plot
Plot_Args$par.settings$superpose.line$col <<- Colors
Plot_Args$par.settings$superpose.line$lty <<- "solid"
}
}
if (svalue(T3_SetSymbols)=="ON") { #selezionate SIMBOLI
Plot_Args$par.settings$superpose.symbol$col <<- "black" #B/W plot
Plot_Args$par.settings$superpose.symbol$pch <<- STypeIndx
Plot_Args$par.settings$superpose.symbol$pch <<- 1
Plot_Args$scales$relation <<- "free"
if (svalue(T3_BW_Col)=="RainBow") { #COLOR plot
Plot_Args$par.settings$superpose.symbol$col <<- Colors
}
}
} else {
Plot_Args$auto.key <<- FALSE
}
CtrlPlot()
}, container=T5F_legendCK)
layoutLeg[1,2] <- T5F_LegFNameCK <- gframe(text="Add XPSSamp Name", spacing=5, container=layoutLeg)
LegFNameCK <- gcheckbox("XPSSamp.Name ON/OFF", checked=TRUE,handler=function(h,...){
if (is.logical(Plot_Args$auto.key)){
gmessage("PLEASE ENABLE LEGENDS", icon="warning")
svalue(LegFNameCK) <- FALSE
} else {
if (svalue(LegFNameCK)==TRUE) {
Legends <- FNamesCoreLines$CoreLines
for (ii in seq_along(FNamesCoreLines$XPSSample)){
tmp <- unlist(strsplit(Legends[ii], "\\.")) #skip the number at beginning coreline name
Legends[ii] <- paste(tmp[2], "_", FNamesCoreLines$XPSSample[ii], sep="")
}
Plot_Args$auto.key$text <<- as.vector(Legends)
} else {
Legends <- FNamesCoreLines$CoreLines
for(ii in seq_along(Legends)){
tmp <- unlist(strsplit(Legends[ii], "\\.")) #skip the number at beginning coreline name
Legends[ii] <- tmp[2]
}
Plot_Args$auto.key$text <<- as.vector(Legends)
}
}
CtrlPlot()
}, container=T5F_LegFNameCK)
layoutLeg[2,1] <- T5F_TSizeCK <- gframe(text="Text Size", spacing=5, container=layoutLeg)
TSizeCK <- gcombobox(LegTxtSize,selected=1, toolkit = guiToolkit(), handler=function(h,...){
Plot_Args$auto.key$cex <<- as.numeric(svalue(TSizeCK))
CtrlPlot()
}, container=T5F_TSizeCK)
layoutLeg[2,2] <- T5F_LegColCK <- gframe(text="Group Legend and organize in columns", spacing=5, container=layoutLeg)
LegColCK <- gedit(initial.msg ="Col. numb.", selected=1, editable=FALSE, handler=function(h,...){
columns <- svalue(LegColCK)
Plot_Args$auto.key$columns <<- as.numeric(svalue(LegColCK))
CtrlPlot()
}, container=T5F_LegColCK)
layoutLeg[3,1] <- T5F_LineWdhCK <- gframe(text="Line/Symbol weight", spacing=5, container=layoutLeg)
LineWdhCK <- gcombobox(LWidth,selected=1, toolkit = guiToolkit(), handler=function(h,...){
weight <- as.numeric(svalue(LineWdhCK))
if (svalue(T3_SetLines)=="ON") { #Lines selected
Plot_Args$par.settings$superpose.line$lwd <<- weight
}
if (svalue(T3_SetSymbols)=="ON") { #Symbol selected
Plot_Args$par.settings$superpose.symbol$cex <<- weight
}
CtrlPlot()
}, container=T5F_LineWdhCK)
layoutLeg[3,2] <- T5F_TxtColCK <- gframe(text="Legend text Color", spacing=5, container=layoutLeg)
TxtColCK <- gcombobox(c("B/W", "RainBow"),selected=1, toolkit = guiToolkit(), handler=function(h,...){
if (svalue(TxtColCK)=="B/W"){
Plot_Args$auto.key$col <<- "black"
} else {
Plot_Args$auto.key$col <<- Colors
}
CtrlPlot()
}, container=T5F_TxtColCK)
layoutLeg[4,1] <- T5F_ChangLeg <- gbutton(text="Change Legend", spacing=5, handler=function(h,...){
LegWin <- gwindow(title="XPS Sample Legends", visible=FALSE) #open a new window to contain the list of new labels
LegGroup <- ggroup(horizontal=FALSE, container=LegWin)
glabel(" EDIT LEGENDS ", container=LegGroup) #This label long to get a reasonable window dimension
LL=length(FNamesCoreLines$XPSSample)
Legends <- data.frame(LEGENDS=rep("-", LL), stringsAsFactors=FALSE)
LegDFrame <- gdf(items=Legends, container=LegGroup) #here no handler: it does not work in linux
size(LegDFrame) <- c(150,150) #size needed to generate a window with a non null-size window
addHandlerChanged(LegDFrame, handler=function(h,...){ #addHandlerChanged to add the handler to gdf() working also in linux.
Legends <<- h$obj[]
})
gbutton(" SAVE LEGENDS & EXIT ", handler=function(h,...){
Plot_Args$auto.key$text <<- as.vector(Legends)
dispose(LegWin)
unblockHandler(Annotate)
CtrlPlot()
}, container = LegGroup)
visible(LegWin) <- TRUE
CtrlPlot()
}, container=layoutLeg)
T5group2 <- ggroup(horizontal=TRUE, container=T5group1)
gbutton(" RESET PLOT ", handler=function(h,...){
ResetPlot()
CtrlPlot()
}, container=T5group2)
gbutton(" EXIT ", handler=function(h,...){
dispose(win)
}, container = T5group2)
#----- END NOTEBOOK -----
svalue(nb) <- 5
svalue(nb) <- 4
svalue(nb) <- 3
svalue(nb) <- 2
svalue(nb) <- 1
addHandlerChanged(nb, handler=function(h, ...){
if (svalue(nb) > 1 || plotted==FALSE) {
CtrlPlot()
plotted <<- TRUE
return()
}
})
tcl("update", "idletasks")
visible(win) <- TRUE
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.