source: tol/tolbase/lib/byswidget/bsersel/bsersel.tcl @ 20907d9

1941-docker-image-to-testdevel
Last change on this file since 20907d9 was 20907d9, checked in by Pedro Gea <pgea@…>, 10 years ago

Refs #1933
Se prescinde de BLT en algunos widgets.
Otros que no se han convertido se marcan como obsoletos.

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