source: tol/tolbase/lib/byswidget/bsersel/bsersel.tcl @ bdc524a

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

svn:eol-style native

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@154 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 51.7 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#/////////////////////////////////////////////////////////////////////////////
580method _fillSubDimHie {mag dim sDi trigger} {
581#
582# PURPOSE: Fills subdimension frame for a subdimension marked as hierarchical
583# PARAMETERS:
584#   mag -> magnitud identifier
585#   dim -> dimension identifier
586#   sDi -> subdimension identifier
587#   trigger -> 0/1 trigger event for dependants?
588#   multisel -> 0/1 allows multiselection
589#/////////////////////////////////////////////////////////////////////////////
590
591  set w $algwid($mag,$dim,$sDi)
592  set lstReg [$self _getSubDimValues $mag $dim $sDi]
593  set defval [$self _getSubDimDefValue $mag $dim $sDi]
594
595  set valCont 0
596  #if $multisel { set icosel 0 } else { set icosel 1 }
597# -bonselcmd [list $self _trigger $mag $dim $sDi] \
598# Si no existe crearlo
599  if {![info exist ${selfns}::tmp($mag,$dim,$sDi)]} {
600    ScrolledWindow $w.sw${sDi}
601    if {$trigger} {
602      set tmp($mag,$dim,$sDi) [ btreeview $w.sw${sDi}.tv \
603        -bonselcmd [list $self _trigger $mag $dim $sDi] \
604                -btogglehier false \
605        -height 150 -linewidth 2 -borderwidth 1 \
606        -bmultiselect false -bicosel false ]
607    } else {
608      set tmp($mag,$dim,$sDi) [ btreeview $w.sw${sDi}.tv \
609        -btogglehier false \
610        -height 150 -linewidth 2 -borderwidth 1 \
611        -bmultiselect true -bicosel true ]
612    }
613   
614    $tmp($mag,$dim,$sDi) bColumnInsert end cod -hide true
615   
616   
617    $w.sw${sDi} setwidget $w.sw${sDi}.tv
618    grid $w.sw${sDi} -sticky news
619    #grid $w.sw${sDi}.tv  -row 0 -column 0 -sticky new
620 
621    grid columnconfigure $w 0 -weight 1
622    grid rowconfigure    $w 0 -weight 1
623  }
624  # Insertar los valores
625  # Crear elementos nuevos
626    #set idx 0
627    $tmp($mag,$dim,$sDi) delete root
628    set alg(sDi,$mag,$dim,-hie,$sDi) ""
629    set plotted 0
630    set iteration -1
631    set regidx 0
632    set plottedreg ""
633    set numels [expr [llength $lstReg]-1 ]
634   
635    while { ($plotted < $numels) && ($iteration < $numels) } {
636       set iteration [expr $iteration + 1]
637
638       foreach reg $lstReg {
639          set ide [lindex $reg 0]
640          set abr [lindex $reg 1]
641          set nom [lindex $reg 2]
642          set des [lindex $reg 3]
643          set par [lindex $reg 4]
644          set lev [lindex $reg 5]
645          if {$iteration eq 0} { lappend plottedreg 0 }
646          if { $abr eq $defval } {
647            set mark ON
648          } else {
649            set mark OFF
650          }
651          set isplotted [lindex $plottedreg $regidx]
652
653#          set cmd "Text WriteLn(\"Processing iteration $iteration regidx $regidx plotted $plotted plottedreg -> $plottedreg \");"
654#          ::tol::console eval $cmd
655
656          if { $isplotted eq 0 } {
657              set infCols [ list cod $abr ]
658              if {$par ne ""} {
659                 set paridx [$self _findcode $alg(sDi,$mag,$dim,-hie,$sDi) $par]
660                 if { $paridx >= 0 } {
661                   set plottedreg [ lreplace $plottedreg $regidx $regidx 1 ]
662                   set plotted [expr $plotted+1]
663                   set idx [ $tmp($mag,$dim,$sDi) insertNode $paridx 0 $mark $abr $nom $infCols ]
664                 }
665              } else {
666                 set plottedreg [ lreplace $plottedreg $regidx $regidx 1 ]
667                 set plotted [expr $plotted+1]
668                 set idx [ $tmp($mag,$dim,$sDi) insertNode root 0 $mark $abr $nom $infCols ]
669              }
670              lappend alg(sDi,$mag,$dim,-hie,$sDi) [list $idx $abr]
671          }
672          set regidx [expr $regidx+1]
673       }
674       set regidx 0
675    }
676}
677 
678#/////////////////////////////////////////////////////////////////////////////
679method _fillSubDimDat {mag dim sDi trigger} {
680#
681# PURPOSE: Fills subdimension frame for a subdimension marked as returning a
682#          date data type
683# PARAMETERS:
684#   mag -> magnitud identifier
685#   dim -> dimension identifier
686#   sDi -> subdimension identifier
687#/////////////////////////////////////////////////////////////////////////////
688#Tolcon_Trace "_fillSubDimUniInd mag=$mag dim=$dim, sDi=$sDi"
689  set w $algwid($mag,$dim,$sDi)
690  set lstReg [$self _getSubDimValues $mag $dim $sDi]
691  set defval [$self _getSubDimDefValue $mag $dim $sDi]
692  set defFound 0
693  set valCont 0
694
695  if {[llength $lstReg]} {
696    foreach reg $lstReg {
697      lappend lstRegMod [linsert [lrange $reg 1 end] end [lindex $reg 0]]
698      set valCont [expr $valCont+1]
699      if {$defval eq [lindex $reg 1]} {
700           set defFound $valCont
701      }
702    }
703  } else {
704    set lstRegMod ""
705  }
706  # Si no existe crearlo
707  if {![info exist ${selfns}::tmp($mag,$dim,$sDi)]} {
708    label $w.l${sDi} -text [mc $sDi]
709      if {$trigger} {
710          set tmp($mag,$dim,$sDi) [ bentrydate $w.bsf${sDi} \
711             -postcommand [list $self _trigger $mag $dim $sDi] ]
712      } else {
713          set tmp($mag,$dim,$sDi) [bentrydate $w.bsf${sDi} ]
714      }
715
716   
717    grid $w.l${sDi}    -row 0 -column 0 -sticky ne
718    grid $w.bsf${sDi}  -row 0 -column 1 -sticky new
719 
720    grid columnconfigure $w 1 -weight 1
721    grid rowconfigure    $w 0 -weight 1
722  }
723  puts $defval
724  # Insertar los valores
725  $tmp($mag,$dim,$sDi) configure -bdate $defval
726
727#  if {$defval ne ""} {
728#     if {$defFound eq 1} {
729#        $tmp($mag,$dim,$sDi) selectIndex $defFound
730#     }
731#  }
732
733}
734
735  #/////////////////////////////////////////////////////////////////////////////
736  method _fillSubDimUniDir {mag dim sDi} {
737  #
738  # PURPOSE: Fills subdimension frame for a subdimension with 'unique'
739  #          selection type and 'direct' show method (radiobuttons)
740  # PARAMETERS:
741  #   mag -> magnitud identifier
742  #   dim -> dimension identifier
743  #   sDi -> subdimension identifier
744  #/////////////////////////////////////////////////////////////////////////////
745  #Tolcon_Trace "_fillSubDimUniDir mag=$mag dim=$dim, sDi=$sDi"
746    set w $algwid($mag,$dim,$sDi)
747    set lstReg [$self _getSubDimValues $mag $dim $sDi]
748
749    if [info exist ${selfns}::alg(sDi,$mag,$dim,TCL,-cols,$sDi)] {
750      set cols $alg(sDi,$mag,$dim,TCL,-cols,$sDi)
751    } else {
752      set cols 1
753    }
754
755    # Eliminar elementos anteriores y eliminar configure padre
756    set idx 0
757    foreach f [winfo child $w] {
758      destroy $f
759      incr idx
760    }
761    grid columnconfigure $w $cols                 -weight 0
762    grid rowconfigure    $w [_getRows $cols $idx] -weight 0
763
764    # Crear elementos nuevos
765    set idx 0
766    set defval [$self _getSubDimDefValue $mag $dim $sDi]
767
768    foreach reg $lstReg {
769      set ide [lindex $reg 0]
770      set abr [lindex $reg 1]
771      set nom [lindex $reg 2]
772      set des [lindex $reg 3]
773      set wid rb$abr
774      radiobutton $w.$wid -text $nom -value $abr \
775         -variable ${selfns}::tmp($mag,$dim,$sDi)
776      if {$abr eq $defval} {
777        $w.$wid select
778      }
779      DynamicHelp::add $w.$wid -text [mc $des]
780      grid $w.$wid -row [expr $idx/$cols] -column [expr $idx%$cols] -sticky nws
781      incr idx
782    }
783    if {$idx ne 0} {
784      trace variable ${selfns}::tmp($mag,$dim,$sDi) \
785        w [list $self _trigger $mag $dim $sDi]
786    }
787    grid columnconfigure $w $cols                  -weight 1
788    grid rowconfigure    $w [_getRows $cols $idx]  -weight 1
789  }
790
791  #/////////////////////////////////////////////////////////////////////////////
792  method _fillSubDimUniInd {mag dim sDi} {
793  #
794  # PURPOSE: Fills subdimension frame for a subdimension with 'unique'
795  #          selection type and 'indirect' show method (bselectfields)
796  # PARAMETERS:
797  #   mag -> magnitud identifier
798  #   dim -> dimension identifier
799  #   sDi -> subdimension identifier
800  #/////////////////////////////////////////////////////////////////////////////
801  #Tolcon_Trace "_fillSubDimUniInd mag=$mag dim=$dim, sDi=$sDi"
802    set w $algwid($mag,$dim,$sDi)
803    set lstReg [$self _getSubDimValues $mag $dim $sDi]
804    set defval [$self _getSubDimDefValue $mag $dim $sDi]
805    set defFound 0
806    set valCont 0
807
808    if {[llength $lstReg]} {
809      foreach reg $lstReg {
810        lappend lstRegMod [linsert [lrange $reg 1 end] end [lindex $reg 0]]
811        set valCont [expr $valCont+1]
812        if {$defval eq [lindex $reg 1]} {
813             set defFound $valCont
814        }
815      }
816    } else {
817      set lstRegMod ""
818    }
819    # Si no existe crearlo
820    if {![info exist ${selfns}::tmp($mag,$dim,$sDi)]} {
821      label $w.l${sDi} -text [mc $sDi]
822      set tmp($mag,$dim,$sDi) [bcomboboxplus $w.bsf${sDi} \
823        -modifycmd [list $self _trigger $mag $dim $sDi] \
824        -cols    [list [mc Code] [mc Name] [mc Description] [mc Id]] \
825        -hiddencols    [list [mc Description] [mc Id]] \
826        -nrows 6 \
827        -widthlb 600 \
828        -font {Arial 8}]
829     
830      grid $w.l${sDi}    -row 0 -column 0 -sticky ne
831      grid $w.bsf${sDi}  -row 0 -column 1 -sticky new
832   
833      grid columnconfigure $w 1 -weight 1
834      grid rowconfigure    $w 0 -weight 1
835    }
836    # Insertar los valores
837    $tmp($mag,$dim,$sDi) clear
838    foreach item $lstRegMod {
839      $tmp($mag,$dim,$sDi) insert end $item
840    }
841
842    if {$defval ne ""} {
843       if {$defFound eq 1} {
844          $tmp($mag,$dim,$sDi) selectIndex $defFound
845       }
846    }
847
848  }
849
850  #/////////////////////////////////////////////////////////////////////////////
851  method _fillSubDimMulDir {mag dim sDi} {
852  #
853  # PURPOSE: Fills subdimension frame for a subdimension with 'multiple'
854  #          selection type and 'direct' show method (checkbuttons)
855  # PARAMETERS:
856  #   mag -> magnitud identifier
857  #   dim -> dimension identifier
858  #   sDi -> subdimension identifier
859  #/////////////////////////////////////////////////////////////////////////////
860  #Tolcon_Trace "_fillSubDimMulDir mag=$mag dim=$dim, sDi=$sDi"
861
862    set w $algwid($mag,$dim,$sDi)
863    set lstReg [$self _getSubDimValues $mag $dim $sDi]
864    if [info exist ${selfns}::alg(sDi,$mag,$dim,TCL,-cols,$sDi)] {
865      set cols $alg(sDi,$mag,$dim,TCL,-cols,$sDi)
866    } else {
867      set cols 3
868    }
869#set cmd "Text WriteLn(\"Llamada a testar (before) -> mag:$mag,dim:$dim,subdim:$sDi \");"
870#::tol::console eval $cmd
871
872    # Eliminar elementos anteriores y eleminar configure padre
873    set idx 0
874    foreach f [winfo child $w] {
875      set abr [string range [lindex [split $f .] end] 2 end]
876      set tmp($mag,$dim,$sDi,$abr) 0
877      destroy $f
878      incr idx
879    }
880    grid columnconfigure $w $cols                 -weight 0
881    grid rowconfigure    $w [_getRows $cols $idx] -weight 0
882    # Crear elementos nuevos
883    set idx 0
884    set defval [$self _getSubDimDefValue $mag $dim $sDi]
885    foreach reg $lstReg {
886      set ide [lindex $reg 0]
887      set abr [lindex $reg 1]
888      set nom [lindex $reg 2]
889      set des [lindex $reg 3]
890      set wid ch$abr
891      checkbutton $w.$wid -text $nom -onvalue $abr \
892         -variable ${selfns}::tmp($mag,$dim,$sDi,$abr)
893
894      if {$abr eq $defval} {
895        $w.$wid select
896      }
897      DynamicHelp::add $w.$wid -text [mc $des]
898      grid $w.$wid -row [expr $idx/$cols] -column [expr $idx%$cols] -sticky nw
899      incr idx
900    }
901    grid columnconfigure $w $cols                 -weight 1
902    grid rowconfigure    $w [_getRows $cols $idx] -weight 1
903  }
904
905  #/////////////////////////////////////////////////////////////////////////////
906  method _fillSubDimMulInd {mag dim sDi {readonly 1}} {
907  #
908  # PURPOSE: Fills subdimension frame for a subdimension with 'multiple'
909  #          selection type and 'indirect' show method (beditselector)
910  # PARAMETERS:
911  #   mag -> magnitud identifier
912  #   dim -> dimension identifier
913  #   sDi -> subdimension identifier
914  #   readonly  -> indica si es editable o no
915  #/////////////////////////////////////////////////////////////////////////////
916  #Tolcon_Trace "_fillSubDimMulInd mag=$mag dim=$dim, sDi=$sDi"
917    set w $algwid($mag,$dim,$sDi)
918    set lstReg [$self _getSubDimValues $mag $dim $sDi]
919    set defval [$self _getSubDimDefValue $mag $dim $sDi]
920    set defFound 0
921    set longitud [llength $lstReg]
922    if {[llength $lstReg]} {
923      foreach reg $lstReg {
924        set lstValues [linsert [lrange $reg 1 end] end [lindex $reg 0]]
925        lappend lstRegMod $lstValues
926        set val [lindex $reg 1]
927        if {$defval eq $val} {
928             set defFound $lstValues
929        }
930      }
931    } else {
932      set lstRegMod ""
933    }
934    # si no existe crearlo
935    if {![info exist ${selfns}::tmp($mag,$dim,$sDi)]} {
936      set tmp($mag,$dim,$sDi) [beditselector $w.bes${sDi} -width 25\
937        -label [mc $sDi] -readonly $readonly  -font {Arial 8}\
938        -entcols [list [mc Code] [mc Name]] -msgeometry 1000x500+40+10\
939        -hlpcols [list [mc Code] [mc Name] [mc Description]]\
940        -cols    [list [mc Code] [mc Name] [mc Description] [mc Id]] ]
941      grid $w.bes${sDi}  -row 0 -column 0 -sticky new
942
943      grid columnconfigure $w 0 -weight 1
944      grid rowconfigure    $w 0 -weight 1
945    }
946    # Insertar los valores
947    $tmp($mag,$dim,$sDi) configure -list $lstRegMod -sel ""
948
949    if {$defval ne ""} {
950       if {$defFound ne 0} {
951          $tmp($mag,$dim,$sDi) configure -sel  [list $defFound]
952       }
953    }
954  }
955
956  #/////////////////////////////////////////////////////////////////////////////
957  method _trigger {mag dim sDi args} {
958  #
959  # PURPOSE: Method called when a 'unique' selection type subdimension changes
960  #          its selection, then other subdimensions values may change and
961  #          other dimensions existence may change.
962  # PARAMETERS:
963  #   mag   -> magntitud
964  #   dim   -> dimension
965  #   sDi   -> subdimension
966  #   args  -> rest of arguments (not used)
967  #/////////////////////////////////////////////////////////////////////////////
968    set localtrig 0
969    if { !$data(alreadytriggering) } {
970         set data(alreadytriggering) 1
971      set localtrig 1
972      . configure -cursor watch
973    }
974    #Tolcon_Trace "********** Launching _trigger $mag $dim $sDi"
975     
976    set def [$self cget -def]
977
978    foreach reg $alg(sDi,$mag,$dim,-dva,$sDi) {
979      set dimDep [lindex $reg 0]
980      set sDiDep [lindex $reg 1]
981      $self _fillSubDim $mag $dimDep $sDiDep
982    }
983    if { $localtrig } {
984        set data(alreadytriggering) 0
985        . configure -cursor ""
986      }
987     
988  }
989
990  #/////////////////////////////////////////////////////////////////////////////
991  method _getSubDimValues {mag dim sDi} {
992  #
993  # PURPOSE: Get allowed values of a subdimension
994  # PARAMETERS:
995  #   mag -> magnitud identifier
996  #   dim -> dimension identifier
997  #   sDi -> subdimension identifier
998  #/////////////////////////////////////////////////////////////////////////////
999  #Tolcon_Trace "_getSumDimValues mag=$mag, dim=$dim, sDi=$sDi"
1000    set res [$self _getSelection]
1001
1002    set cmd [TclLst2TolSet $res -level 2]
1003    set sSet [StringReplace $cmd "SetOfText" "AlgNodeSt"]
1004
1005    set def    [$self cget -def]
1006    set nRes [GetUniqueName Text _GuiAlgDim]
1007    set cmd "Text $nRes = \
1008      GuiAlgGetSubDimVal(\"$mag\",\"$dim\",\"$sDi\",$sSet,$def);"
1009    ::tol::console eval ${cmd}
1010    array set info [TclInfoVar Text $nRes]
1011    eval "set lstSubDimVal $info(CONTENT)"
1012    ::tol::console stack release $nRes
1013    #Tolcon_Trace "\ncmd=$cmd \n lstSubDimVal = $lstSubDimVal"
1014    return $lstSubDimVal
1015  }
1016
1017  #/////////////////////////////////////////////////////////////////////////////
1018  method _getSubDimDefValue {mag dim sDi} {
1019  #
1020  # PURPOSE: Get default value of a subdimension
1021  # PARAMETERS:
1022  #   mag -> magnitud identifier
1023  #   dim -> dimension identifier
1024  #   sDi -> subdimension identifier
1025  #/////////////////////////////////////////////////////////////////////////////
1026    #Tolcon_Trace "_getSumDimValues mag=$mag, dim=$dim, sDi=$sDi"
1027    set res [$self _getSelection]
1028       
1029    set cmd [TclLst2TolSet $res -level 2]
1030    set sSet [StringReplace $cmd "SetOfText" "AlgNodeSt"]
1031       
1032    set def    [$self cget -def]
1033    set nRes [GetUniqueName Text _GuiAlgDim]
1034    set cmd "Text $nRes = \
1035            GuiAlgGetSubDimDefVal(\"$mag\",\"$dim\",\"$sDi\",$sSet,$def);"
1036    ::tol::console eval ${cmd}
1037    array set info [TclInfoVar Text $nRes]
1038    eval "set lstSubDimVal $info(CONTENT)"
1039    ::tol::console stack release $nRes
1040    #Tolcon_Trace "\ncmd=$cmd \n lstSubDimVal = $lstSubDimVal"
1041    return $lstSubDimVal
1042  }
1043   
1044  #/////////////////////////////////////////////////////////////////////////////
1045  method _getSubDimType {mag dim sDi} {
1046  #
1047  # PURPOSE: Returns type of a subdimension
1048  # PARAMETERS:
1049  #   mag -> magnitud
1050  #   dim -> dimension
1051  #   sDi -> subdimension
1052  #/////////////////////////////////////////////////////////////////////////////
1053    set nDeEx [llength $alg(sDi,$mag,$dim,-dex,$sDi)]
1054    set nDeVa [llength $alg(sDi,$mag,$dim,-dva,$sDi)]
1055   
1056    if {[expr $nDeEx + $nDeVa] eq 0} {
1057      set car "mul"
1058    } else {
1059      set car "uni"
1060    }
1061    if [info exist ${selfns}::alg(sDi,$mag,$dim,TCL,-type,$sDi)] {
1062      set met [string tolower $alg(sDi,$mag,$dim,TCL,-type,$sDi)]
1063      if { ($met ne "hie") && ($met ne "dir") && ($met ne "dat") && ($met ne "lib")} {
1064        set met "ind"
1065      }
1066    } else {
1067      set met "ind"
1068    }
1069    set typ ${car}.${met}
1070
1071    return $typ
1072  }
1073
1074  #/////////////////////////////////////////////////////////////////////////////
1075  method _getSelection {} {
1076  #
1077  # PURPOSE: Returns a names list corresponding to selection of actual tab
1078  #
1079  #/////////////////////////////////////////////////////////////////////////////
1080    set res ""
1081    set magSel [$widget(tabset) get focus]
1082
1083    # lista de magnitudes
1084    foreach mag [$self _getMag] {
1085      if {$magSel eq $mag} {
1086        set res [$self _getSelMag $mag]
1087      }
1088    }
1089    return $res
1090  }
1091
1092  #/////////////////////////////////////////////////////////////////////////////
1093  method _checkMag {mag} {
1094  #
1095  # PURPOSE: Checks if all requiered dimensions and subdimensions are choosen
1096  #
1097  # PARAMETERS:
1098  #   mag -> magnitud identifier
1099  #
1100  #/////////////////////////////////////////////////////////////////////////////
1101    set res 1
1102    foreach dim [$self _getDim $mag] {
1103      foreach sDi [$self _getSubDim $mag $dim] {
1104        set sDiLst  [$self _getSelSubDim $mag $dim $sDi]
1105        set type [$self _getSubDimType $mag $dim $sDi]
1106        if {$res && ($alg(sDi,$mag,$dim,-req,$sDi) eq 1) && \
1107            ( $type ne "uni.dat" && $type ne "mul.dat" ) && ([llength $sDiLst] eq 0)} {
1108          set msg [mc "Must fill subdimension %1\$s of dimension %2\$s" \
1109             $alg(sDi,$mag,$dim,-nam,$sDi) $alg(Dim,$mag,-nam,$dim)]
1110          tk_messageBox -message $msg -title [mc "Required fields"]
1111          set res 0
1112        }
1113      }
1114    }
1115    return $res
1116  }
1117
1118  #/////////////////////////////////////////////////////////////////////////////
1119  method _getSelMag {mag} {
1120  #
1121  # PURPOSE: Returns a names list corresponding to selection of a given magnitud
1122  #
1123  # PARAMETERS:
1124  #   mag -> magnitud identifier
1125  #
1126  #/////////////////////////////////////////////////////////////////////////////
1127    set res ""
1128    foreach dim [$self _getDim $mag] {
1129      foreach sDi [$self _getSubDim $mag $dim] {
1130        set sDiLst  [$self _getSelSubDim $mag $dim $sDi]
1131        foreach sDiRes $sDiLst {
1132          lappend res $sDiRes
1133        }
1134      }
1135    }
1136    #Tolcon_Trace "MAG: $mag     --> $res"
1137    return $res
1138  }
1139
1140  #/////////////////////////////////////////////////////////////////////////////
1141  method _getSelMagAsName {mag} {
1142  #
1143  # PURPOSE: Returns a names list corresponding to selection of a given magnitud
1144  #          as a valid name
1145  #
1146  # PARAMETERS:
1147  #   mag -> magnitud identifier
1148  #
1149  #/////////////////////////////////////////////////////////////////////////////
1150    set lstDimf ""
1151    if {[$self _checkMag $mag]} {
1152      set lstDim [$self _getDim $mag]
1153      set cmd [$self _getSelMag_ lstDimf $mag [lindex $lstDim 0] $lstDim]
1154      #Tolcon_Trace "\n$cmd\n"
1155      eval $cmd
1156    }
1157    return $lstDimf
1158  }
1159
1160  #/////////////////////////////////////////////////////////////////////////////
1161  method _getSelMag_ {var mag dim lstDim} {
1162  #
1163  # PURPOSE: Returns the TCL script that when its evaluated returns the algebra
1164  #          names relative to a given magnitud Its returned in var variable.
1165  # PARAMETERS:
1166  #   var -> name of TCL variable that will contain the list of magnitud names
1167  #   mag -> magnitud identifier
1168  #   dim -> dimension identifier
1169  #   lstDim -> list of dimensions of given magnitud To iterate
1170  #
1171  #/////////////////////////////////////////////////////////////////////////////
1172  #Tolcon_Trace "_getSelMag var=$var mag=$mag dim=$dim lstDim=$lstDim"
1173    set txt ""
1174    set idx [lsearch $lstDim $dim]
1175    set spa [string repeat " " [expr 2*$idx]]
1176    if {$dim eq [lindex $lstDim end]} {
1177      set txt \
1178"${spa}foreach $dim [list [$self _getSelDim $mag $dim]] {
1179${spa}  lappend $var ${mag}_[ListToStr $lstDim $alg(TCL,-dimSep) {[lindex $}    { 0]}]
1180${spa}}"
1181    } else {
1182      set txt \
1183"${spa}foreach $dim [list [$self _getSelDim $mag $dim]] {
1184[$self _getSelMag_ $var $mag [lindex $lstDim [expr $idx+1]] $lstDim]
1185${spa}}"
1186    }
1187    Tolcon_Trace "\n$txt\n"
1188    return $txt
1189  }
1190
1191
1192  #/////////////////////////////////////////////////////////////////////////////
1193  method _getSelDim {mag dim} {
1194  #/////////////////////////////////////////////////////////////////////////////
1195    set lstSD [$self _getSubDim $mag $dim]
1196    set cmd [$self _getSelDim_ lstSDf $mag $dim [lindex $lstSD 0] $lstSD]
1197    set lstSDf ""
1198    eval $cmd
1199    return $lstSDf
1200  }
1201
1202
1203  #/////////////////////////////////////////////////////////////////////////////
1204  method _getSelDim_ {var mag dim sDi lstSDi} {
1205  #
1206  # PURPOSE: Returns the TCL script that when its evaluated returns the algebra
1207  #          names relative to a given dimension. Its returned in var variable.
1208  # PARAMETERS:
1209  #   var -> name of TCL variable that will contain the list of dimension names
1210  #   mag -> magnitud identifier
1211  #   dim -> dimension identifier
1212  #   sDi -> subdimension identifier
1213  #   lstSDi -> list of subdimensions of given dimension. To iterate
1214  #
1215  #/////////////////////////////////////////////////////////////////////////////
1216  #Tolcon_Trace "_getSelDim_ var=$var mag=$mag dim=$dim sDi=$sDi, lstSDi=$lstSDi"
1217    set txt ""
1218    set idx [lsearch $lstSDi $sDi]
1219    set spa [string repeat " " [expr 2*$idx]]
1220
1221    set dimTxt [string range $dim 0 [expr $alg(TCL,-numCarDim)-1]]
1222    if {$sDi eq [lindex $lstSDi end]} {
1223      set txt \
1224"${spa}foreach $sDi [list [$self _getSelSubDim $mag $dim $sDi]] {
1225${spa}  lappend $var ${dimTxt}[ListToStr $lstSDi $alg(TCL,-sDiSep) {[lindex $}    { 2]}]
1226${spa}}"
1227    } else {
1228      set txt \
1229"${spa}foreach $sDi [list [$self _getSelSubDim $mag $dim $sDi]] {
1230[$self _getSelDim_ $var $mag $dim [lindex $lstSDi [expr $idx+1]] $lstSDi]
1231${spa}}"
1232    }
1233    Tolcon_Trace "\n$txt\n"
1234    return $txt
1235  }
1236
1237  #/////////////////////////////////////////////////////////////////////////////
1238  method _getSelSubDim {mag dim sDi} {
1239  #
1240  # PURPOSE: Returns a names list corresponding to a given subdimension
1241  # PARAMETERS:
1242  #   mag -> magnitud identifier
1243  #   dim -> dimension identifier
1244  #   sDi -> subdimension identifier
1245  #
1246  #/////////////////////////////////////////////////////////////////////////////
1247#Tolcon_Trace "Obteniendo subdimension: $mag $dim $sDi"
1248    set lst ""
1249    set type [$self _getSubDimType $mag $dim $sDi]
1250    #TODO: Validate here
1251    switch -- $type {
1252       "uni.hie" {
1253         if {[info exist ${selfns}::tmp($mag,$dim,$sDi)] } {
1254           if {$tmp($mag,$dim,$sDi) ne ""} {
1255               if {[ $tmp($mag,$dim,$sDi) getSelected ] ne ""} {
1256                    set lst [ join [  $tmp($mag,$dim,$sDi) getSelected cod ] ]
1257               } else {
1258                   set lst ""
1259               }
1260           }
1261         }
1262       }
1263       "mul.hie" {
1264         if {[info exist ${selfns}::tmp($mag,$dim,$sDi)] } {
1265           if {$tmp($mag,$dim,$sDi) ne ""} {
1266               if {[ $tmp($mag,$dim,$sDi) getSelected ] ne ""} {
1267                    set lst [ join [  $tmp($mag,$dim,$sDi) getSelected cod ] ]
1268               } else {
1269                   set lst ""
1270               }
1271           }
1272         }
1273       }
1274       "uni.dat" {
1275         if {[info exist ${selfns}::tmp($mag,$dim,$sDi)] } {
1276           if {$tmp($mag,$dim,$sDi) ne ""} {
1277               if {[ $tmp($mag,$dim,$sDi) cget -btext ] ne ""} {
1278                    set lst [ join [  $tmp($mag,$dim,$sDi) cget -btext ] ]
1279               } else {
1280                   set lst "00000000"
1281               }
1282           }
1283         }
1284       }
1285      "mul.dat" {
1286          if {[info exist ${selfns}::tmp($mag,$dim,$sDi)] } {
1287            if {$tmp($mag,$dim,$sDi) ne ""} {
1288                if {[ $tmp($mag,$dim,$sDi) cget -btext ] ne ""} {
1289                     set lst [ join [  $tmp($mag,$dim,$sDi) cget -btext ] ]
1290                } else {
1291                    set lst "00000000"
1292                }
1293            }
1294          }
1295      }
1296       "uni.dir" {
1297         if {[info exist ${selfns}::tmp($mag,$dim,$sDi)] } {
1298           if {$tmp($mag,$dim,$sDi) ne ""} {
1299             set lst [list $tmp($mag,$dim,$sDi)]
1300           }
1301         }
1302       }
1303       "uni.ind" {
1304         if {[info exist ${selfns}::tmp($mag,$dim,$sDi)]} {
1305           set val [lindex [$tmp($mag,$dim,$sDi) key get] 0]
1306           if {$val ne ""} {
1307             set lst [list $val]
1308           } else {
1309             set lst ""
1310           }
1311         }
1312       }
1313       "mul.dir" { 
1314         regsub -all $mag,$dim,$sDi, \
1315           [array names ${selfns}::tmp $mag,$dim,$sDi,*] "" ideNames
1316         foreach ide $ideNames {
1317           if {$tmp($mag,$dim,$sDi,$ide) != 0} {
1318             lappend lst $ide
1319           }
1320         }
1321       }
1322       "mul.lib" -
1323       "mul.ind" {
1324         if {[info exist ${selfns}::tmp($mag,$dim,$sDi)]} {
1325           set lst [$tmp($mag,$dim,$sDi) selection get [mc Code]]
1326         }
1327       }
1328    }   
1329
1330    set res ""
1331    foreach val $lst {
1332      lappend res [list $dim $sDi $val]
1333    }
1334    #Tolcon_Trace "sDi: $dim $sDi --> $res"
1335    return $res
1336  }
1337
1338  #/////////////////////////////////////////////////////////////////////////////
1339  method _createlist {w} {
1340  # PURPOSE: Creates series list listbox frame
1341  # PARAMETERS:
1342  #   w  - path
1343  #/////////////////////////////////////////////////////////////////////////////
1344   
1345    set tf [TitleFrame $w.tflist -text [mc {Series selected}] -bd 1 -side center]
1346    set f [$tf getframe]
1347     
1348    ScrolledWindow $f.sw
1349    set widget(output) [blistbox $f.sw.lb -state normal -width 30 \
1350        -selectmode extended]
1351    $f.sw setwidget $f.sw.lb
1352 
1353    grid $f.sw -sticky news
1354 
1355    grid columnconfigure $f 0 -weight 1
1356    grid rowconfigure    $f 0 -weight 1
1357     
1358    return $tf
1359  }
1360 
1361  #/////////////////////////////////////////////////////////////////////////////
1362  method _createbbox {f} {
1363  #
1364  # PURPOSE: Creates a button box with options over form selection and names
1365  #          list.
1366  # PARAMETERS:
1367  #  f  - path
1368  #
1369  #/////////////////////////////////////////////////////////////////////////////
1370 
1371    # Botones
1372    set bbox [ButtonBox $f.bb -orient vertical -spacing 2]
1373    set spNor  2 ;#Espacio normal entre botones del mismo grupo
1374    set spSep 20 ;#Espacio entre grupos de botones
1375    # add add button
1376    $bbox add -image [Bitmap::get play] \
1377      -relief link -bd 1 -padx 1 -pady 1 \
1378      -command [list $self _addselection]\
1379      -helptext [mc "Add series to list"]
1380    $bbox configure -spacing $spNor
1381    # add clear sel button
1382    $bbox add -image [Bitmap::get reverse] \
1383      -relief link -bd 1 -padx 1 -pady 1 \
1384      -command [list $self _clearselection ]\
1385      -helptext [mc "Clear selection"]
1386    # add clear all button
1387    $bbox add -image [Bitmap::get Clear] \
1388      -relief link -bd 1 -padx 1 -pady 1 \
1389      -command [list $self _clearall]\
1390      -helptext [mc "Clear all"]
1391    $bbox configure -spacing $spSep
1392    # add include button
1393    $bbox add -image [::Bitmap::get "eval"] \
1394       -relief link -bd 1 -padx 1 -pady 1 \
1395       -helptext "[mc "Include"] (F9)" -command [list $self _includeseries]
1396    bind $widget(output) <F9> [list $self _includeseries]
1397    $bbox configure -spacing $spNor
1398    # add clear button
1399    $bbox add -image [::Bitmap::get "decom"] -highlightthickness 0 \
1400       -activebackground \#ececec \
1401       -relief link -bd 1 -padx 1 -pady 1 \
1402       -helptext "[mc Release] (F8)" -command ::TolConsole::ClearConsole
1403    bind $widget(output) <F8> ::TolConsole::ClearConsole
1404    $bbox configure -spacing $spSep
1405    # add load list button
1406    $bbox add -image [Bitmap::get open] \
1407      -relief link -bd 1 -padx 1 -pady 1 \
1408      -command [list lbLoadFromFile $widget(output)] \
1409      -helptext [mc "Load selection from file"]
1410    $bbox configure -spacing $spNor
1411    # add save list button
1412    $bbox add -image [Bitmap::get save] \
1413      -relief link -bd 1 -padx 1 -pady 1 \
1414      -command [list lbSaveToFile $widget(output) 1 1] \
1415      -helptext [mc "Save selection in file"]
1416    $bbox configure -spacing $spSep
1417    # exit button
1418    #$bbox add -image [Bitmap::get exit] -relief link -bd 1 -padx 1 -pady 1\
1419    #   -command [list $self _destroy]\
1420    #   -helptext [mc "Close the form"]
1421 
1422    return $bbox
1423  }
1424
1425  #/////////////////////////////////////////////////////////////////////////////
1426  method _addselection {} {
1427  #
1428  # PURPOSE: Adds selection from algebra to series list listbox
1429  #
1430  #/////////////////////////////////////////////////////////////////////////////
1431   set mag [$widget(tabset) get focus]
1432    set lst [$self _getSelMagAsName $mag]
1433    foreach name $lst {
1434      $widget(output) insert end $name
1435    }
1436  }
1437
1438 
1439  #/////////////////////////////////////////////////////////////////////////////
1440  method _clearselection {} {
1441  #
1442  # PURPOSE: Clears selected series of series list listbox
1443  #
1444  #/////////////////////////////////////////////////////////////////////////////
1445    lbDeleteSelection $widget(output)
1446  }
1447 
1448 
1449  #/////////////////////////////////////////////////////////////////////////////
1450  method _clearall {} {
1451  #
1452  # PURPOSE: Clears all series of series list listbox
1453  #
1454  #/////////////////////////////////////////////////////////////////////////////
1455    $widget(output) deletespecial
1456  }
1457
1458
1459  #/////////////////////////////////////////////////////////////////////////////
1460  method _includeseries {} {
1461  #
1462  # PURPOSE: Includes series of series list listbox
1463  #
1464    #/////////////////////////////////////////////////////////////////////////////
1465    set max 0
1466    foreach it [$widget(output) get 0 end] {
1467        set max $max+1
1468    }
1469    ::progressbar::Show [mc "loading"] 60 2
1470    set iterador 0
1471    foreach it [$widget(output) get 0 end] {
1472      ::progressbar::SetText "[mc "Compiling serie"]: $it"
1473      set code "Anything $alg(TCL,-funAlgGetData)(\"$it\",[$self cget -def])"
1474      ::tol::console eval $code
1475      set iterador [expr $iterador+1]
1476      ::progressbar::Set [expr $iterador * 100 / ($max)]
1477    }
1478    ::TolInspector::UpdateConsoleObj
1479    ::progressbar::Destroy
1480  }
1481
1482  #/////////////////////////////////////////////////////////////////////////////
1483  method _destroy {} {
1484  #/////////////////////////////////////////////////////////////////////////////
1485    $self _writeini
1486    array unset tmp
1487    array unset alg
1488  }
1489
1490
1491  #/////////////////////////////////////////////////////////////////////////////
1492  method _writeini {} {
1493  #/////////////////////////////////////////////////////////////////////////////
1494    set wini ::iniFile::Write
1495 
1496    set options(wform)   [winfo width $widget(panel,form)]
1497    set options(wlist)   [winfo width $widget(panel,list)]
1498 
1499    $wini $data(iniEntry) wform     $options(wform)
1500    $wini $data(iniEntry) wlist     $options(wlist)
1501  }
1502
1503  #/////////////////////////////////////////////////////////////////////////////
1504  method _readini {} {
1505  #/////////////////////////////////////////////////////////////////////////////
1506    set rini ::iniFile::Read
1507    set options(wform) [$rini $data(iniEntry) wform 7]
1508    set options(wlist) [$rini $data(iniEntry) wlist 3]
1509  }
1510}
1511
1512
1513
1514
1515package provide bsersel 1.0
1516
1517# -------- TEST CODE ------
1518
1519proc test_bsersel { } {
1520  # Desde un ambito global
1521  global env
1522  source "./toltk/project.tcl"
1523  source "./toltk/iniparseBys.tcl"
1524  source "./toltk/iniFile.tcl"
1525
1526  load iniFile
1527  ::iniFile::Create [file join $env(HOME) "prueba.ini"]
1528
1529  bsersel .a -project CocaCola
1530  .a show
1531}
1532
1533#test_bsersel
Note: See TracBrowser for help on using the repository browser.