R/XPSMoveCompGUI.r

Defines functions XPSMoveComp

Documented in XPSMoveComp

#' @title XPSMoveComp
#' @description XPSMoveComp function to modify component position and intensity in a fit
#'   this function provides a userfriendly interface change position and intensity of each
#'   individual fitting component of a selected XPSCoreline. Changes are saved
#'   in the .GlobalEnv main software memory.
#' @examples
#' \dontrun{
#' 	XPSMoveComp()
#' }
#' @export
#'


XPSMoveComp <- function(){

  GetCurPos <- function(SingClick){
       coords <<- NULL
       EXIT <- FALSE
       enabled(FitComp) <- FALSE   #prevent exiting Analysis if locatore active
       enabled(MCFrame4) <- FALSE   #prevent exiting Analysis if locatore active
       Estep <- abs(Object@RegionToFit[[1]][1] - Object@RegionToFit[[1]][2])
cat("\n 1111")
       while(EXIT == FALSE){
            pos <- locator(n=1)
            if (is.null(pos)) {
                enabled(FitComp) <- TRUE
                enabled(MCFrame4) <- TRUE
                EXIT <- TRUE
            } else {
                if (SingClick){
                     enabled(FitComp) <- TRUE
                     enabled(MCFrame4) <- TRUE
                     EXIT <- TRUE
                }
                if (SetZoom == TRUE) {  #define zoom area
                    xx <- pos$x
                    yy <- pos$y
                    Xindx <- which(Object@RegionToFit[[1]] > xx-Estep/2 & Object@RegionToFit[[1]] < xx+Estep/2)
                    yy_BasLin <- yy-Object@Baseline$y[Xindx]  #spectral intensity at xx without Baseline
                    coords <<- c(xx, yy, yy_BasLin)
                    RBmousedown()  #selection of the zoom area
                } else {
                    xx <- pos$x
                    yy <- pos$y
                    Xindx <- which(Object@RegionToFit[[1]] > xx-Estep/2 & Object@RegionToFit[[1]] < xx+Estep/2)
                    yy_BasLin <- yy-Object@Baseline$y[Xindx]  #spectral intensity at xx without Baseline
                    coords <<- c(xx, yy, yy_BasLin)
                    LBmousedown()  #selection of the BaseLine Edges
                }
            }
       }
       return()
  }

  LBmousedown <- function() {   #Left mouse button down
	    xx <- coords[1]
	    yy <- coords[2]
     if (SetZoom==FALSE) { #left button works only when SET ZOOM REGION inactive
        MoveComp()
    	   ## loop on spectra and retrieve Pass Energy
        XPSquantify(XPSSample)
        refresh <<- FALSE
     }
     replot()
  }

  RBmousedown <- function() {   #Right mouse button down
	    xx <- coords[1]
	    yy <- coords[2]
     if (SetZoom == TRUE) { #left button works only when SET ZOOM REGION button pressed
     	  point.coords$x[point.index] <<- coords[1]   #abscissa
     	  point.coords$y[point.index] <<- coords[2]   #ordinate
     	  if (point.index == 1) {   #First rect corner C1
     	     point.index <<- 3
           Corners$x <<- c(point.coords$x[1],point.coords$x[1],point.coords$x[2],point.coords$x[2])
           Corners$y <<- c(point.coords$y[1],point.coords$y[2],point.coords$y[1],point.coords$y[2])
#  	     } else if (point.index == 2) { #Second rect corner C2 opposite to C1
#           point.index <<- 3
#           Corners$x <<- c(point.coords$x[1],point.coords$x[1],point.coords$x[2],point.coords$x[2])
#           Corners$y <<- c(point.coords$y[1],point.coords$y[2],point.coords$y[1],point.coords$y[2])
  	     } else if (point.index == 3) { #modifies corner positions
           D <- vector("numeric", 4)
           Dmin <- ((point.coords$x[3]-Corners$x[1])^2 + (point.coords$y[3]-Corners$y[1])^2)^0.5  #valore di inizializzazione
           for (ii in 1:4) {
               D[ii] <- ((point.coords$x[3]-Corners$x[ii])^2 + (point.coords$y[3]-Corners$y[ii])^2)^0.5  #dist P0 P1
               if(D[ii] <= Dmin){
                  Dmin <- D[ii]
                  idx <- ii
               }
           }
           if (idx == 1){
              Corners$x[1] <<- Corners$x[2] <<- point.coords$x[3]
              Corners$y[1] <<- Corners$y[3] <<- point.coords$y[3]
           } else if (idx==2){
              Corners$x[1] <<- Corners$x[2] <<- point.coords$x[3]
              Corners$y[2] <<- Corners$y[4] <<- point.coords$y[3]
           } else if (idx==3){
              Corners$x[3] <<- Corners$x[4] <<- point.coords$x[3]
              Corners$y[1] <<- Corners$y[3] <<- point.coords$y[3]
           } else if (idx==4){
              Corners$x[3] <<- Corners$x[4] <<- point.coords$x[3]
              Corners$y[2] <<- Corners$y[4] <<- point.coords$y[3]
           }
           if (Object@Flags[1]) { #Binding energy set
              point.coords$x <<- sort(c(Corners$x[1],Corners$x[3]), decreasing=TRUE) #pos$x in decreasing order
              point.coords$y <<- sort(c(Corners$y[1],Corners$y[4]), decreasing=FALSE)
           } else {
              point.coords$x <<- sort(c(Corners$x[1],Corners$x[3]), decreasing=FALSE) #pos$x in increasing order
              point.coords$y <<- sort(c(Corners$y[1],Corners$y[4]), decreasing=FALSE)
           }
        }
        replot()
     }
  }

  Check.PE <- function(){
    	PassE <- NULL
       	PassE <- sapply( XPSSample, function(x) {
                      info <- x@Info[1]   #retrieve info containing PE value
                      sss <- strsplit(info, "Pass energy")  #extract PE value
                      PE <- strsplit(sss[[1]][2], "Iris") #PE value
                      PE <- gsub(" ", "", PE[[1]][1], fixed=TRUE) #drop white spaces in string PE
                      PE <- as.integer(PE)
                      return(PE)
		                  }
                  )
        SpectList <- XPSSpectList(activeFName)
        idx <- grep("Survey", SpectList)       #recognize presence of a Survey
        if (length(idx) == 0){ idx <- grep("survey", SpectList) }
        if (length(idx) == 0){ return(TRUE) }  #No survey spectra are present in XPSSample: continue working

        PEsur <- PassE[[ idx[1] ]]             #if idx is a vector, select the first element

        if (length(idx) > 0){                  #a survey is present
           SpectList <- SpectList[-idx]        #eliminate the "Survey" from list of Spectral Names
           PassE <- PassE[-idx]                #eliminate the PassE(survey) to compare PE of only core-lines
        }
        Extracted <- which(PassE == 160)
        LL <- length(Extracted)
        if (LL > 0){
            for(ii in 1:LL){
                Indx <- Extracted[ii]
                Indx <- unlist(strsplit(SpectList[Indx], "\\."))   
                Indx <- as.integer(Indx[1])                    #select "NUMber." in component name
                if ( hasRegionToFit(XPSSample[[Indx]])){
                     txt <- paste(SpectList[Extracted], collapse="  ")
                     txt <- paste(" Found Core Line: ", txt, " extracted from Survey.
                     \nCannot perform quantification here!
                     \nPlease exit  MOVE COMPONENT  and run  QUANTIFY  option to correct Core Line intensity")
                     gmessage(msg=txt, title="WARNING", icon="warning")
                     return(FALSE)
                     break
                }
            }
        }
        return(TRUE)
  }

  MoveComp <- function(...) {
#     FComp <- svalue(FitComp)

     if (length(FComp)==0) {
         gmessage(msg="Select Component Please", title="WARNING", icon = "warning")
     } else {
#        FComp <- as.numeric(unlist(strsplit(FComp, split="C")))   #index of the selected component
#        FComp <- FComp[2]
        xx <- coords[1]
        yy <- coords[2]  #Component max value with baseline
        zz <- coords[3]  #Component max value without baseline

        FitFunct <- Object@Components[[FComp]]@funcName
        newh <- GetHvalue(Object, FComp, FitFunct, zz)  #Get value computes the Component value given the fit parameters and the Ymax value

        #range limits for mu
        varmu <- getParam(Object@Components[[FComp]],variable="mu")
        minmu <- varmu$start-varmu$min
        maxmu <- varmu$max-varmu$start
        newmu <- c(xx, xx-minmu, xx+maxmu)
        #range limits for h
        varh <- getParam(Object@Components[[FComp]],variable="h")
        minh <- varh$start-varh$min
        maxh <- varh$max-varh$start

        if (maxh > 0) {
            newh <- c(newh, 0, newh*5)    # No constraints on h
        }
        if (maxh==0){
            newh <- c(newh, newh, newh)   # h is fixed
        }
        if (maxh < 0){
            newh <- c(newh, 0, newh*5)    # maxh cannot be <0: => force newH to correct values
        }
        if (varh$start < 0) {
            newh <- c(0, 0, 1e5)   #set a positive value for an hypotheic fit
        }

        Object@Components[[FComp]] <<- setParam(Object@Components[[FComp]], parameter=NULL, variable="mu", value=newmu)
        Object@Components[[FComp]] <<- setParam(Object@Components[[FComp]], parameter=NULL, variable="h", value=newh)
#Now compute the new component Y values for the new xy position
        Object@Components[[FComp]] <<- Ycomponent(Object@Components[[FComp]], x=Object@RegionToFit$x, y=Object@Baseline$y) #eomputes the Y value and add baseline
#Fit computed addind fit components with the modified ones
        tmp <- sapply(Object@Components, function(z) matrix(data=z@ycoor))
        Object@Fit$y <<- ( colSums(t(tmp)) - length(Object@Components)*(Object@Baseline$y))

        Object <<- sortComponents(Object)
#if component order changed then re-number them
        LL <- length(Object@Components) #N. fit components
        for (ii in 1:LL){
           if (xx == Object@Components[[ii]]@param["mu",1]) { #compare marker position with component positions
             idx <- ii
             break()
           }
        }
        svalue(FitComp) <- paste("C", idx, sep="")  #update component gradio
        XPSSample[[Indx]] <<- Object
     }
  }

  replot <- function(...) {
     if (point.index==1 && refresh==FALSE) {  #point.index==1 when moving mcomponent
         plot(Object, xlim=Xlimits, ylim=Ylimits)
         points(x=coords[1], y=coords[2], col=2, cex=1.2, lwd=2.5, pch=1)  # if refresh==FALSE plot spectrum with component marker
     } else if (SetZoom == TRUE){   #set zoom area corners
	        if (point.index == 1) {    #normal plot
 	           plot(Object)
             points(point.coords, type="p", col=4, cex=1.2, lwd=2.5, pch=3)
  	      } else if (point.index == 3){  #plot zoom area corners
 	           plot(Object, xlim=Xlimits, ylim=Ylimits)
             points(Corners, type="p", col=4, cex=1.2, lwd=2.5, pch=3)
             rect(point.coords$x[1], point.coords$y[1], point.coords$x[2], point.coords$y[2])
         }
     } else {
         plot(Object, xlim=Xlimits, ylim=Ylimits)
     }
     if (! is.null(coords)){
         svalue(StatBar) <- paste("x =",round(coords[1],2), "y =",round(coords[2],2), sep="   ")
     }
  }

  reset.plot <- function(h, ...) {
       point.coords$x <<- range(Object@RegionToFit$x) #set original X range
       point.coords$y <<- range(Object@RegionToFit$y) #set original Y range
       Object@Boundaries <<- point.coords
       Xlimits <<- point.coords$x
       Ylimits <<- sort(point.coords$y, decreasing=FALSE)
       Corners <- list(x=c(point.coords$x[1],point.coords$x[1],point.coords$x[2],point.coords$x[2]),
                       y=c(point.coords$y[1],point.coords$y[2],point.coords$y[1],point.coords$y[2]))
       replot()
  }

  ComponentMenu <- function(){
       FComp <<- 1
       delete(MCFrame3,MCGroup3)
       MCGroup3 <<- ggroup(spacing=3, horizontal=FALSE, container=MCFrame3)
       FitComplyt <<- glayout(spacing=5, container=MCGroup3)
       if (length(ComponentList) > 1){    #gradio works with at least 2 items
           FitComp <<- gradio(ComponentList, selected=1, handler = function(h,...){
                               FComp <<- svalue(FitComp)
                               cat("\n selected component:", FComp)
                               FComp <<- as.numeric(unlist(strsplit(FComp, split="C")))   #index selected component
                               FComp <<- FComp[2]
                               xx <- Object@Components[[FComp]]@param[2,1] #component position mu
                               Rng <- range(Object@RegionToFit$x)
                               if (xx < Rng[1]) {xx <- Rng[1]}
                               if (xx > Rng[2]) {xx <- Rng[2]}
                               yy <- Object@Components[[FComp]]@param[1,1] #component height h
                               FuncName <- Object@Components[[FComp]]@funcName
                               yy <- yy/GetHvalue(Object,FComp, FuncName, 1)  #provides the correct yy value for complex functions
                               Estep <- abs(Object@RegionToFit$x[1]-Object@RegionToFit$x[2])
                               Xindx <- which(Object@RegionToFit[[1]] > xx-Estep/2 & Object@RegionToFit[[1]] < xx+Estep/2)
                               yy <- yy+Object@Baseline$y[Xindx]  #spectral intensity + baseline at point xx
                               coords[1] <<- xx
                               coords[2] <<- yy
                               refresh <<- TRUE    #cancel previous selections
                               replot()   #plot spectrum without marker
                               refresh <<- FALSE #now plot also the component marker
                               replot()   #replot spectrum and marker
                               if (ShowMsg==TRUE){
                                   gmessage("Left click to enter Fit Component position. Right click to stop slection", title="WARNING", icon="warning")
                                   tcl("update", "idletasks") #closes the gmessage window
                               }
                               GetCurPos(SingClick=FALSE)
                           },  container = MCGroup3)
           LL <- length(ComponentList)
           NCol <- ceiling(LL/5)   #gradio will be split in solumns of 5 elements
           for(ii in 1:LL){
               tkpack.forget(FitComp$widgets[[ii]])  # unparent widgets (uses library call)
           }
           for(kk in 1:NCol){
               NN <- (kk-1)*5
               for (ii in 1:5) {
                    if((ii+NN) > LL) {break}
                    FitComplyt[ii,kk] <<- FitComp$widgets[[(ii+NN)]]
               }
           }
       }
       if (length(ComponentList) == 1){    #gradio works with at least 2 items
          FitComp <<- gcheckboxgroup(ComponentList, checked=TRUE, handler = function(h,...){
                               FComp <<- svalue(FitComp)
                               FComp <<- as.numeric(unlist(strsplit(FComp, split="C")))   #index selected compoent
                               FComp <<- FComp[2]
                               xx <- Object@Components[[FComp]]@param[2,1] #component position mu
                               Rng <- range(Object@RegionToFit[[1]])
                               if (xx < Rng[1]) {xx <- Rng[1]}
                               if (xx > Rng[2]) {xx <- Rng[2]}
                               Estep <- abs(Object@RegionToFit[[1]][1]-Object@RegionToFit[[1]][2])
                               Xindx <- which(Object@RegionToFit[[1]] > xx-Estep/2 & Object@RegionToFit[[1]] < xx+Estep/2)
                               yy <- yy+Object@Baseline$y[Xindx]  #spectral intensity + Baseline at point xx
                               coords[1] <<- xx
                               coords[2] <<- yy
                               refresh<<-TRUE    #cancel previous component markers
                               replot()   #plot spectrum only
                               refresh <<- FALSE #now plot spectrum + component marker
                               replot()
                               if (O.Sys == "linux"){ #in Linux locator is activated to read cursor positions
                                   if (ShowMsg==TRUE){
                                       gmessage("Left click to enter Fit Component position. Right click to stop slection", title="WARNING", icon="warning")
                                       tcl("update", "idletasks") #closes the gmessage window
                                   }
                                   GetCurPos(SingClick=FALSE)
                               }
                           },  container = MCGroup3)
       }
       txt <- paste("The selection of a Core-Line or Fit-Component always activates reading the [X,Y] cursor position.",
                    "\n=> Left click with the mouse to enter the cursor coordinates.",
                    "\n=> Right click to stop position selection and cursor position reading when not required.",
                    "\n",
                    "=> Do not show these WARNING messages again press YES, let WARNINGS active press NO", sep="")
       ShowMsg <<- !gconfirm(msg=txt, title="WARNING", icon="question", width=30) #ShowMsg==FALSE if answer=YES
       tcl("update", "idletasks") #closes the gmessage window
       GetCurPos(SingClick=FALSE)
  }

  LoadCoreLine <- function(){
      XPSSample <<- get(activeFName, envir=.GlobalEnv)       #load XPSdata values from main memory
      Indx <<- activeSpectIndx
      Object <<- XPSSample[[Indx]]
      Xlimits <<- range(Object@RegionToFit$x)
      Ylimits <<- range(Object@RegionToFit$y)
      Object@Boundaries$x <<- Xlimits
      Object@Boundaries$y <<- Ylimits
      point.coords$x <<- Xlimits #set original X range
      point.coords$y <<- Ylimits #set original Y range

      ComponentList <<- names(slot(Object,"Components"))
      if (length(ComponentList)==0) {
          gmessage("ATTENTION NO FIT FOUND: change coreline please!" , title = "WARNING",  icon = "warning")
          return()
      }
      xx <- Object@Components[[1]]@param[2,1] #component position mu
      yy <- Object@Components[[1]]@param[1,1] #component height h
      Estep <- abs(Object@RegionToFit[[1]][1]-Object@RegionToFit[[1]][2])
      Xindx <- which(Object@RegionToFit[[1]] > xx-Estep/2 & Object@RegionToFit[[1]] < xx+Estep/2)
      yy <- yy+Object@Baseline$y[Xindx]  #spectral intensity + baseline at point xx
      coords[1] <<- xx
      coords[2] <<- yy
      refresh <<- FALSE #now plot the component marker
      replot()   #replot spectrum and marker of selected fit component
      if (UpdateCompMenu == TRUE){ ComponentMenu() }
  }

  editFitFrame <- function(h,...){
      FComp <- svalue(FitComp)
      FComp <- as.integer(gsub("[^0-9]", "", FComp))   #index selected component
      fitParam <<- Object@Components[[FComp]]@param #load DataFrame relative to the selected component
      VarNames <- rownames(fitParam)
      idx <- grep("lg", VarNames)
      if(length(idx) > 0){VarNames[idx] <- "Mix.L.G"}
      idx <- grep("gv", VarNames)
      if(length(idx) > 0){VarNames[idx] <- "Mix.G.V"}
      fitParam <<- as.matrix(fitParam) #this is needed to construct correctly the data.frame
      fitParam <<- data.frame(cbind(VarNames,fitParam), stringsAsFactors=FALSE) #in the dataframe add a column with variable names
      newFitParam <<- fitParam
      Label=paste("C", FComp, "- COMPONENT FIT PARAMETERS")
      DFwin <- gwindow(title=Label, visible=FALSE) # open a window to edit the dataframe
      DFgroup <- ggroup(horizontal=FALSE, container=DFwin)       
      txt <- paste("Fit Function: ", Object@Components[[FComp]]@funcName, sep="")
      glabel(txt, container=DFgroup)
      DFrame <- gdf(items=fitParam, container=DFgroup)
      size(DFrame) <- c(550, 200) 
      tkconfigure(DFrame$widget, width=550, height=200)      
      addHandlerChanged(DFrame, handler=function(h,...){ #addHandlerChanged dowload the dataFrame with modified parameters in NewFirParam (global variable)
         newFitParam <<- h$obj[]
      })

      gbutton("     SAVE AND EXIT      ", handler=function(h,...){
                newFP <- lapply(newFitParam[,2:ncol(newFitParam)], function(x) {as.numeric(x)} ) #the dataframe contais strings
                fitParam <<- fitParam[,-1]   #remove labels introduced in the first column of the DataFrame
                fitParam[, 1:ncol(fitParam)] <<- newFP   #this operation preserves the class(fitParam)=data.base nneded to save parameters in the relative slot of XPSSSample
                Object@Components[[FComp]]@param <<- fitParam #save parameters in the slot of XPSSample
                XPSSample[[Indx]] <<- Object
                NComp <- length(Object@Components)
                tmp <- NULL
                for(ii in 1:NComp){
                    Object@Components[[ii]] <<- Ycomponent(Object@Components[[ii]], x=Object@RegionToFit$x, y=Object@Baseline$y)
	                   tmp <- cbind(tmp, Object@Components[[ii]]@ycoor)  #fit is the sum of fitting components
	                   Object@Fit$y <<- colSums(t(tmp)) - length(Object@Components)*(Object@Baseline$y) #substract NComp*Baseline
                }
                Object <<- sortComponents(Object)
                xx <- Object@Components[[FComp]]@param[2,1] #component position mu
                Rng <- range(Object@RegionToFit[[1]])
                if (xx < Rng[1]) {xx <- Rng[1]}
                if (xx > Rng[2]) {xx <- Rng[2]}
                yy <- Object@Components[[FComp]]@param[1,1] #component height h
                FuncName <- Object@Components[[FComp]]@funcName
                yy <- yy/GetHvalue(Object,FComp, FuncName, 1)  #provides the correct yy value for complex functions
                Estep <- abs(Object@RegionToFit[[1]][1]-Object@RegionToFit[[1]][2])
                Xindx <- which(Object@RegionToFit[[1]] > xx-Estep/2 & Object@RegionToFit[[1]] < xx+Estep/2)
                yy <- yy + Object@Baseline$y[Xindx]  #spectral intensity + baseline at point xx
                coords[1] <<- xx   #Marker coords
                coords[2] <<- yy
                assign(activeFName, XPSSample, envir = .GlobalEnv)
                dispose(DFwin)
                XPSSaveRetrieveBkp("save")
                replot()
                return()
             }, container = DFgroup)
      visible(DFwin) <- TRUE
  }

  reset.vars <- function(){
     XPSSample <<- get(activeFName, envir=.GlobalEnv)       #load XPSdata values from main memory
     Indx <<- 1
     assign("activeSpectIndx", 1, envir=.GlobalEnv)
     if(activeSpectIndx > length(XPSSample)) { Indx <<- 1 }
     OldXPSSample <<- XPSSample
     Object <<- XPSSample[[Indx]]
     SpectName <<- NULL
     ComponentList <<- names(Object@Components)
     FNameList <<- XPSFNameList()
     SpectList <<- XPSSpectList(activeFName)
     FComp <<- 1
     if (is.null(FitComp) == FALSE){
         delete(MCGroup3, FitComp)
     }
     UpdateCompMenu <<- TRUE     
     coords <<- c(xx=NA, yy=NA, yy_BasLin=NA)
     CompCoords <<- c(xx=NA, yy=NA, yy_BasLin=NA)

     refresh <<- TRUE
     SetZoom <<- FALSE
     NoFit <<- FALSE
     ShowMsg <<- TRUE
     WinSize <<- as.numeric(XPSSettings$General[4])
     hscale <<- hscale <- as.numeric(WinSize)

     if (length(ComponentList)==0) {
        gmessage("ATTENTION NO FIT FOUND: change coreline please!" , title = "WARNING",  icon = "warning")
        Xlimits <<- range(Object@.Data[1])
        Ylimits <<- range(Object@.Data[2])
        NoFit <<- TRUE
        return()
     }
  }


# --- Variable definitions ---
     XPSSample <- get(activeFName, envir=.GlobalEnv)       #load XPSdata values from main memory
     Indx <- activeSpectIndx
     if(activeSpectIndx > length(XPSSample)) { Indx <- 1 }
     OldXPSSample <- XPSSample
     Object <- XPSSample[[Indx]]
     SpectName <- NULL
     ComponentList <<- names(Object@Components)
     FNameList <- XPSFNameList()
     SpectList <- XPSSpectList(activeFName)
     FComp <- 1
     FitComp <- NULL
     UpdateCompMenu <- TRUE

     WinSize <- as.numeric(XPSSettings$General[4])
     hscale <- hscale <- as.numeric(WinSize)

     coords <- c(xx=NA, yy=NA, yy_BasLin=NA)
     CompCoords <- c(xx=NA, yy=NA, yy_BasLin=NA)
     xx <- NULL
     yy <- NULL

     refresh <- TRUE
     SetZoom <- FALSE
     NoFit <- FALSE
     ShowMsg <- TRUE
#Coreline boundaries
     if (length(ComponentList)==0) {
        gmessage("ATTENTION NO FIT FOUND: change coreline please!" , title = "WARNING",  icon = "warning")
        point.index <- 1
        point.coords <- list(x=range(Object@RegionToFit$x), #set the X window extension == x range
                             y=range(Object@RegionToFit$y)) #set the Y window extension == x range
        Xlimits <- range(Object@.Data[1])
        Ylimits <- range(Object@.Data[2])
        Object@Boundaries$x <- Xlimits
        Object@Boundaries$y <- Ylimits
        Corners <- list(x=NULL, y=NULL)
        NoFit <- TRUE
     } else {
        LL <- length(Object@.Data[[1]])
        point.index <- 1
        point.coords <- list(x=range(Object@RegionToFit$x), #set the X window extension == x range
                             y=range(Object@RegionToFit$y)) #set the Y window extension == x range
        Corners <- list(x=c(point.coords$x[1],point.coords$x[1],point.coords$x[2],point.coords$x[2]),
                        y=c(point.coords$y[1],point.coords$y[2],point.coords$y[1],point.coords$y[2]))
        Xlimits <- range(Object@RegionToFit$x)
        Ylimits <- range(Object@RegionToFit$y)
        Object@Boundaries$x <- Xlimits
        Object@Boundaries$y <- Ylimits
     }
     plot(Object)

     if (Check.PE() == FALSE) { return() }
     O.Sys <- unname(tolower(Sys.info()["sysname"]))

#--- GWidget definition ---
     MCWindow <- gwindow("XPS MOVE COMPONENT", parent=c(50,10), visible = FALSE)
     addHandlerDestroy(MCWindow, handler=function(h, ...){  #if MainWindow unproperly closed with X
                               EXIT <<- TRUE
                               XPSSettings$General[4] <<- 7      #Reset to normal graphic win dimension
                               assign("XPSSettings", XPSSettings, envir=.GlobalEnv)
                               plot(XPSSample[[Indx]])         #replot the CoreLine
                           })

#--- Selection Group ---
     SelectGroup <- ggroup(horizontal=FALSE, spacing = 5, container=MCWindow)

     MCGroup1 <- ggroup(horizontal=TRUE, spacing = 5, container=SelectGroup)
     MCFrame1 <- gframe(text = " XPS Samples ", container = MCGroup1)
     XPS.Sample <- gcombobox(FNameList, selected=-1, editable=FALSE, handler=function(h,...){
                               reset.vars()
                               ActFName <- svalue(XPS.Sample)
                               assign("activeFName", ActFName, envir=.GlobalEnv)
                               XPSSample <<- get(ActFName, envir=.GlobalEnv)
                               Indx <<- activeSpectIndx
                               if(activeSpectIndx > length(XPSSample)) { Indx <<- 1 }
                               Object <<- XPSSample[[Indx]]
                               SpectList <- XPSSpectList(activeFName)
                               delete(MCFrame1, Core.Lines)
                               Core.Lines <<- gcombobox(SpectList, selected=-1, editable=FALSE, handler=function(h,...){
                                                   XPS.CL <- svalue(Core.Lines)
                                                   XPS.CL <- unlist(strsplit(XPS.CL, "\\."))
                                                   Indx <<- as.integer(XPS.CL[1])               #select "NUMber." in component name
                                                   SpectName <<- XPS.CL[2]
                                                   Object <<- XPSSample[[Indx]]
                                                   ComponentList <<- names(Object@Components)
                                                   assign("activeSpectName", SpectName,envir=.GlobalEnv) #set activeSpectName == last selected spectrum
                                                   assign("activeSpectIndx", Indx,envir=.GlobalEnv) #set the activeIndex == last selected spectrum
                                                   point.index <<- 1
                                                   UpdateCompMenu <<- TRUE
                                                   LoadCoreLine()
                                                }, container = MCFrame1)
                               refresh <<- FALSE #now plot also the component marker
                               Xlimits <<- range(Object@RegionToFit$x)
                               Ylimits <<- range(Object@RegionToFit$y)
                               Object@Boundaries$x <<- Xlimits
                               Object@Boundaries$y <<- Ylimits
                               plot(Object)
                           }, container = MCFrame1)
     svalue(XPS.Sample) <- activeFName

     MCFrame2 <- gframe(text = " Core-Lines ", container = MCGroup1)
     Core.Lines <- gcombobox(SpectList, selected=-1, editable=FALSE, handler=function(h,...){
                               XPS.CL <- svalue(Core.Lines)
                               XPS.CL <- unlist(strsplit(XPS.CL, "\\."))
                               Indx <<- as.integer(XPS.CL[1])               #select "NUMber." in component name
                               SpectName <<- XPS.CL[2]
                               Object <<- XPSSample[[Indx]]
                               ComponentList <<- names(slot(Object,"Components"))
                               assign("activeSpectName", SpectName,envir=.GlobalEnv) #set activeSpectName == last selected spectrum
                               assign("activeSpectIndx", Indx,envir=.GlobalEnv) #set the activeIndex == last selected spectrum
                               point.index <<- 1
                               UpdateCompMenu <<- TRUE
                               LoadCoreLine()
                           }, container = MCFrame2)
     svalue(Core.Lines) <- SpectList[Indx]

     MCFrame3 <- gframe(text = " COMPONENTS ", spacing=5, container = SelectGroup)
     MCGroup3 <- ggroup(spacing=3, horizontal=FALSE, container=MCFrame3)
     FitComplyt <- glayout(spacing=5, container=MCGroup3)
     FitComplyt[1, 1] <- glabel("    ", container=FitComplyt)  #just to add a space in MCFrame3

     MCFrame4 <- gframe(text = " OPTIONS ", spacing=5, container = SelectGroup)
     Buttlyt <- glayout(spacing=5, container=MCFrame4)

     Buttlyt[1,1] <- LMFitbutton <- gbutton("          FIT Lev.Marq.        ", handler=function(h,...){
                               svalue(FitComp) <- -1
                               FComp <<- svalue(FitComp)
                               FComp <<- as.numeric(unlist(strsplit(FComp, split="C")))   #index selected component
                               FComp <<- FComp[2]
                               Object <<- XPSFitLM(Object, plt=FALSE)
                               xx <- Object@Components[[FComp]]@param[2,1] #component position mu
                               yy <- Object@Components[[FComp]]@param[1,1] #component height h
                               Estep <- abs(Object@RegionToFit[[1]][1]-Object@RegionToFit[[1]][2])
                               Xindx <- which(Object@RegionToFit[[1]] > xx-Estep/2 & Object@RegionToFit[[1]] < xx+Estep/2)
                               yy <- yy+Object@Baseline$y[Xindx]  #spectral intensity + Baseline at point xx
                               coords[1] <<- xx #coords of marker of the first fit component
                               coords[2] <<- yy
                               Object <<- sortComponents(Object)
                               refresh <<- FALSE  #now plot also the component marker
                               assign("Object", Object, envir = .GlobalEnv)
                               replot()
                           }, container = Buttlyt)

     Buttlyt[1,2] <- MFFitbutton <- gbutton("           FIT Modfit          ", handler=function(h,...){
                               svalue(FitComp) <- -1
                               if( is.na(match("FME", Pkgs)) == TRUE ){       #check if the package 'FME' is installed
                                  txt <- "Package 'FME' not installed. \nOption 'ModFit' not available"
                                  gmessage(msg=txt, title="WARNING", icon="error")
                                  return()
                               }
                               FComp <<- svalue(FitComp)
                               FComp <<- as.numeric(unlist(strsplit(FComp, split="C")))   #index selected component
                               FComp <<- FComp[2]
                               Object <<- XPSModFit(Object, plt=FALSE)
                               xx <- Object@Components[[FComp]]@param[2,1] #component position mu
                               yy <- Object@Components[[FComp]]@param[1,1] #component height h
                               Estep <- abs(Object@RegionToFit[[1]][1]-Object@RegionToFit[[1]][2])
                               Xindx <- which(Object@RegionToFit[[1]] > xx-Estep/2 & Object@RegionToFit[[1]] < xx+Estep/2)
                               yy <- yy+Object@Baseline$y[Xindx]  #spectral intensity + Baseline at point xx
                               coords[1] <<- xx
                               coords[2] <<- yy
                               Object <<- sortComponents(Object)
                               refresh <<- FALSE #now plot also the component marker
                               assign("Object", Object, envir = .GlobalEnv)
                               replot()
                           }, container = Buttlyt)

     Buttlyt[2,1] <- ZRbutton <- gbutton("         SET ZOOM REGION       ", handler = function(h, ...){
                               CompCoords <<- coords   #save the of position component_marker
                               point.coords <<- NULL   #point.coords contain the X, Y data ranges
                               enabled(LMFitbutton) <- FALSE
                               enabled(MFFitbutton) <- FALSE
                               enabled(RSTbutton) <- FALSE
                               SetZoom <<- TRUE
                               point.coords$x <<- range(Object@RegionToFit$x)
                               point.coords$y <<- range(Object@RegionToFit$y)
                               if (Object@Flags[1]) { #Binding energy set
                                   point.coords$x <<- sort(c(point.coords$x[1], point.coords$x[2]), decreasing=TRUE) #pos$x in decreasing order
                               }
                               Xlimits <<- point.coords$x
                               Ylimits <<- point.coords$y
                               Corners$x <<- c(point.coords$x[1],point.coords$x[1],point.coords$x[2],point.coords$x[2])
                               Corners$y <<- c(point.coords$y[1],point.coords$y[2],point.coords$y[1],point.coords$y[2])
                               Marker <<- list(Points=Corners, col=4, cex=1.2, lwd=2.5, pch=3)
                               point.index <<- 3 #plot initial zoom area
                               replot()
                               if (O.Sys == "windows"){
                                   msg <- paste("\n => Right click near corners to adjust Zoom Region Dimensions",
                                                "\n => When Zoom Region OK, press MAKE ZOOM", sep="")
                                   gmessage(msg, title="WARNING", icon="warning")
                               } else if (O.Sys == "linux"){
                                   msg <- paste("\n => Left click near corners to adjust Zoom Region Dimensions",
                                                "\n => When Zoom Region OK, right click and press  MAKE ZOOM", sep="")
                                   gmessage(msg, title="WARNING", icon="warning")
                                   tcl("update", "idletasks") #closes the gmessage window
                                   GetCurPos(SingClick=FALSE)
                               }
                           }, container = Buttlyt)

     Buttlyt[2,2] <- MZbutton <- gbutton("           MAKE ZOOM           ", handler = function(h, ...){
                               if (Object@Flags[1]) { #Binding energy set
                                  point.coords$x <- sort(point.coords$x, decreasing=TRUE) #pos$x in decreasing order
                                  point.coords$x[1] <- point.coords$x[1]
                                  point.coords$x[2] <- point.coords$x[2]
                               } else {
                                  point.coords$x<-sort(point.coords$x, decreasing=FALSE) #pos$x in increasing order
                                  point.coords$x[1] <- point.coords$x[1]
                                  point.coords$x[2] <- point.coords$x[2]
                               }
                               Xlimits <<- point.coords$x
                               Ylimits <<- sort(point.coords$y, decreasing=FALSE)
 	                             slot(Object,"Boundaries") <<- point.coords
 	                             point.index <<- 1
 	                             coords <<- CompCoords #restore of position component_marker
 	                             refresh <<- FALSE
                               SetZoom <<- FALSE
                               assign("Object", Object, envir = .GlobalEnv)
                               replot()
                               enabled(LMFitbutton) <- TRUE
                               enabled(MFFitbutton) <- TRUE
                               enabled(RSTbutton) <- TRUE
                          }, container = Buttlyt)

     Buttlyt[3,1] <- RSTbutton <- gbutton("           RESET PLOT          ", handler = function(h, ...) {
                               SetZoom <<- FALSE
                               refresh <<- FALSE
  	                            point.index <<- 1
  	                            reset.plot()
                          }, container = Buttlyt)

     Buttlyt[3,2] <- gbutton("              UNDO             ", handler = function(h, ...) {
                               FComp <<- svalue(FitComp)
                               FComp <<- as.numeric(unlist(strsplit(FComp, split="C")))   #index selected component
                               FComp <<- FComp[2]
                               XPSSample <<- OldXPSSample
                               Object <<- XPSSample[[Indx]]
                               xx <- Object@Components[[FComp]]@param[2,1] #component position mu
                               yy <- Object@Components[[FComp]]@param[1,1] #component height h
                               Estep <- abs(Object@RegionToFit[[1]][1]-Object@RegionToFit[[1]][2])
                               Xindx <- which(Object@RegionToFit[[1]] > xx-Estep/2 & Object@RegionToFit[[1]] < xx+Estep/2)
                               yy <- yy+Object@Baseline$y[Xindx]  #spectral intensity + Baseline at point xx
                               coords[1] <<- xx
                               coords[2] <<- yy
                               replot()
                          }, container = Buttlyt)

     Buttlyt[4,1] <- gbutton("        EDIT PARAMETERS        ", handler=editFitFrame, container = Buttlyt)

     Buttlyt[4,2] <- gbutton("          RE-LOAD DATA         ", handler=function(h,...){
                               svalue(FitComp) <- -1
                               UpdateCompMenu <<- FALSE
                               LoadCoreLine()
                               svalue(FitComp, index=TRUE) <- 1
                               OldXPSSample <<- XPSSample
                          }, container = Buttlyt)

     Buttlyt[5,1] <- gbutton("              SAVE             ", handler=function(h,...){
#    With button SAVE the Component parameters are updated and are now available for FiTConstraints
                               svalue(FitComp) <- -1
                               Indx <- get("activeSpectIndx", envir=.GlobalEnv)
                               XPSSample[[Indx]] <<- Object
                               OldXPSSample[[Indx]] <<- XPSSample[[Indx]]
                               assign("Object", XPSSample[[Indx]], envir = .GlobalEnv)
                               assign(activeFName, XPSSample, envir = .GlobalEnv)
                               replot()
                               XPSSaveRetrieveBkp("save")
                          }, container = Buttlyt)

     Buttlyt[5,2] <- gbutton("               EXIT            ", handler=function(h,...){
#-----            stopping mouse handler
                               dispose(MCWindow)    #Disposing MCWindow will activate GDestroyHandler which re-opens the graphic window
                               XPSSample <- get(activeFName, envir=.GlobalEnv) #Update XPSSample with all changes before plotting
                               XPSSaveRetrieveBkp("save")
                               plot(XPSSample[[Indx]])         #replot the CoreLine
                          }, container = Buttlyt)

     StatBar <- gstatusbar("status", container = MCWindow)

#--- Marker-----
     if (NoFit==FALSE){
        coords[1] <- Object@Components[[1]]@param[2,1] #component position mu
        coords[2] <- Object@Components[[1]]@param[1,1] #component1 height h
        FuncName <- Object@Components[[1]]@funcName
        coords[2] <- coords[2]/GetHvalue(Object,1, FuncName, 1)
        Estep <- abs(Object@RegionToFit[[1]][1]-Object@RegionToFit[[1]][2])
        Xindx <- which(Object@RegionToFit[[1]] > coords[1]-Estep/2 & Object@RegionToFit[[1]] < coords[1]+Estep/2) #indice del vettore X corrispondente alla posizione della componente
        coords[2] <- coords[2]+Object@Baseline$y[Xindx]
        refresh <- FALSE
        replot()
        refresh <- TRUE
     }

     enabled(LMFitbutton) <- TRUE
     enabled(MFFitbutton) <- TRUE
     enabled(RSTbutton) <- TRUE
     visible(MCWindow) <- TRUE
     tkevent.generate(MCWindow$widget, "<Expose>", when="now") #forces the MCWindow to be exposed
     tcl("update", "idletasks") #Complete the idle tasks

#--- Interactive mouse control ---
     if (length(ComponentList) > 0) {
         ComponentMenu()
     }
}
GSperanza/RxpsG_2.3-1 documentation built on Feb. 11, 2024, 5:09 p.m.