[Stacomir-commits] r372 - pkg/stacomir/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jun 4 08:38:45 CEST 2017
Author: briand
Date: 2017-06-04 08:38:44 +0200 (Sun, 04 Jun 2017)
New Revision: 372
Modified:
pkg/stacomir/R/RefDC.r
pkg/stacomir/R/RefStades.r
pkg/stacomir/R/RefTaxon.r
pkg/stacomir/R/Refpar.r
Log:
Fixed bug for interface
In choixmult methods, the page in the notebook is destroyed according to it's relative position, not it's absolute; This allows to add more pages in the widget at the beginning e.g. in BilanMigrationCar
Modified: pkg/stacomir/R/RefDC.r
===================================================================
--- pkg/stacomir/R/RefDC.r 2017-06-04 06:36:09 UTC (rev 371)
+++ pkg/stacomir/R/RefDC.r 2017-06-04 06:38:44 UTC (rev 372)
@@ -195,9 +195,10 @@
# as I can't get the name from within the function (deparse(substitute(objectBilan does not return
# "bilanMigrationMult"
assign(get("objectBilan",envir=envir_stacomi),objectBilan,envir=envir_stacomi)
- # suppresses all tab larger than 1 (dc)
- if (length(notebook)>2){
- for (i in 3:length(notebook)){
+ # suppresses all tab larger than (dc)
+ currenttab<-svalue(notebook)
+ if (length(notebook)>currenttab){
+ for (i in length(notebook):(currenttab+1)){
svalue(notebook) <- i
dispose(notebook) ## dispose current tab
}}
@@ -263,7 +264,7 @@
} else {
funout(gettext("Error : no counting device in the database (the query returns 0 entry)\n",domain="R-stacomiR"),arret=TRUE)
}
- return(object)
+ #return(object)
})
Modified: pkg/stacomir/R/RefStades.r
===================================================================
--- pkg/stacomir/R/RefStades.r 2017-06-04 06:36:09 UTC (rev 371)
+++ pkg/stacomir/R/RefStades.r 2017-06-04 06:38:44 UTC (rev 372)
@@ -170,13 +170,13 @@
objectBilan at stades<-object
assign(get("objectBilan",envir=envir_stacomi),objectBilan,envir=envir_stacomi)
- # suppresses all tab larger than 3 (stage))
- if (length(notebook)>4){
- for (i in 5:length(notebook)){
+ # suppresses all tab larger than current tab
+ currenttab<-svalue(notebook)
+ if (length(notebook)>currenttab){
+ for (i in length(notebook):(currenttab+1)){
svalue(notebook) <- i
dispose(notebook) ## dispose current tab
- }
- }
+ }}
# par defaut la methode ne charge pas de maniere interactive (par exemple en ne prenant que les stades des taxon du dc par la methode charge_avec_filtre
# elle est alors affichee des le debut par la methode choice e laquelle on ne passe pas d'objectBilan en parametre
#il y a bien un object par dans l'object Bilan
Modified: pkg/stacomir/R/RefTaxon.r
===================================================================
--- pkg/stacomir/R/RefTaxon.r 2017-06-04 06:36:09 UTC (rev 371)
+++ pkg/stacomir/R/RefTaxon.r 2017-06-04 06:38:44 UTC (rev 372)
@@ -124,15 +124,16 @@
objectBilan at stades<-charge_avec_filtre(object=objectBilan at stades,
dc_selectionne=get("refDC",envir_stacomi)@dc_selectionne,
taxon_selectionne=get("refTaxon",envir_stacomi)@data$tax_code
- )
+ )
assign(get("objectBilan",envir=envir_stacomi),objectBilan,envir=envir_stacomi)
# suppresses all tab larger than 3 (taxon)
- if (length(notebook)>3){
- for (i in 4:length(notebook)){
+ # suppresses all tab larger than (dc)
+ currenttab<-svalue(notebook)
+ if (length(notebook)>currenttab){
+ for (i in length(notebook):(currenttab+1)){
svalue(notebook) <- i
dispose(notebook) ## dispose current tab
- }
- }
+ }}
choicemult(objectBilan at stades,objectBilan,is.enabled=TRUE)
}
# changing tab of notebook to next tab
Modified: pkg/stacomir/R/Refpar.r
===================================================================
--- pkg/stacomir/R/Refpar.r 2017-06-04 06:36:09 UTC (rev 371)
+++ pkg/stacomir/R/Refpar.r 2017-06-04 06:38:44 UTC (rev 372)
@@ -159,7 +159,100 @@
if (any(!concord)){
warning(paste(gettextf("No data for par %s",object at par_selectionne[!concord],domain="R-stacomiR")))
}
-
+
assign("refpar",object,envir=envir_stacomi)
return(object)
- })
\ No newline at end of file
+ })
+
+
+#' Multiple Choice method for RefPar referential objects
+#'
+#' @param object An object of class \link{RefPar-class}
+#' @param objectBilan An object Bilan which includes the \link{RefPar-class}, default NULL
+#' @param is.enabled Sets if the frame is enabled at launch, defaut TRUE
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @examples
+#' \dontrun{
+#' object=new("Refpar")
+#' win=gwindow()
+#' group=ggroup(container=win,horizontal=FALSE)
+#' object<-charge(object)
+#' bilanMigrationCar=new("BilanMigrationCar")
+#' objectBilan=bilan_taille # for other test
+#' choicemult(object,objectBilan=bilanMigrationCar)
+#' }
+setMethod("choicemult",signature=signature("Refpar"),definition=function(object,objectBilan=NULL,is.enabled=TRUE) {
+
+ if (nrow(object at data) > 0){
+ hpar=function(h,...){
+ parm=tbdestpar[,][tbdestpar[,]!=""]
+ object at data<-object at data[car_libelle%in%parm ,]
+ assign("refPar",object,envir_stacomi)
+ funout(gettext("Parameter selected\n",domain="R-stacomiR"))
+ if (!is.null(objectBilan)) {
+ objectBilan at parm<-object
+ assign(get("objectBilan",envir=envir_stacomi),objectBilan,envir=envir_stacomi)
+ # suppresses all tab larger than current tab
+ currenttab<-svalue(notebook)
+ if (length(notebook)>currenttab){
+ for (i in length(notebook):(currenttab+1)){
+ svalue(notebook) <- i
+ dispose(notebook) ## dispose current tab
+ }}
+ if (svalue(notebook)<length(notebook)){
+ svalue(notebook)<-svalue(notebook)+1
+ }
+ }
+ }
+ # below the widget structure [=> within (=> type
+ # group(ggroup)[notebook(notebook)[groupstd(ggroup&tab)[[framestdsource(gframe)[tbsourcestd(gtable)],framestddest(gframe)[tbdeststd(gtable)]],OKbutton]]
+ if (!exists("notebook")) notebook <- gnotebook(container=group)
+ car_libelle=fun_char_spe(object at data$par_nom)
+ car_libelle[nchar(car_libelle)>30]<-paste(substr(car_libelle[nchar(car_libelle)>30],1,30),".",sep="")
+ grouppar<-ggroup()
+ assign("gouppar",grouppar,envir=.GlobalEnv)
+ add(notebook,grouppar,label=gettext("Sample characteritic",domain="R-stacomiR"))
+ frameparsource<-gframe(gettext("Select here",domain="R-stacomiR"),container=grouppar)
+ tbsourcepar = gtable(car_libelle,container=frameparsource,expand = TRUE, fill = TRUE)
+ size(tbsourcepar)<-c(160,300)
+ framepardest<-gframe(gettext("drop here",domain="R-stacomiR"),container=grouppar)
+ # need for a fixed size data.frame otherwise errors when adding new lines
+ xx<-data.frame(choice=rep("",8))
+ xx$choice<-as.character(xx$choice)
+ tbdestpar=gtable(xx,container=framepardest,expand = TRUE, fill = TRUE)
+ size(tbdestpar)<-c(160,300)
+ adddropsource(tbsourcepar)
+ adddroptarget(tbdestpar)
+ adddropmotion(tbdestpar,handler=function(h,...) {
+ valeurs<-tbdestpar[,]
+ valeurs<-valeurs[valeurs!=""]
+ if (!svalue(tbsourcepar)%in%valeurs){
+ tbdestpar[length(valeurs)+1,1]<-svalue(tbsourcepar)
+ }
+ })
+ addHandlerDoubleclick(tbsourcepar,handler=function(h,...) {
+ valeurs<-tbdestpar[,]
+ valeurs<-valeurs[valeurs!=""]
+ if (!svalue(tbsourcepar)%in%valeurs){
+ tbdestpar[length(valeurs)+1,1]<-svalue(h$obj)
+ }
+ })
+ adddropsource(tbdestpar)
+ adddroptarget(tbsourcepar)
+ removepar<-function(){
+ valeurs<-tbdestpar[,]
+ valeurs<-valeurs[valeurs!=""]
+ valeurs<-valeurs[-match(svalue(tbdestpar),valeurs)]
+ tbdestpar[,]<-c(valeurs,rep("",8-length(valeurs)))
+ }
+ adddropmotion(tbsourcepar,handler=function(h,...) {
+ removepar()
+ })
+ addHandlerDoubleclick(tbdestpar,handler=function(h,...) {
+ removepar()
+ })
+ gbutton("OK", container = grouppar, handler = hpar)
+ } else {
+ funout(gettext("Error : no counting device in the database (the query returns 0 entry)\n",domain="R-stacomiR"),arret=TRUE)
+ }
+ })
More information about the Stacomir-commits
mailing list