source: tol/tolbaseBLT/lib/byswidget/bsersel/bsersel.tcl @ be261c8

1941-docker-image-to-testdevel
Last change on this file since be261c8 was 56ade3b, checked in by Jorge Pérez <josp.jorge@…>, 10 years ago

fixes #1932, se ha creado la rama trunk/tolbaseBLT copia de trunk/tolbase

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7330 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 51.5 KB
Line 
1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : bsersel.tcl
3# PURPOSE : This file
4#/////////////////////////////////////////////////////////////////////////////
5
6# Requiere funciones de acceso a archivo .ini ::iniFile::*
7# Ver test al final del archivo
8package require snit
9package require Tk
10package require BLT
11package require byscommon
12
13
14#/////////////////////////////////////////////////////////////////////////////
15::snit::type bsersel {
16#
17# PURPOSE: Defincición de las funcionalidades de un
18#
19#/////////////////////////////////////////////////////////////////////////////
20
21#
22#/////////////////////////////////////////////////////////////////////////////
23  delegate option * to hull
24
25  option -project   {} ;# Nombre del proyecto
26  option -inientry  {} ;# Entrada en el .ini
27  option -def       {} ;# Nombre del cjto TOL con la definicion del algebra
28 
29  variable tmp     ;# Valores temporales de los elementos seleccionados
30    # para selUni.numBaj  - tmp($mag,$dim,$sDi)      <-- $val
31    # para selMul.numBaj  - tmp($mag,$dim,$sDi,$val) <-- 0|1
32    # para selUni.numAlt  - método get de bselectfields tmp($mag,$dim,$sDi)
33    # para selMul.numAlt  - método get de beditselector tmp($mag,$dim,$sDi)
34
35  variable alg     ;# Meta información del álgebra
36    # alg(TCL,<key>)                    - Valor de clave TCL $-key
37    # alg(Mag,-cod,$mag)                - Codigo de magnitud
38    # alg(Mag,-nam,$mag)                - Nombre de magnitud
39    # alg(Mag,-des,$mag)                - Descripcion de magnitud
40    # alg(Mag,TCL,<key>,$mag)           - Valor de clave TCL $-key
41    # alg(Dim,$mag,-cod,$dim)           - Codigo de dimension
42    # alg(Dim,$mag,-nam,$dim)           - Nombre de dimension
43    # alg(Dim,$mag,-des,$dim)           - Descripcion de dimension
44    # alg(Dim,$mag,-req,$dim)           - Si la dimension es requirida o no
45    # alg(Dim,$mag,TCL,<key>,$dim)      - Valor de clave TCL $-key
46    # alg(sDi,$mag,$dim,-cod,$sDi)      - Codigo de subdimension
47    # alg(sDi,$mag,$dim,-nam,$sDi)      - Nombre de subdimension
48    # alg(sDi,$mag,$dim,-des,$sDi)      - Descripcion de subdimension
49    # alg(sDi,$mag,$dim,-req,$sDi)      - Si la subdimension es requerida o no
50    # alg(sDi,$mag,$dim,-typ,$sDi)      - Tipo de la subdimension
51    # alg(sDi,$mag,$dim,-dex,$sDi)      - Lista dependencias existenciales
52    # alg(sDi,$mag,$dim,-hie,$sDi)      - Lista de valores jerárquicos
53    # alg(sDi,$mag,$dim,-dva,$sDi)      - Lista dependencias de valor
54    # alg(sDi,$mag,$dim,TCL,<key>,$sDi) - Valor de clave TCL $-key
55
56  variable data    ;# Diversas informaciones
57    # data(iniEntry)      - entrada en el archivo .ini para options
58    # data(project)       - Nombre del proyecto
59
60  variable options ;# Opciones que se guardan en archivo .ini
61    # options(wform)      - ancho porcentual del formulario de selección
62    # options(wlist)      - ancho porcentual de la lista de series
63
64  variable algwid  ;# Rutas de widgets del algebra creados
65    # algwid($mag,$dim,$sDi) - frame interno de cada subdimension
66
67  variable widget  ;# Rutas de widgets generales creados
68    # widget(tl)          - toplevel donde se crea el selector de series
69    # widget(tabset)      - tabset que separa el selector por magnitudes
70    # widget(panel,form)  - panel del formulario de seleccion de series
71    # widget(panel,list)  - panel del la lista de series
72    # widget(output)      - listbox con la selección de series
73
74  #///////////////////////////////////////////////////////////////////////////
75  constructor { args } {
76  #
77  # PURPOSE: bsersel constructor
78  #
79  # PARAMETERS:
80  #   args -> options
81  #
82  #///////////////////////////////////////////////////////////////////////////
83    # Apply all options passed at creation time.
84    $self configurelist $args
85    set data(project)  [$self cget -project]
86    set data(iniEntry) [$self cget -inientry]
87    set data(alreadytriggering) 0
88    $self _readini
89  }
90
91  #///////////////////////////////////////////////////////////////////////////
92  #
93  # PURPOSE: Metodos cget y configure
94  #
95  #///////////////////////////////////////////////////////////////////////////
96
97
98  # delegacion de metodos y opciones
99  delegate method * to hull
100  delegate option * to hull
101
102  #///////////////////////////////////////////////////////////////////////////
103  method _init {} {
104  #
105  # PURPOSE: Inicializa el array alg con la informacion del algebra
106  #
107  #///////////////////////////////////////////////////////////////////////////
108    set def [$self cget -def]
109
110    #Información general
111    set nRes [GetUniqueName Text _GuiAlgDim]
112    set cmd "Text $nRes = GuiAlgGetDef($def);"
113    ::tol::console eval $cmd
114    array set info [TclInfoVar Text $nRes]
115    eval "set lstDefTcl $info(CONTENT)"
116    ::tol::console stack release $nRes
117    foreach {key value} $lstDefTcl {
118      set alg(TCL,$key) $value
119    }
120
121    # Obtener magnitudes
122    set cmd "Text $nRes = GuiAlgGetMag($def);"
123    ::tol::console eval $cmd
124    array set info [TclInfoVar Text $nRes]
125    eval "set lstMag $info(CONTENT)"
126    ::tol::console stack release $nRes
127    set idxMag 0
128    foreach mag $lstMag {
129      # Guardar magnitud
130      set codMag [lindex $mag 0]
131      set alg(Mag,-idx,$codMag) $idxMag
132      set alg(Mag,-cod,$codMag) $codMag
133      set alg(Mag,-nam,$codMag) [lindex $mag 1]
134      set alg(Mag,-des,$codMag) [lindex $mag 2]
135      #Info TCL
136      set cmd "Text $nRes = GuiAlgGetMagTclSet(\"$codMag\",$def);"
137      ::tol::console eval $cmd
138      array set info [TclInfoVar Text $nRes]
139      eval "set lstMagTcl $info(CONTENT)"
140      ::tol::console stack release $nRes
141      foreach {key value} $lstMagTcl {
142        set alg(Mag,TCL,$key,$codMag) $value
143      }
144      #Obtener dimensiones
145      set nRes [GetUniqueName Text _GuiAlgDim]
146      set cmd "Text $nRes =  GuiAlgGetDim(\"$codMag\",$def);"
147      ::tol::console eval $cmd
148      array set info [TclInfoVar Text $nRes]
149      eval "set lstDim $info(CONTENT)"
150      ::tol::console stack release $nRes
151      set idxDim 0
152      foreach dim $lstDim {
153        # Guardar dimension
154        set codDim [lindex $dim 0]
155        set alg(Dim,$codMag,-idx,$codDim) $idxDim
156        set alg(Dim,$codMag,-cod,$codDim) $codDim
157        set alg(Dim,$codMag,-nam,$codDim) [lindex $dim 1]
158        set alg(Dim,$codMag,-des,$codDim) [lindex $dim 2]
159        set alg(Dim,$codMag,-req,$codDim) [lindex $dim 3]
160        #Info TCL
161        set cmd "Text $nRes = \
162          GuiAlgGetNodeTclSet(\"$codMag\",\"$codDim\",\"\",$def);"
163        ::tol::console eval $cmd
164        array set info [TclInfoVar Text $nRes]
165        eval "set lstDimTcl $info(CONTENT)"
166        ::tol::console stack release $nRes
167        foreach {key value} $lstDimTcl {
168          set alg(Dim,$codMag,TCL,$key,$codDim) $value
169        }
170        # Obtener subdimensiones
171        set nRes [GetUniqueName Text _GuiAlgDim]
172        set cmd "Text $nRes = \
173          GuiAlgGetSubDim(\"$codMag\",\"$codDim\",$def);"
174        ::tol::console eval $cmd
175        array set info [TclInfoVar Text $nRes]
176        eval "set lstSubDim $info(CONTENT)"
177        ::tol::console stack release $nRes
178        set idxSDi 0
179        foreach sDi $lstSubDim {
180          # Guardar subdimension
181          set codSDi [lindex $sDi 0]
182          set alg(sDi,$codMag,$codDim,-idx,$codSDi) $idxSDi
183          set alg(sDi,$codMag,$codDim,-cod,$codSDi) $codSDi
184          set alg(sDi,$codMag,$codDim,-nam,$codSDi) [lindex $sDi 1]
185          set alg(sDi,$codMag,$codDim,-des,$codSDi) [lindex $sDi 2]
186          set alg(sDi,$codMag,$codDim,-req,$codSDi) [lindex $sDi 3]
187          set alg(sDi,$codMag,$codDim,-typ,$codSDi) [lindex $sDi 4]
188          # Dimensiones que dependen existencialmente de la subdimension
189          set cmd "Text $nRes = \
190            GuiAlgGetExiDepSubDim(\"$codMag\",\"$codDim\",\"$codSDi\",$def);"
191          ::tol::console eval $cmd
192          array set infExi [TclInfoVar Text $nRes]
193          eval "set lstSubDimExi $infExi(CONTENT)"
194          ::tol::console stack release $nRes
195#Tolcon_Trace "$codDim $codSDi $lstSubDimExi"
196          set alg(sDi,$codMag,$codDim,-dex,$codSDi) $lstSubDimExi
197          # Subdimensiones que dependen por valor de la subdimension
198          set cmd "Text $nRes = \
199            GuiAlgGetValDepSubDim(\"$codMag\",\"$codDim\",\"$codSDi\",$def);"
200          ::tol::console eval $cmd
201          array set infVal [TclInfoVar Text $nRes]
202          eval "set lstSubDimVal $infVal(CONTENT)"
203          ::tol::console stack release $nRes
204#Tolcon_Trace "$codDim $codSDi $lstSubDimVal"
205          set alg(sDi,$codMag,$codDim,-dva,$codSDi) $lstSubDimVal
206          #Info TCL
207          set cmd "Text $nRes = \
208            GuiAlgGetNodeTclSet(\"$codMag\",\"$codDim\",\"$codSDi\",$def);"
209          ::tol::console eval $cmd
210          array set info [TclInfoVar Text $nRes]
211          eval "set lstSubDimTcl $info(CONTENT)"
212          ::tol::console stack release $nRes
213          foreach {key value} $lstSubDimTcl {
214            set alg(sDi,$codMag,$codDim,TCL,$key,$codSDi) $value
215          }
216          incr idxSDi
217        }
218        incr idxDim
219      }
220      incr idxMag
221    }
222    #parray alg   
223  }
224
225  #///////////////////////////////////////////////////////////////////////////
226  method _getMag {} {
227  #
228  # PURPOSE: Gets list of magnitud
229  #
230  # PARAMETERS:
231  #
232  #///////////////////////////////////////////////////////////////////////////
233    regsub -all Mag,-cod,\
234      [array names ${selfns}::alg Mag,-cod,*] "" lstMag
235    set lst ""
236    foreach mag $lstMag {
237      lappend lst [list $mag $alg(Mag,-idx,$mag)]
238    }
239    set lstOrd [lsort -integer -index 1 $lst]
240    set lstFin ""
241    foreach reg $lstOrd {
242      lappend lstFin [lindex $reg 0]
243    }
244    return $lstFin
245  }
246
247  #///////////////////////////////////////////////////////////////////////////
248  method _getDim {mag} {
249  #
250  # PURPOSE: Gets list of dimensions of a given magnitud in order of creation
251  #
252  # PARAMETERS:
253  #   mag -> Magnitud
254  #
255  #///////////////////////////////////////////////////////////////////////////
256    regsub -all Dim,$mag,-cod,\
257      [array names ${selfns}::alg Dim,$mag,-cod,*] "" lstDim
258    set lst ""
259    foreach dim $lstDim {
260      lappend lst [list $dim $alg(Dim,$mag,-idx,$dim)]
261    }
262    set lstOrd [lsort -integer -index 1 $lst]
263    set lstFin ""
264    foreach reg $lstOrd {
265      lappend lstFin [lindex $reg 0]
266    }
267    return $lstFin
268  }
269
270  #///////////////////////////////////////////////////////////////////////////
271  method _getSubDim {mag dim} {
272  #
273  # PURPOSE: Gets list of subdimension of a given dimension in order of
274  #          creation
275  #
276  # PARAMETERS:
277  #   mag -> Magnitud
278  #   dim -> Dimension
279  #
280  #///////////////////////////////////////////////////////////////////////////
281    regsub -all sDi,$mag,$dim,-cod, \
282      [array names ${selfns}::alg sDi,$mag,$dim,-cod,*] "" lstSDi
283    set lst ""
284    foreach sDi $lstSDi {
285      lappend lst [list $sDi $alg(sDi,$mag,$dim,-idx,$sDi)]
286    }
287    set lstOrd [lsort -integer -index 1 $lst]
288    set lstFin ""
289    foreach reg $lstOrd {
290      lappend lstFin [lindex $reg 0]
291    }
292    return $lstFin
293  }
294
295  #///////////////////////////////////////////////////////////////////////////
296  method create {tl } {
297  #
298  # PURPOSE: Creates a Windows with series selector and series list.
299  #          Actually creates a tab for each magnitud
300  #
301  # PARAMETERS:
302  #
303  #///////////////////////////////////////////////////////////////////////////
304    global toltk_options
305    # Inicilaizamos alg
306    $self _init
307
308    set widget(tl) $tl
309    set w [lindex [split $tl .] end]
310    option add *TitleFrame.ipad             2 user
311    option add *$w*Radiobutton.padY         0 user
312    option add *$w*Radiobutton.borderWidth  0 user
313    option add *$w*Checkbutton.padY         0 user
314    option add *$w*Checkbutton.borderWidth  0 user
315    option add *$w*Checkbutton.font {Arial 8} user
316    option add *$w*Radiobutton.font {Arial 8} user
317 
318    set pw [PanedWindow $tl.pw -side bottom -pad 0]
319    set widget(panel,form) [set pane1 [$pw add -weight $options(wform)]]
320    set widget(panel,list) [set pane2 [$pw add -weight $options(wlist)]]
321
322    # Lista de series
323    set flis [$self _createlist $pane2]
324    set bbox [$self _createbbox $pane2]
325    grid $bbox -column 0 -row 0 -sticky news
326    grid $flis -column 1 -row 0 -sticky news
327    grid columnconfigure $pane2 1 -weight 1
328    grid rowconfigure    $pane2 0 -weight 1
329 
330    # Selectores de series
331    set widget(tabset) [set w_tabset [::blt::tabset $pane1.ts -relief flat \
332              -highlightthickness 0 -bd 0 -outerpad 0 -tier 2 -slant right \
333              -textside right -selectcommand [list $self _changeMag]]]
334 
335    # lista de magnitudes
336    foreach mag [$self _getMag] {
337      $w_tabset insert end $mag
338      set w     [frame $w_tabset.f${mag}]
339      $w_tabset tab configure $mag \
340         -text $alg(Mag,-nam,$mag) -window $w -fill both  \
341         -font $toltk_options(fonts,Title1) -ipady 3
342      DynamicHelp::add $w -text $alg(Mag,-des,$mag)
343      $self _createMag $w $mag
344    }
345    grid $w_tabset   -sticky news
346    grid columnconfigure $pane1 0 -weight 1
347    grid rowconfigure    $pane1 0 -weight 1
348    pack $pw -expand true -fill both
349    $self _changeMag
350    # Establecemos la magnitud por defecto (primera)
351    # TODO: Podia ser la ultima en que se dejo el selector de series
352    #$self _changeMag
353  }
354  #///////////////////////////////////////////////////////////////////////////
355  method _triggerMag {mag} {
356  #
357  # PURPOSE: Trigger all subdimensions in magnitud which other subdimensions
358  #          depend on
359  # PARAMETERS:
360  #   mag -> magnitud
361#set cmd "Text WriteLn(\"Lanzando trigger -> mag:$mag,dim:$dim,subdim:$sDi\");"
362#set cmd "Real 1;"
363#::tol::console eval $cmd
364  #///////////////////////////////////////////////////////////////////////////
365    set max 0
366    foreach it [$self _getDim $mag] {
367        set max $max+1
368    }
369    set localtrig 0
370    if { !$data(alreadytriggering) } {
371        set data(alreadytriggering) 1
372        set localtrig 1
373        Tolcon_Trace "cargando --> $mag"
374        . configure -cursor watch
375        ::progressbar::Show [mc "loading"] 60 2
376        ::progressbar::SetText [mc "Getting Values"]
377    }
378    set iterador 0
379
380    variable alreadyTriggered
381    foreach dim [$self _getDim $mag] {
382      #::TolInspector::Busy
383      set lstSubDim [$self _getSubDim $mag $dim]
384      foreach sDi $lstSubDim {
385        if {![info exist alreadyTriggered($dim,$sDi)]} {
386           set type [$self _getSubDimType $mag $dim $sDi]
387           if { $type eq "uni.dir" || $type eq "uni.ind" || $type eq "uni.dat" } {
388             $self _trigger $mag $dim $sDi
389           }
390           foreach reg $alg(sDi,$mag,$dim,-dva,$sDi) {
391               set dimDep [lindex $reg 0]
392               set sDiDep [lindex $reg 1]
393               set alreadyTriggered($dimDep,$sDiDep) 1
394           }
395           set alreadyTriggered($dim,$sDi) 1
396        }
397      }
398      set iterador [expr $iterador+1]
399      ::progressbar::Set [expr $iterador * 100 / ($max)]
400    }
401    array unset alreadyTriggered
402    if { $localtrig } {
403        Tolcon_Trace "terminando --> $mag"
404      set data(alreadytriggering) 0
405      ::progressbar::Destroy
406      . configure -cursor ""
407    }
408 
409
410  }
411
412  #///////////////////////////////////////////////////////////////////////////
413  method _changeMag {} {
414  #///////////////////////////////////////////////////////////////////////////
415    set magSel [$widget(tabset) get focus]
416    $self _triggerMag $magSel
417  }
418
419  #///////////////////////////////////////////////////////////////////////////
420  proc _configure {f cols idx} {
421  #
422  # PURPOSE: Configures row and column weight for a given frame suposed it
423  #          has been grid as a matrix in $cols cols and last element index
424  #          is $idx.
425  # PARAMETERS:
426  #   f    -> widget to configure
427  #   idx  -> index of last element of matrix
428  #   cols -> number of columns of matrix
429  #///////////////////////////////////////////////////////////////////////////
430    set rows [_getRows $cols $idx]
431    for {set i 0} {$i < $rows} {incr i} {
432      grid rowconfigure    $f $i -weight 1
433    }
434    for {set j 0} {$j < $cols} {incr j} {
435      grid columnconfigure $f $j -weight 1
436    }
437  }
438
439  #///////////////////////////////////////////////////////////////////////////
440  proc _getRows {cols idx} {
441  #///////////////////////////////////////////////////////////////////////////
442    if {[expr $idx%$cols] eq 0} {
443      set rows [expr ($idx/$cols)]
444    } else {
445      set rows [expr ($idx/$cols)+1]
446    }
447    return $rows
448  }
449
450  #///////////////////////////////////////////////////////////////////////////
451  method _createMag {w mag} {
452  #
453  # PURPOSE: Fills the tab of a given magnitud
454  # PARAMETERS:
455  #   w   -> path
456  #   mag -> magnitud
457  #///////////////////////////////////////////////////////////////////////////
458  #Tolcon_Trace "_createMag: w=$w, mag=$mag"
459
460    if [info exist ${selfns}::alg(Mag,TCL,-cols,$mag)] {
461      set cols $alg(Mag,TCL,-cols,$mag)
462    } else {
463      set cols 2
464    }
465    set idx 0
466    foreach dim [$self _getDim $mag] {
467      set tf [$self _createDim $w $mag $dim]
468      grid $tf -row [expr $idx/$cols] -column [expr $idx%$cols] -sticky news
469      incr idx
470    }
471   
472    #Configuro columnas y filas de magnitud
473    _configure $w $cols $idx
474  }
475
476
477  #///////////////////////////////////////////////////////////////////////////
478  method _createDim {w mag dim} {
479  #
480  # PURPOSE: Creates a title frame for a given dimension and calls to create
481  #          subdimensions
482  # PARAMETERS:
483  #   w   -> path
484  #   mag -> magnitud
485  #   dim -> dimension
486  #///////////////////////////////////////////////////////////////////////////
487  #Tolcon_Trace "_createDim: mag=$mag dim=$dim"
488
489    set dimPat [string tolower $dim]
490    set tf [TitleFrame $w.$dimPat -text $alg(Dim,$mag,-nam,$dim) -bd 1 \
491              -side center -fg blue -font {Verdana 9 bold}]
492    set f [$tf getframe]
493   
494    DynamicHelp::add $tf -text $alg(Dim,$mag,-des,$dim)
495
496    set lstSubDim [$self _getSubDim $mag $dim]
497    if [info exist ${selfns}::alg(Dim,$mag,TCL,-cols,$dim)] {
498      set cols $alg(Dim,$mag,TCL,-cols,$dim)
499    } else {
500      set cols [llength $lstSubDim]
501    }
502
503    set idx 0
504    foreach sDi $lstSubDim {
505      set tfs [$self _createSubDim $f $mag $dim $sDi]
506      grid $tfs -row [expr $idx/$cols] -column [expr $idx%$cols] -sticky news
507      incr idx
508
509    }
510    #Configuro columnas y filas de dimension
511    _configure $f $cols $idx
512    return $tf
513  }
514
515  #///////////////////////////////////////////////////////////////////////////
516  method _createSubDim {w mag dim sDi} {
517  #
518  # PURPOSE: Creates a title frame for a given subdimension and fills it with
519  #          enabled values
520  # PARAMETERS:
521  #   w   -> path
522  #   mag -> magnitud
523  #   dim -> dimension
524  #   sDi -> subdimension
525  #///////////////////////////////////////////////////////////////////////////
526  #Tolcon_Trace "_createSubDim: mag=$mag dim=$dim sDi=$sDi"
527
528    set sDiPat [string tolower $sDi]
529    set tf [TitleFrame $w.$sDiPat -text $alg(sDi,$mag,$dim,-nam,$sDi) -bd 1]
530    set f [$tf getframe]
531    set algwid($mag,$dim,$sDi) $f
532    DynamicHelp::add $tf -text $alg(sDi,$mag,$dim,-des,$sDi)
533    $self _fillSubDim $mag $dim $sDi
534
535    return $tf
536  }
537
538  #/////////////////////////////////////////////////////////////////////////////
539  method _fillSubDim {mag dim sDi} {
540  #
541  # PURPOSE: Fills subdimension frame for a subdimension
542  # PARAMETERS:
543  #   mag -> magnitud identifier
544  #   dim -> dimension identifier
545  #   sDi -> subdimension identifier
546  #/////////////////////////////////////////////////////////////////////////////
547    #Tolcon_Trace "_fillSubDim mag=$mag, dim=$dim, sDi=$sDi"
548    set type [$self _getSubDimType $mag $dim $sDi]
549    switch -- $type {
550       "uni.dir" { $self _fillSubDimUniDir $mag $dim $sDi }
551       "uni.ind" { $self _fillSubDimUniInd $mag $dim $sDi }
552       "mul.dir" { $self _fillSubDimMulDir $mag $dim $sDi }
553       "mul.lib" { $self _fillSubDimMulInd $mag $dim $sDi 0}
554       "mul.ind" { $self _fillSubDimMulInd $mag $dim $sDi }
555       "uni.dat" { $self _fillSubDimDat $mag $dim $sDi 1}
556       "mul.dat" { $self _fillSubDimDat $mag $dim $sDi 0}
557       "uni.hie" { $self _fillSubDimHie $mag $dim $sDi 1}
558       "mul.hie" { $self _fillSubDimHie $mag $dim $sDi 0}
559    }
560    #Tolcon_Trace "subDim: $mag $dim $sDi es de tipo $type"
561  }
562
563 
564#/////////////////////////////////////////////////////////////////////////////
565method _findcode {idcoltab cod} {
566#
567# PURPOSE: Find a value in the column col of tview and returns its index
568# PARAMETERS:
569#   idcoltab -> list of pairs id, cod
570#   val      -> value to find
571#/////////////////////////////////////////////////////////////////////////////
572  foreach pair $idcoltab {
573    if {[lindex $pair 1] eq $cod} {
574      return [lindex $pair 0]
575    }
576  }
577  return -1
578}
579
580#/////////////////////////////////////////////////////////////////////////////
581method _fillSubDimHie {mag dim sDi trigger} {
582#
583# PURPOSE: Fills subdimension frame for a subdimension marked as hierarchical
584# PARAMETERS:
585#   mag -> magnitud identifier
586#   dim -> dimension identifier
587#   sDi -> subdimension identifier
588#   trigger -> 0/1 trigger event for dependants?
589#   multisel -> 0/1 allows multiselection
590#/////////////////////////////////////////////////////////////////////////////
591
592  set w $algwid($mag,$dim,$sDi)
593  set lstReg [$self _getSubDimValues $mag $dim $sDi]
594  set defval [$self _getSubDimDefValue $mag $dim $sDi]
595
596  set valCont 0
597  #if $multisel { set icosel 0 } else { set icosel 1 }
598# -bonselcmd [list $self _trigger $mag $dim $sDi] \
599# Si no existe crearlo
600  if {![info exist ${selfns}::tmp($mag,$dim,$sDi)]} {
601    ScrolledWindow $w.sw${sDi}
602    if {$trigger} {
603      set tmp($mag,$dim,$sDi) [ btreeview $w.sw${sDi}.tv \
604        -bonselcmd [list $self _trigger $mag $dim $sDi] \
605                    -btogglehier false \
606        -height 150 -linewidth 2 -borderwidth 1 \
607        -bmultiselect false -bicosel false ]
608    } else {
609      set tmp($mag,$dim,$sDi) [ btreeview $w.sw${sDi}.tv \
610        -btogglehier false \
611        -height 150 -linewidth 2 -borderwidth 1 \
612        -bmultiselect true -bicosel true ]
613    }
614    $tmp($mag,$dim,$sDi) bColumnInsert end cod -hide true
615    $w.sw${sDi} setwidget $w.sw${sDi}.tv
616    grid $w.sw${sDi} -sticky news
617    #grid $w.sw${sDi}.tv  -row 0 -column 0 -sticky new
618 
619    grid columnconfigure $w 0 -weight 1
620    grid rowconfigure    $w 0 -weight 1
621  }
622  # Insertar los valores
623  # Crear elementos nuevos
624  #set idx 0
625  $tmp($mag,$dim,$sDi) delete root
626  set alg(sDi,$mag,$dim,-hie,$sDi) ""
627  set plotted 0
628  set iteration 0
629  set regidx 0
630  set plottedreg ""
631  set numels [expr [llength $lstReg] ]
632   
633  while { ($plotted < $numels) && ($iteration < $numels) } {
634    foreach reg $lstReg {
635      set ide [lindex $reg 0]
636      set abr [lindex $reg 1]
637      set nom [lindex $reg 2]
638      set des [lindex $reg 3]
639      set par [lindex $reg 4]
640      set lev [lindex $reg 5]
641      if {$iteration eq 0} { lappend plottedreg 0 }
642      if { $abr eq $defval } {
643        set mark ON
644      } else {
645        set mark OFF
646      }
647      set isplotted [lindex $plottedreg $regidx]
648      #puts "Processing iteration $iteration regidx $regidx plotted $plotted plottedreg -> $plottedreg \");"
649      if { $isplotted eq 0 } {
650        set infCols [ list cod $abr ]
651        if {$par ne ""} {
652          set paridx [$self _findcode $alg(sDi,$mag,$dim,-hie,$sDi) $par]
653          if { $paridx >= 0 } {
654            set plottedreg [ lreplace $plottedreg $regidx $regidx 1 ]
655            set plotted [expr $plotted+1]
656            set idx [ $tmp($mag,$dim,$sDi) insertNode $paridx 0 $mark $abr $nom $infCols ]
657              lappend alg(sDi,$mag,$dim,-hie,$sDi) [list $idx $abr]
658          }
659        } else {
660          set plottedreg [ lreplace $plottedreg $regidx $regidx 1 ]
661          set plotted [expr $plotted+1]
662          set idx [ $tmp($mag,$dim,$sDi) insertNode root 0 $mark $abr $nom $infCols ]
663          lappend alg(sDi,$mag,$dim,-hie,$sDi) [list $idx $abr]
664        }
665      }
666      set regidx [expr $regidx+1]
667    }
668    set regidx 0
669    set iteration [expr $iteration + 1]
670  }
671}
672 
673#/////////////////////////////////////////////////////////////////////////////
674method _fillSubDimDat {mag dim sDi trigger} {
675#
676# PURPOSE: Fills subdimension frame for a subdimension marked as returning a
677#          date data type
678# PARAMETERS:
679#   mag -> magnitud identifier
680#   dim -> dimension identifier
681#   sDi -> subdimension identifier
682#/////////////////////////////////////////////////////////////////////////////
683#Tolcon_Trace "_fillSubDimDat mag=$mag dim=$dim, sDi=$sDi"
684  set w $algwid($mag,$dim,$sDi)
685  set lstReg [$self _getSubDimValues $mag $dim $sDi]
686  set defval [$self _getSubDimDefValue $mag $dim $sDi]
687  set defFound 0
688  set valCont 0
689
690  if {[llength $lstReg]} {
691    foreach reg $lstReg {
692      lappend lstRegMod [linsert [lrange $reg 1 end] end [lindex $reg 0]]
693      set valCont [expr $valCont+1]
694      if {$defval eq [lindex $reg 1]} {
695           set defFound $valCont
696      }
697    }
698  } else {
699    set lstRegMod ""
700  }
701  # Si no existe crearlo
702  if {![info exist ${selfns}::tmp($mag,$dim,$sDi)]} {
703    label $w.l${sDi} -text [mc $sDi]
704      if {$trigger} {
705          set tmp($mag,$dim,$sDi) [ bentrydate $w.bsf${sDi} \
706             -postcommand [list $self _trigger $mag $dim $sDi] ]
707      } else {
708          set tmp($mag,$dim,$sDi) [bentrydate $w.bsf${sDi} ]
709      }
710
711   
712    grid $w.l${sDi}    -row 0 -column 0 -sticky ne
713    grid $w.bsf${sDi}  -row 0 -column 1 -sticky new
714 
715    grid columnconfigure $w 1 -weight 1
716    grid rowconfigure    $w 0 -weight 1
717  }
718  puts $defval
719  # Insertar los valores
720  $tmp($mag,$dim,$sDi) configure -bdate $defval
721
722#  if {$defval ne ""} {
723#     if {$defFound eq 1} {
724#        $tmp($mag,$dim,$sDi) selectIndex $defFound
725#     }
726#  }
727
728}
729
730  #/////////////////////////////////////////////////////////////////////////////
731  method _fillSubDimUniDir {mag dim sDi} {
732  #
733  # PURPOSE: Fills subdimension frame for a subdimension with 'unique'
734  #          selection type and 'direct' show method (radiobuttons)
735  # PARAMETERS:
736  #   mag -> magnitud identifier
737  #   dim -> dimension identifier
738  #   sDi -> subdimension identifier
739  #/////////////////////////////////////////////////////////////////////////////
740  #Tolcon_Trace "_fillSubDimUniDir mag=$mag dim=$dim, sDi=$sDi"
741    set w $algwid($mag,$dim,$sDi)
742    set lstReg [$self _getSubDimValues $mag $dim $sDi]
743
744    if [info exist ${selfns}::alg(sDi,$mag,$dim,TCL,-cols,$sDi)] {
745      set cols $alg(sDi,$mag,$dim,TCL,-cols,$sDi)
746    } else {
747      set cols 1
748    }
749
750    # Eliminar elementos anteriores y eliminar configure padre
751    set idx 0
752    foreach f [winfo child $w] {
753      destroy $f
754      incr idx
755    }
756    grid columnconfigure $w $cols                 -weight 0
757    grid rowconfigure    $w [_getRows $cols $idx] -weight 0
758
759    # Crear elementos nuevos
760    set idx 0
761    set defval [$self _getSubDimDefValue $mag $dim $sDi]
762
763    foreach reg $lstReg {
764      set ide [lindex $reg 0]
765      set abr [lindex $reg 1]
766      set nom [lindex $reg 2]
767      set des [lindex $reg 3]
768      set wid rb$abr
769      radiobutton $w.$wid -text $nom -value $abr \
770         -variable ${selfns}::tmp($mag,$dim,$sDi)
771      if {$abr eq $defval} {
772        $w.$wid select
773      }
774      DynamicHelp::add $w.$wid -text [mc $des]
775      grid $w.$wid -row [expr $idx/$cols] -column [expr $idx%$cols] -sticky nws
776      incr idx
777    }
778    if {$idx ne 0} {
779      trace variable ${selfns}::tmp($mag,$dim,$sDi) \
780        w [list $self _trigger $mag $dim $sDi]
781    }
782    grid columnconfigure $w $cols                  -weight 1
783    grid rowconfigure    $w [_getRows $cols $idx]  -weight 1
784  }
785
786  #/////////////////////////////////////////////////////////////////////////////
787  method _fillSubDimUniInd {mag dim sDi} {
788  #
789  # PURPOSE: Fills subdimension frame for a subdimension with 'unique'
790  #          selection type and 'indirect' show method (bselectfields)
791  # PARAMETERS:
792  #   mag -> magnitud identifier
793  #   dim -> dimension identifier
794  #   sDi -> subdimension identifier
795  #/////////////////////////////////////////////////////////////////////////////
796  #Tolcon_Trace "_fillSubDimUniInd mag=$mag dim=$dim, sDi=$sDi"
797    set w $algwid($mag,$dim,$sDi)
798    set lstReg [$self _getSubDimValues $mag $dim $sDi]
799    set defval [$self _getSubDimDefValue $mag $dim $sDi]
800    set defFound 0
801    set valCont 0
802
803    if {[llength $lstReg]} {
804      foreach reg $lstReg {
805        lappend lstRegMod [linsert [lrange $reg 1 end] end [lindex $reg 0]]
806        set valCont [expr $valCont+1]
807        if {$defval eq [lindex $reg 1]} {
808          set defFound $valCont
809        }
810      }
811    } else {
812      set lstRegMod ""
813    }
814    # Si no existe crearlo
815    if {![info exist ${selfns}::tmp($mag,$dim,$sDi)]} {
816      label $w.l${sDi} -text [mc $sDi]
817      set tmp($mag,$dim,$sDi) [bcomboboxplus $w.bsf${sDi} \
818        -modifycmd [list $self _trigger $mag $dim $sDi] \
819        -cols    [list [mc Code] [mc Name] [mc Description] [mc Id]] \
820        -hiddencols    [list [mc Description] [mc Id]] \
821        -nrows 6 \
822        -widthlb 600 \
823        -font {Arial 8}]
824     
825      grid $w.l${sDi}    -row 0 -column 0 -sticky ne
826      grid $w.bsf${sDi}  -row 0 -column 1 -sticky new
827   
828      grid columnconfigure $w 1 -weight 1
829      grid rowconfigure    $w 0 -weight 1
830    }
831    # Insertar los valores
832    $tmp($mag,$dim,$sDi) clear
833    foreach item $lstRegMod {
834      $tmp($mag,$dim,$sDi) insert end $item
835    }
836
837    if {$defval ne ""} {
838       if {$defFound ne 0} {
839          $tmp($mag,$dim,$sDi) selectIndex $defFound
840       }
841    }
842
843  }
844
845  #/////////////////////////////////////////////////////////////////////////////
846  method _fillSubDimMulDir {mag dim sDi} {
847  #
848  # PURPOSE: Fills subdimension frame for a subdimension with 'multiple'
849  #          selection type and 'direct' show method (checkbuttons)
850  # PARAMETERS:
851  #   mag -> magnitud identifier
852  #   dim -> dimension identifier
853  #   sDi -> subdimension identifier
854  #/////////////////////////////////////////////////////////////////////////////
855  #Tolcon_Trace "_fillSubDimMulDir mag=$mag dim=$dim, sDi=$sDi"
856
857    set w $algwid($mag,$dim,$sDi)
858    set lstReg [$self _getSubDimValues $mag $dim $sDi]
859    if [info exist ${selfns}::alg(sDi,$mag,$dim,TCL,-cols,$sDi)] {
860      set cols $alg(sDi,$mag,$dim,TCL,-cols,$sDi)
861    } else {
862      set cols 3
863    }
864#set cmd "Text WriteLn(\"Llamada a testar (before) -> mag:$mag,dim:$dim,subdim:$sDi \");"
865#::tol::console eval $cmd
866
867    # Eliminar elementos anteriores y eleminar configure padre
868    set idx 0
869    foreach f [winfo child $w] {
870      set abr [string range [lindex [split $f .] end] 2 end]
871      set tmp($mag,$dim,$sDi,$abr) 0
872      destroy $f
873      incr idx
874    }
875    grid columnconfigure $w $cols                 -weight 0
876    grid rowconfigure    $w [_getRows $cols $idx] -weight 0
877    # Crear elementos nuevos
878    set idx 0
879    set defval [$self _getSubDimDefValue $mag $dim $sDi]
880    foreach reg $lstReg {
881      set ide [lindex $reg 0]
882      set abr [lindex $reg 1]
883      set nom [lindex $reg 2]
884      set des [lindex $reg 3]
885      set wid ch$abr
886      checkbutton $w.$wid -text $nom -onvalue $abr \
887         -variable ${selfns}::tmp($mag,$dim,$sDi,$abr)
888
889      if {$abr eq $defval} {
890        $w.$wid select
891      }
892      DynamicHelp::add $w.$wid -text [mc $des]
893      grid $w.$wid -row [expr $idx/$cols] -column [expr $idx%$cols] -sticky nw
894      incr idx
895    }
896    grid columnconfigure $w $cols                 -weight 1
897    grid rowconfigure    $w [_getRows $cols $idx] -weight 1
898  }
899
900  #/////////////////////////////////////////////////////////////////////////////
901  method _fillSubDimMulInd {mag dim sDi {readonly 1}} {
902  #
903  # PURPOSE: Fills subdimension frame for a subdimension with 'multiple'
904  #          selection type and 'indirect' show method (beditselector)
905  # PARAMETERS:
906  #   mag -> magnitud identifier
907  #   dim -> dimension identifier
908  #   sDi -> subdimension identifier
909  #   readonly  -> indica si es editable o no
910  #/////////////////////////////////////////////////////////////////////////////
911  #Tolcon_Trace "_fillSubDimMulInd mag=$mag dim=$dim, sDi=$sDi"
912    set w $algwid($mag,$dim,$sDi)
913    set lstReg [$self _getSubDimValues $mag $dim $sDi]
914    set defval [$self _getSubDimDefValue $mag $dim $sDi]
915    set defFound 0
916    set longitud [llength $lstReg]
917    if {[llength $lstReg]} {
918      foreach reg $lstReg {
919        set lstValues [linsert [lrange $reg 1 end] end [lindex $reg 0]]
920        lappend lstRegMod $lstValues
921        set val [lindex $reg 1]
922        if {$defval eq $val} {
923             set defFound $lstValues
924        }
925      }
926    } else {
927      set lstRegMod ""
928    }
929    # si no existe crearlo
930    if {![info exist ${selfns}::tmp($mag,$dim,$sDi)]} {
931      set tmp($mag,$dim,$sDi) [beditselector $w.bes${sDi} -width 25\
932        -label [mc $sDi] -readonly $readonly  -font {Arial 8}\
933        -entcols [list [mc Code] [mc Name]] -msgeometry 1000x500+40+10\
934        -hlpcols [list [mc Code] [mc Name] [mc Description]]\
935        -cols    [list [mc Code] [mc Name] [mc Description] [mc Id]] ]
936      grid $w.bes${sDi}  -row 0 -column 0 -sticky new
937
938      grid columnconfigure $w 0 -weight 1
939      grid rowconfigure    $w 0 -weight 1
940    }
941    # Insertar los valores
942    $tmp($mag,$dim,$sDi) configure -list $lstRegMod -sel ""
943
944    if {$defval ne ""} {
945       if {$defFound ne 0} {
946          $tmp($mag,$dim,$sDi) configure -sel  [list $defFound]
947       }
948    }
949  }
950
951  #/////////////////////////////////////////////////////////////////////////////
952  method _trigger {mag dim sDi args} {
953  #
954  # PURPOSE: Method called when a 'unique' selection type subdimension changes
955  #          its selection, then other subdimensions values may change and
956  #          other dimensions existence may change.
957  # PARAMETERS:
958  #   mag   -> magntitud
959  #   dim   -> dimension
960  #   sDi   -> subdimension
961  #   args  -> rest of arguments (not used)
962  #/////////////////////////////////////////////////////////////////////////////
963    set localtrig 0
964    if { !$data(alreadytriggering) } {
965         set data(alreadytriggering) 1
966      set localtrig 1
967      . configure -cursor watch
968    }
969    #Tolcon_Trace "********** Launching _trigger $mag $dim $sDi"
970     
971    set def [$self cget -def]
972
973    foreach reg $alg(sDi,$mag,$dim,-dva,$sDi) {
974      set dimDep [lindex $reg 0]
975      set sDiDep [lindex $reg 1]
976      $self _fillSubDim $mag $dimDep $sDiDep
977    }
978    if { $localtrig } {
979        set data(alreadytriggering) 0
980        . configure -cursor ""
981      }
982     
983  }
984
985  #/////////////////////////////////////////////////////////////////////////////
986  method _getSubDimValues {mag dim sDi} {
987  #
988  # PURPOSE: Get allowed values of a subdimension
989  # PARAMETERS:
990  #   mag -> magnitud identifier
991  #   dim -> dimension identifier
992  #   sDi -> subdimension identifier
993  #/////////////////////////////////////////////////////////////////////////////
994  #Tolcon_Trace "_getSumDimValues mag=$mag, dim=$dim, sDi=$sDi"
995    set res [$self _getSelection]
996
997    set cmd [TclLst2TolSet $res -level 2]
998    set sSet [StringReplace $cmd "SetOfText" "AlgNodeSt"]
999
1000    set def    [$self cget -def]
1001    set nRes [GetUniqueName Text _GuiAlgDim]
1002    set cmd "Text $nRes = \
1003      GuiAlgGetSubDimVal(\"$mag\",\"$dim\",\"$sDi\",$sSet,$def);"
1004    ::tol::console eval ${cmd}
1005    array set info [TclInfoVar Text $nRes]
1006    eval "set lstSubDimVal $info(CONTENT)"
1007    ::tol::console stack release $nRes
1008    #Tolcon_Trace "\ncmd=$cmd \n lstSubDimVal = $lstSubDimVal"
1009    return $lstSubDimVal
1010  }
1011
1012  #/////////////////////////////////////////////////////////////////////////////
1013  method _getSubDimDefValue {mag dim sDi} {
1014  #
1015  # PURPOSE: Get default value of a subdimension
1016  # PARAMETERS:
1017  #   mag -> magnitud identifier
1018  #   dim -> dimension identifier
1019  #   sDi -> subdimension identifier
1020  #/////////////////////////////////////////////////////////////////////////////
1021    #Tolcon_Trace "_getSumDimValues mag=$mag, dim=$dim, sDi=$sDi"
1022    set res [$self _getSelection]
1023       
1024    set cmd [TclLst2TolSet $res -level 2]
1025    set sSet [StringReplace $cmd "SetOfText" "AlgNodeSt"]
1026       
1027    set def    [$self cget -def]
1028    set nRes [GetUniqueName Text _GuiAlgDim]
1029    set cmd "Text $nRes = \
1030            GuiAlgGetSubDimDefVal(\"$mag\",\"$dim\",\"$sDi\",$sSet,$def);"
1031    ::tol::console eval ${cmd}
1032    array set info [TclInfoVar Text $nRes]
1033    eval "set lstSubDimVal $info(CONTENT)"
1034    ::tol::console stack release $nRes
1035    #Tolcon_Trace "\ncmd=$cmd \n lstSubDimVal = $lstSubDimVal"
1036    return $lstSubDimVal
1037  }
1038   
1039  #/////////////////////////////////////////////////////////////////////////////
1040  method _getSubDimType {mag dim sDi} {
1041  #
1042  # PURPOSE: Returns type of a subdimension
1043  # PARAMETERS:
1044  #   mag -> magnitud
1045  #   dim -> dimension
1046  #   sDi -> subdimension
1047  #/////////////////////////////////////////////////////////////////////////////
1048    set nDeEx [llength $alg(sDi,$mag,$dim,-dex,$sDi)]
1049    set nDeVa [llength $alg(sDi,$mag,$dim,-dva,$sDi)]
1050   
1051    if {[expr $nDeEx + $nDeVa] eq 0} {
1052      set car "mul"
1053    } else {
1054      set car "uni"
1055    }
1056    if [info exist ${selfns}::alg(sDi,$mag,$dim,TCL,-type,$sDi)] {
1057      set met [string tolower $alg(sDi,$mag,$dim,TCL,-type,$sDi)]
1058      if { ($met ne "hie") && ($met ne "dir") && ($met ne "dat") && ($met ne "lib")} {
1059        set met "ind"
1060      }
1061    } else {
1062      set met "ind"
1063    }
1064    set typ ${car}.${met}
1065
1066    return $typ
1067  }
1068
1069  #/////////////////////////////////////////////////////////////////////////////
1070  method _getSelection {} {
1071  #
1072  # PURPOSE: Returns a names list corresponding to selection of actual tab
1073  #
1074  #/////////////////////////////////////////////////////////////////////////////
1075    set res ""
1076    set magSel [$widget(tabset) get focus]
1077
1078    # lista de magnitudes
1079    foreach mag [$self _getMag] {
1080      if {$magSel eq $mag} {
1081        set res [$self _getSelMag $mag]
1082      }
1083    }
1084    return $res
1085  }
1086
1087  #/////////////////////////////////////////////////////////////////////////////
1088  method _checkMag {mag} {
1089  #
1090  # PURPOSE: Checks if all requiered dimensions and subdimensions are choosen
1091  #
1092  # PARAMETERS:
1093  #   mag -> magnitud identifier
1094  #
1095  #/////////////////////////////////////////////////////////////////////////////
1096    set res 1
1097    foreach dim [$self _getDim $mag] {
1098      foreach sDi [$self _getSubDim $mag $dim] {
1099        set sDiLst  [$self _getSelSubDim $mag $dim $sDi]
1100        set type [$self _getSubDimType $mag $dim $sDi]
1101        if {$res && ($alg(sDi,$mag,$dim,-req,$sDi) eq 1) && \
1102            ( $type ne "uni.dat" && $type ne "mul.dat" ) && ([llength $sDiLst] eq 0)} {
1103          set msg [mc "Must fill subdimension %1\$s of dimension %2\$s" \
1104             $alg(sDi,$mag,$dim,-nam,$sDi) $alg(Dim,$mag,-nam,$dim)]
1105          tk_messageBox -message $msg -title [mc "Required fields"]
1106          set res 0
1107        }
1108      }
1109    }
1110    return $res
1111  }
1112
1113  #/////////////////////////////////////////////////////////////////////////////
1114  method _getSelMag {mag} {
1115  #
1116  # PURPOSE: Returns a names list corresponding to selection of a given magnitud
1117  #
1118  # PARAMETERS:
1119  #   mag -> magnitud identifier
1120  #
1121  #/////////////////////////////////////////////////////////////////////////////
1122    set res ""
1123    foreach dim [$self _getDim $mag] {
1124      foreach sDi [$self _getSubDim $mag $dim] {
1125        set sDiLst  [$self _getSelSubDim $mag $dim $sDi]
1126        foreach sDiRes $sDiLst {
1127          lappend res $sDiRes
1128        }
1129      }
1130    }
1131    #Tolcon_Trace "MAG: $mag     --> $res"
1132    return $res
1133  }
1134
1135  #/////////////////////////////////////////////////////////////////////////////
1136  method _getSelMagAsName {mag} {
1137  #
1138  # PURPOSE: Returns a names list corresponding to selection of a given magnitud
1139  #          as a valid name
1140  #
1141  # PARAMETERS:
1142  #   mag -> magnitud identifier
1143  #
1144  #/////////////////////////////////////////////////////////////////////////////
1145    set lstDimf ""
1146    if {[$self _checkMag $mag]} {
1147      set lstDim [$self _getDim $mag]
1148      set cmd [$self _getSelMag_ lstDimf $mag [lindex $lstDim 0] $lstDim]
1149      #Tolcon_Trace "\n$cmd\n"
1150      eval $cmd
1151    }
1152    return $lstDimf
1153  }
1154
1155  #/////////////////////////////////////////////////////////////////////////////
1156  method _getSelMag_ {var mag dim lstDim} {
1157  #
1158  # PURPOSE: Returns the TCL script that when its evaluated returns the algebra
1159  #          names relative to a given magnitud Its returned in var variable.
1160  # PARAMETERS:
1161  #   var -> name of TCL variable that will contain the list of magnitud names
1162  #   mag -> magnitud identifier
1163  #   dim -> dimension identifier
1164  #   lstDim -> list of dimensions of given magnitud To iterate
1165  #
1166  #/////////////////////////////////////////////////////////////////////////////
1167  #Tolcon_Trace "_getSelMag var=$var mag=$mag dim=$dim lstDim=$lstDim"
1168    set txt ""
1169    set idx [lsearch $lstDim $dim]
1170    set spa [string repeat " " [expr 2*$idx]]
1171    if {$dim eq [lindex $lstDim end]} {
1172      set txt \
1173"${spa}foreach $dim [list [$self _getSelDim $mag $dim]] {
1174${spa}  lappend $var ${mag}_[ListToStr $lstDim $alg(TCL,-dimSep) {[lindex $}    { 0]}]
1175${spa}}"
1176    } else {
1177      set txt \
1178"${spa}foreach $dim [list [$self _getSelDim $mag $dim]] {
1179[$self _getSelMag_ $var $mag [lindex $lstDim [expr $idx+1]] $lstDim]
1180${spa}}"
1181    }
1182    Tolcon_Trace "\n$txt\n"
1183    return $txt
1184  }
1185
1186
1187  #/////////////////////////////////////////////////////////////////////////////
1188  method _getSelDim {mag dim} {
1189  #/////////////////////////////////////////////////////////////////////////////
1190    set lstSD [$self _getSubDim $mag $dim]
1191    set cmd [$self _getSelDim_ lstSDf $mag $dim [lindex $lstSD 0] $lstSD]
1192    set lstSDf ""
1193    eval $cmd
1194    return $lstSDf
1195  }
1196
1197
1198  #/////////////////////////////////////////////////////////////////////////////
1199  method _getSelDim_ {var mag dim sDi lstSDi} {
1200  #
1201  # PURPOSE: Returns the TCL script that when its evaluated returns the algebra
1202  #          names relative to a given dimension. Its returned in var variable.
1203  # PARAMETERS:
1204  #   var -> name of TCL variable that will contain the list of dimension names
1205  #   mag -> magnitud identifier
1206  #   dim -> dimension identifier
1207  #   sDi -> subdimension identifier
1208  #   lstSDi -> list of subdimensions of given dimension. To iterate
1209  #
1210  #/////////////////////////////////////////////////////////////////////////////
1211  #Tolcon_Trace "_getSelDim_ var=$var mag=$mag dim=$dim sDi=$sDi, lstSDi=$lstSDi"
1212    set txt ""
1213    set idx [lsearch $lstSDi $sDi]
1214    set spa [string repeat " " [expr 2*$idx]]
1215
1216    set dimTxt [string range $dim 0 [expr $alg(TCL,-numCarDim)-1]]
1217    if {$sDi eq [lindex $lstSDi end]} {
1218      set txt \
1219"${spa}foreach $sDi [list [$self _getSelSubDim $mag $dim $sDi]] {
1220${spa}  lappend $var ${dimTxt}[ListToStr $lstSDi $alg(TCL,-sDiSep) {[lindex $}    { 2]}]
1221${spa}}"
1222    } else {
1223      set txt \
1224"${spa}foreach $sDi [list [$self _getSelSubDim $mag $dim $sDi]] {
1225[$self _getSelDim_ $var $mag $dim [lindex $lstSDi [expr $idx+1]] $lstSDi]
1226${spa}}"
1227    }
1228    Tolcon_Trace "\n$txt\n"
1229    return $txt
1230  }
1231
1232  #/////////////////////////////////////////////////////////////////////////////
1233  method _getSelSubDim {mag dim sDi} {
1234  #
1235  # PURPOSE: Returns a names list corresponding to a given subdimension
1236  # PARAMETERS:
1237  #   mag -> magnitud identifier
1238  #   dim -> dimension identifier
1239  #   sDi -> subdimension identifier
1240  #
1241  #/////////////////////////////////////////////////////////////////////////////
1242#Tolcon_Trace "Obteniendo subdimension: $mag $dim $sDi"
1243    set lst ""
1244    set type [$self _getSubDimType $mag $dim $sDi]
1245    #TODO: Validate here
1246    switch -- $type {
1247       "uni.hie" {
1248         if {[info exist ${selfns}::tmp($mag,$dim,$sDi)] } {
1249           if {$tmp($mag,$dim,$sDi) ne ""} {
1250               if {[ $tmp($mag,$dim,$sDi) getSelected ] ne ""} {
1251                    set lst [ join [  $tmp($mag,$dim,$sDi) getSelected cod ] ]
1252               } else {
1253                   set lst ""
1254               }
1255           }
1256         }
1257       }
1258       "mul.hie" {
1259         if {[info exist ${selfns}::tmp($mag,$dim,$sDi)] } {
1260           if {$tmp($mag,$dim,$sDi) ne ""} {
1261               if {[ $tmp($mag,$dim,$sDi) getSelected ] ne ""} {
1262                    set lst [ join [  $tmp($mag,$dim,$sDi) getSelected cod ] ]
1263               } else {
1264                   set lst ""
1265               }
1266           }
1267         }
1268       }
1269       "uni.dat" {
1270         if {[info exist ${selfns}::tmp($mag,$dim,$sDi)] } {
1271           if {$tmp($mag,$dim,$sDi) ne ""} {
1272               if {[ $tmp($mag,$dim,$sDi) cget -btext ] ne ""} {
1273                    set lst [ join [  $tmp($mag,$dim,$sDi) cget -btext ] ]
1274               } else {
1275                   set lst "00000000"
1276               }
1277           }
1278         }
1279       }
1280      "mul.dat" {
1281          if {[info exist ${selfns}::tmp($mag,$dim,$sDi)] } {
1282            if {$tmp($mag,$dim,$sDi) ne ""} {
1283                if {[ $tmp($mag,$dim,$sDi) cget -btext ] ne ""} {
1284                     set lst [ join [  $tmp($mag,$dim,$sDi) cget -btext ] ]
1285                } else {
1286                    set lst "00000000"
1287                }
1288            }
1289          }
1290      }
1291       "uni.dir" {
1292         if {[info exist ${selfns}::tmp($mag,$dim,$sDi)] } {
1293           if {$tmp($mag,$dim,$sDi) ne ""} {
1294             set lst [list $tmp($mag,$dim,$sDi)]
1295           }
1296         }
1297       }
1298       "uni.ind" {
1299         if {[info exist ${selfns}::tmp($mag,$dim,$sDi)]} {
1300           set val [lindex [$tmp($mag,$dim,$sDi) key get] 0]
1301           if {$val ne ""} {
1302             set lst [list $val]
1303           } else {
1304             set lst ""
1305           }
1306         }
1307       }
1308       "mul.dir" { 
1309         regsub -all $mag,$dim,$sDi, \
1310           [array names ${selfns}::tmp $mag,$dim,$sDi,*] "" ideNames
1311         foreach ide $ideNames {
1312           if {$tmp($mag,$dim,$sDi,$ide) != 0} {
1313             lappend lst $ide
1314           }
1315         }
1316       }
1317       "mul.lib" -
1318       "mul.ind" {
1319         if {[info exist ${selfns}::tmp($mag,$dim,$sDi)]} {
1320           set lst [$tmp($mag,$dim,$sDi) selection get [mc Code]]
1321         }
1322       }
1323    }   
1324
1325    set res ""
1326    foreach val $lst {
1327      lappend res [list $dim $sDi $val]
1328    }
1329    #Tolcon_Trace "sDi: $dim $sDi --> $res"
1330    return $res
1331  }
1332
1333  #/////////////////////////////////////////////////////////////////////////////
1334  method _createlist {w} {
1335  # PURPOSE: Creates series list listbox frame
1336  # PARAMETERS:
1337  #   w  - path
1338  #/////////////////////////////////////////////////////////////////////////////
1339   
1340    set tf [TitleFrame $w.tflist -text [mc {Series selected}] -bd 1 -side center]
1341    set f [$tf getframe]
1342     
1343    ScrolledWindow $f.sw
1344    set widget(output) [blistbox $f.sw.lb -state normal -width 30 \
1345        -selectmode extended]
1346    $f.sw setwidget $f.sw.lb
1347 
1348    grid $f.sw -sticky news
1349 
1350    grid columnconfigure $f 0 -weight 1
1351    grid rowconfigure    $f 0 -weight 1
1352     
1353    return $tf
1354  }
1355 
1356  #/////////////////////////////////////////////////////////////////////////////
1357  method _createbbox {f} {
1358  #
1359  # PURPOSE: Creates a button box with options over form selection and names
1360  #          list.
1361  # PARAMETERS:
1362  #  f  - path
1363  #
1364  #/////////////////////////////////////////////////////////////////////////////
1365 
1366    # Botones
1367    set bbox [ButtonBox $f.bb -orient vertical -spacing 2]
1368    set spNor  2 ;#Espacio normal entre botones del mismo grupo
1369    set spSep 20 ;#Espacio entre grupos de botones
1370    # add add button
1371    $bbox add -image [Bitmap::get play] \
1372      -relief link -bd 1 -padx 1 -pady 1 \
1373      -command [list $self _addselection]\
1374      -helptext [mc "Add series to list"]
1375    $bbox configure -spacing $spNor
1376    # add clear sel button
1377    $bbox add -image [Bitmap::get reverse] \
1378      -relief link -bd 1 -padx 1 -pady 1 \
1379      -command [list $self _clearselection ]\
1380      -helptext [mc "Clear selection"]
1381    # add clear all button
1382    $bbox add -image [Bitmap::get Clear] \
1383      -relief link -bd 1 -padx 1 -pady 1 \
1384      -command [list $self _clearall]\
1385      -helptext [mc "Clear all"]
1386    $bbox configure -spacing $spSep
1387    # add include button
1388    $bbox add -image [::Bitmap::get "eval"] \
1389       -relief link -bd 1 -padx 1 -pady 1 \
1390       -helptext "[mc "Include"] (F9)" -command [list $self _includeseries]
1391    bind $widget(output) <F9> [list $self _includeseries]
1392    $bbox configure -spacing $spNor
1393    # add clear button
1394    $bbox add -image [::Bitmap::get "decom"] -highlightthickness 0 \
1395       -activebackground \#ececec \
1396       -relief link -bd 1 -padx 1 -pady 1 \
1397       -helptext "[mc Release] (F8)" -command ::TolConsole::ClearConsole
1398    bind $widget(output) <F8> ::TolConsole::ClearConsole
1399    $bbox configure -spacing $spSep
1400    # add load list button
1401    $bbox add -image [Bitmap::get open] \
1402      -relief link -bd 1 -padx 1 -pady 1 \
1403      -command [list lbLoadFromFile $widget(output)] \
1404      -helptext [mc "Load selection from file"]
1405    $bbox configure -spacing $spNor
1406    # add save list button
1407    $bbox add -image [Bitmap::get save] \
1408      -relief link -bd 1 -padx 1 -pady 1 \
1409      -command [list lbSaveToFile $widget(output) 1 1] \
1410      -helptext [mc "Save selection in file"]
1411    $bbox configure -spacing $spSep
1412    # exit button
1413    #$bbox add -image [Bitmap::get exit] -relief link -bd 1 -padx 1 -pady 1\
1414    #   -command [list $self _destroy]\
1415    #   -helptext [mc "Close the form"]
1416 
1417    return $bbox
1418  }
1419
1420  #/////////////////////////////////////////////////////////////////////////////
1421  method _addselection {} {
1422  #
1423  # PURPOSE: Adds selection from algebra to series list listbox
1424  #
1425  #/////////////////////////////////////////////////////////////////////////////
1426   set mag [$widget(tabset) get focus]
1427    set lst [$self _getSelMagAsName $mag]
1428    foreach name $lst {
1429      $widget(output) insert end $name
1430    }
1431  }
1432
1433 
1434  #/////////////////////////////////////////////////////////////////////////////
1435  method _clearselection {} {
1436  #
1437  # PURPOSE: Clears selected series of series list listbox
1438  #
1439  #/////////////////////////////////////////////////////////////////////////////
1440    lbDeleteSelection $widget(output)
1441  }
1442 
1443 
1444  #/////////////////////////////////////////////////////////////////////////////
1445  method _clearall {} {
1446  #
1447  # PURPOSE: Clears all series of series list listbox
1448  #
1449  #/////////////////////////////////////////////////////////////////////////////
1450    $widget(output) deletespecial
1451  }
1452
1453
1454  #/////////////////////////////////////////////////////////////////////////////
1455  method _includeseries {} {
1456  #
1457  # PURPOSE: Includes series of series list listbox
1458  #
1459    #/////////////////////////////////////////////////////////////////////////////
1460    set max 0
1461    foreach it [$widget(output) get 0 end] {
1462        set max $max+1
1463    }
1464    ::progressbar::Show [mc "loading"] 60 2
1465    set iterador 0
1466    foreach it [$widget(output) get 0 end] {
1467      ::progressbar::SetText "[mc "Compiling serie"]: $it"
1468      set code "Anything $alg(TCL,-funAlgGetData)(\"$it\",[$self cget -def])"
1469      ::tol::console eval $code
1470      set iterador [expr $iterador+1]
1471      ::progressbar::Set [expr $iterador * 100 / ($max)]
1472    }
1473    ::TolInspector::UpdateConsoleObj
1474    ::progressbar::Destroy
1475  }
1476
1477  #/////////////////////////////////////////////////////////////////////////////
1478  method _destroy {} {
1479  #/////////////////////////////////////////////////////////////////////////////
1480    $self _writeini
1481    array unset tmp
1482    array unset alg
1483  }
1484
1485
1486  #/////////////////////////////////////////////////////////////////////////////
1487  method _writeini {} {
1488  #/////////////////////////////////////////////////////////////////////////////
1489    set wini ::iniFile::Write
1490 
1491    set options(wform)   [winfo width $widget(panel,form)]
1492    set options(wlist)   [winfo width $widget(panel,list)]
1493 
1494    $wini $data(iniEntry) wform     $options(wform)
1495    $wini $data(iniEntry) wlist     $options(wlist)
1496  }
1497
1498  #/////////////////////////////////////////////////////////////////////////////
1499  method _readini {} {
1500  #/////////////////////////////////////////////////////////////////////////////
1501    set rini ::iniFile::Read
1502    set options(wform) [$rini $data(iniEntry) wform 7]
1503    set options(wlist) [$rini $data(iniEntry) wlist 3]
1504  }
1505}
1506
1507
1508
1509
1510package provide bsersel 1.0
1511
1512# -------- TEST CODE ------
1513
1514proc test_bsersel { } {
1515  # Desde un ambito global
1516  global env
1517  source "./toltk/project.tcl"
1518  source "./toltk/iniparseBys.tcl"
1519  source "./toltk/iniFile.tcl"
1520
1521  load iniFile
1522  ::iniFile::Create [file join $env(HOME) "prueba.ini"]
1523
1524  bsersel .a -project CocaCola
1525  .a show
1526}
1527
1528#test_bsersel
Note: See TracBrowser for help on using the repository browser.