source: tol/tolbase/lib/toltk/setgraph.tcl @ 746525a

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

fix #1221, es importante mantener el orden de las columnas para poder seleccionar correctamente los pares y los impares.

Antes de pasar este fix a la version oficial 2.0.1, hay que verificar que este cambio no afecta a otra parte de tolbase.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@3574 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 38.9 KB
Line 
1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : setgraph.tcl
3# PURPOSE : This file
4#           It's a child of bayesGraph so inherites all its functionalities.
5#/////////////////////////////////////////////////////////////////////////////
6
7namespace eval ::SetGraph {
8}
9
10
11#/////////////////////////////////////////////////////////////////////////////
12proc ::SetGraph::Create {path info set tableset {fileGCF {}} {title {}}} {
13#
14# PURPOSE: Creates an instance of a bayesGraph and inserts the graph lines
15#
16# PARAMETERS:
17#   path      -> path of the graph
18#   info      -> list with info of series to graph. Has next syntax:
19#     {vectors <vectors> names <names> minX <minX> maxX <maxX> xTicks <xTicks>}
20#     where:
21#       vectors ->
22#       names   ->
23#       xTicks  ->
24#   set       -> reference to the TOL set
25#   tableset  ->
26#   fileGCF   -> file the graphic configuration file. Default ""
27#   title     -> title of chart
28#
29# RETURN: The instance of the graph.
30#
31#/////////////////////////////////////////////////////////////////////////////
32  if {[winfo exists $path] && [winfo class $path] eq "bayesGraph"} {
33    set Instance "::bayesGraph::$path"
34    set holdon 1
35  } else {
36    set Instance [::bayesGraph::Create $path g]
37    set holdon 0
38  }
39  upvar \#0 ${Instance}::widgets widgets
40  upvar \#0 ${Instance}::data data
41  upvar \#0 ${Instance}::options opt
42
43  if {!$holdon} {
44    set data(namespace) SetGraph
45    set data(proc,OnComputeStepX)  ::SetGraph::ComputeStepX
46    set data(proc,OnEvalWindow)    ::SetGraph::EvalWindow
47    set data(proc,OnToTable)       ::SetGraph::ToTable
48    set data(proc,OnWriteIni)      ::SetGraph::WriteIni
49    set data(proc,xAxisCommand)    [list ::SetGraph::GetTickLabel $Instance]
50    set data(proc,x2AxisCommand)   [list ::SetGraph::GetTickLabel $Instance]
51  }
52 
53  set gr 0
54  set grpath $widgets(gr,$gr)
55
56  #::SetGraphDialog::Init $tableset
57
58  set gInfo(vectors) ""
59  set gInfo(names)   ""
60  set gInfo(xTicks)  ""
61
62  array set gInfo $info
63
64  if {!$holdon} {
65    set data(xTicks) $gInfo(xTicks)
66   
67    set data(gr,$gr,set) $set
68    set data(gr,$gr,tableset) $tableset
69    set data(gr,$gr,OnGetXTicks)    ::SetGraph::GetXTicks 
70    set data(gr,$gr,OnGetXValues)   ::SetGraph::GetXValues 
71  }
72  # insert the series into the graph
73  if {$holdon} {
74    set ii 0
75    foreach item [$grpath element names] {
76      regexp {l(\d+)-(\d+)} $item ==> i
77      if {$i>$ii} {
78        set ii $i
79      }
80      incr ii
81    }
82  } else {
83    set ii  0
84  }
85  set i 0
86  foreach vec $gInfo(vectors) {
87    set j  0
88    set segs  {}
89
90    set xdata [lindex $vec 0]
91    set ydata [lindex $vec 1]
92
93    $grpath line create l$ii-$j -xdata $xdata -ydata $ydata
94    lappend segs l$ii-$j
95    if { $j } {
96      $grpath line configure l$i-$j -label ""
97    } else {
98      set _label_ [lindex $gInfo(names) $i]
99      foreach _it_ [$grpath element names] {
100        if {$_label_ eq [$grpath element cget $_it_ -label]} {
101          append _label_ "x"
102        }
103      }
104      $grpath line configure l$ii-0 -label $_label_
105    }
106    incr i
107    incr ii
108    lappend data(gr,$gr,elements) $segs
109  }
110  ::bayesGraph::BindLegend $Instance
111
112  if {!$holdon} {
113    # configurar grafico
114    #  $grpath axis configure x  -command "::SetGraph::GetTickLabel $Instance"
115   
116    #Establecer el fichero GCF del que se lee
117    #Establecer el fichero GCF del que se lee
118    if {[string length $fileGCF]} {
119      ::bayesGraph::LoadGCF $Instance $fileGCF
120    } else  {
121      ::bayesGraph::LoadGCF $Instance
122    }
123  }
124  ReadIni $Instance $holdon
125   
126  Configure $Instance
127 
128  if {!$holdon} {
129    #set title chart
130    if {[string length $title]} {
131      ::bayesGraph::SetMainTitle $Instance $title
132    } 
133    if {[string equal [winfo class [winfo parent $widgets(this)]] Toplevel]} {
134      wm geometry [winfo parent $widgets(this)] $data(geometry)
135      wm state    [winfo parent $widgets(this)] $data(wm,state)
136    }
137  }
138
139  return $Instance
140}
141
142
143#/////////////////////////////////////////////////////////////////////////////
144proc ::SetGraph::Configure {this} {
145#
146#/////////////////////////////////////////////////////////////////////////////
147  ::bayesGraph::Configure $this
148}
149
150
151#/////////////////////////////////////////////////////////////////////////////
152proc ::SetGraph::ComputeStepX {this min max total} {
153#
154#///////////////////////////////////////////////////////////////////////////// 
155  set step 1
156  # validamos que max y total tengan valor y min no
157  if {(![string length $min] && [string length $max] && \
158        [string length $total])} {
159    set step [expr $max / $total]
160  } elseif {([string length $min] && [string length $max] && \
161             [string length $total])} {
162    # validamos que max, min y total tengan valor
163    set step [expr ($max-$min)/$total]
164  }
165  return $step
166}
167
168
169#/////////////////////////////////////////////////////////////////////////////
170proc ::SetGraph::GetTickLabel {this bltg tick} {
171#
172#///////////////////////////////////////////////////////////////////////////// 
173  upvar \#0 ${this}::data data
174  upvar \#0 ${this}::options options
175
176  if {![string equal $data(xTicks) ""]} {
177    if {[string is int $tick]} {
178      set str [lindex $data(xTicks) $tick]
179    } else  {
180      return ""
181    }
182    set tvalue $str
183  } else {
184    set tvalue $tick
185  }
186  set gr $data(gr,active)
187  ::bayesGraph::FormatNumberAxis $options(gr,$gr,xFormatNumber) \
188      $options(gr,$gr,xFormatPercent) $bltg $tvalue
189}
190
191#/////////////////////////////////////////////////////////////////////////////
192proc ::SetGraph::GetXTicks {this} {
193#
194#///////////////////////////////////////////////////////////////////////////// 
195  upvar \#0 ${this}::data data
196  set gr $data(gr,active)
197  set values ""
198  if {![string equal $data(xTicks) ""]} {
199    set values $data(xTicks)
200  } else {
201    set limAxis [::bayesGraph::GetLimitsValueAxis $this x]
202    if {[llength $limAxis]} {
203      set minX [expr int(floor([lindex $limAxis 0]))]
204      set maxX [expr int(floor([lindex $limAxis 1]))]
205      # If the difference between the maximum and the minimum is very great,
206      # we remained with a sample
207      set inc [expr ($maxX-$minX) > 1000 ? ($maxX - $minX) / 1000 : 1]
208      for {set i $minX} {$i <= $maxX} {incr i $inc} {
209        lappend values $i
210      }
211    }   
212  }
213  return $values
214}
215
216
217#/////////////////////////////////////////////////////////////////////////////
218proc ::SetGraph::GetXValues {this} {
219#
220#///////////////////////////////////////////////////////////////////////////// 
221  upvar \#0 ${this}::data data
222  # si es unique X Axis
223  set gr $data(gr,active)
224  set values ""
225  set limAxis [::bayesGraph::GetLimitsValueAxis $this x]
226  set minX [expr int(floor([lindex $limAxis 0]))]
227  set maxX [expr int(floor([lindex $limAxis 1]))]
228  # If the difference between the maximum and the minimum is very great,
229  # we remained with a sample
230  set inc [expr ($maxX-$minX)>1000 ? ($maxX - $minX) / 1000 : 1]
231  for {set i $minX} {$i <= $maxX} {incr i $inc} {
232    lappend values $i
233  }   
234  return $values
235}
236
237
238#/////////////////////////////////////////////////////////////////////////////
239proc ::SetGraph::getSet {this} {
240#
241#///////////////////////////////////////////////////////////////////////////// 
242  upvar \#0 ${this}::data data
243
244  set gr $data(gr,active)
245  set set $data(gr,$gr,set)
246  return $set
247}
248
249
250#/////////////////////////////////////////////////////////////////////////////
251proc ::SetGraph::getTableSet {this} {
252#
253#///////////////////////////////////////////////////////////////////////////// 
254  upvar \#0 ${this}::data data
255
256  set gr $data(gr,active)
257  set tableset $data(gr,$gr,tableset)
258  return $tableset
259}
260
261
262#/////////////////////////////////////////////////////////////////////////////
263proc ::SetGraph::EvalWindow {this} {
264#
265#///////////////////////////////////////////////////////////////////////////// 
266  set grpath [::bayesGraph::getActiveGraph $this]
267  set set [getSet $this]
268  if {[llength $set] > 1} {
269    set nameSet [lindex [::tol::info variable $set] 1]
270  } else {
271    set nameSet $set
272  }
273  return $nameSet
274}
275
276
277#/////////////////////////////////////////////////////////////////////////////
278proc ::SetGraph::ToTable {this} {
279#
280#///////////////////////////////////////////////////////////////////////////// 
281  set grpath [::bayesGraph::getActiveGraph $this]
282  set set [getSet $this]
283  set tableset [getTableSet $this]
284
285  if {[llength $set] > 1} {
286    set nameSet [lindex [::tol::info variable $set] 1]
287  } else {
288    set nameSet $set
289  }
290 
291  set tl .tbl_from_$nameSet
292  if [winfo exists $tl] {
293     raise $tl
294  } else  {
295        set tl [::project::CreateForm \
296              -title    "[mc "Set table"]: $nameSet" \
297              -iniconfig Tables \
298              -type     Tables ]
299
300    $tl withdraw
301        set tlf [$tl getframe]
302    btable $tlf.t -parent $tl \
303                  -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
304                  -iniconfig btable
305    $tlf.t fillSet $tableset
306    pack $tlf.t -fill both -expand yes
307    update
308    $tl bind <Control-F4> [list $tl kill]
309        $tl restore
310  }
311}
312
313
314#/////////////////////////////////////////////////////////////////////////////
315proc ::SetGraph::ReadIni {this {holdon 0}} {
316#
317# PURPOSE: Reads set graph specific options from .ini file. First of all,
318#          reads options from BayesGraph. Ini file is the active graphic
319#          configuration file.
320#
321# PARAMETERS:
322#   this  -> Instance of BayesGraph
323#
324#/////////////////////////////////////////////////////////////////////////////
325  upvar \#0 ${this}::data data
326
327  if {!$holdon} {
328    set rini ::iniFile::ReadGCF
329    set data(geometry)   [$rini SetGraph geometry 800x600]
330    set data(wm,state)   [::iniFile::ReadWMState $rini SetGraph]
331  }
332  ::bayesGraph::ReadIni $this $holdon
333}
334
335
336#/////////////////////////////////////////////////////////////////////////////
337  proc ::SetGraph::WriteIni {this} {
338#
339# PURPOSE: Writes set graph specific options to .ini file. This procedure
340#          is called by parent BayesGraph. Ini file is the active graphic
341#          configuration file.
342#
343# PARAMETERS:
344#   this  -> Instance of BayesGraph
345#
346#/////////////////////////////////////////////////////////////////////////////
347  upvar \#0 ${this}::data data
348  upvar \#0 ${this}::widgets widgets
349
350  set wini ::iniFile::WriteGCF
351
352  if {[string equal [winfo class [winfo parent $widgets(this)]] Toplevel]} {
353    set data(geometry) [wm geometry [winfo parent $widgets(this)]]
354    set data(wm,state) [wm state    [winfo parent $widgets(this)]]
355  }
356  $wini SetGraph geometry $data(geometry)
357  $wini SetGraph wm,state $data(wm,state)
358}
359
360
361#/////////////////////////////////////////////////////////////////////////////
362  namespace eval ::SetGraphDialog {
363# PURPOSE: The purpose of this namespace is to manage the columns selecting
364#          process of a set.
365#
366# VARIABLES:
367#   tmpOpt -> temporary array used to store the widgets and variables of the
368#             assistant.
369#   data   -> array used to store information about the set and its columns
370#     tableset     -> command of the set
371#     names        -> list with names of the elements selected for drawing
372#     vectors      -> list with pairs
373#     nameVectors  -> list with vector names created when partition is
374#                     necessary and when a type 2 column is choosen for x-axis
375#     xTicks       -> list with ticks of the x values when a type 2 column is
376#                     choosen for x-axis
377#     selected     -> temporary list with the pair of x-y columns selected for
378#                     drawing
379#     uniqueXAxis  -> flag that indicates if the user has choosen an element
380#                     which X data comes from a type 2 column. (if so, it
381#                     stores the column's index in the set)
382#     infoCols     -> array with information of '$tableset info columns'
383#                     command.
384#     idxColsType1 -> list of type 1 column's indexes in the set
385#     idxColsType2 -> list of type 2 column's indexes in the set
386#     idxColsType3 -> list of type 3 column's indexes in the set
387#     idxColsType4 -> list of type 4 column's indexes in the set
388#
389#/////////////////////////////////////////////////////////////////////////////
390  variable tmpOpt
391  variable data
392}
393
394#/////////////////////////////////////////////////////////////////////////////
395  proc ::SetGraphDialog::InitData {tableset} {
396#
397# PURPOSE: Checks if the set is graphicable and if so, draws and assistant
398#          that allows to choose x and y columns for the elements to draw.
399#
400# PARAMETERS:
401#   tableset -> command of the set
402#
403#/////////////////////////////////////////////////////////////////////////////
404  variable data
405
406  set data(tableset)    $tableset
407  set data(names)       ""
408  set data(vectors)     ""
409  set data(nameVectors) ""
410
411  set data(xTicks)      ""
412  set data(selected)    ""
413  set data(uniqueXAxis) ""
414
415  set data(firstcolumn) {}
416
417  GetColTypes $tableset
418}
419     
420#/////////////////////////////////////////////////////////////////////////////
421proc ::SetGraphDialog::DrawSet {path tableset set type {pairs {}} {names {}} {fileGCF {}} {title {}}} {
422#
423# PURPOSE: Checks if the set is graphicable and if so, draws and assistant
424#          that allows to choose x and y columns for the elements to draw.
425#
426# PARAMETERS:
427#   path     -> path of the blt graph
428#   tableset -> command of the set
429#   set      -> reference to the TOL set
430#   type     -> 0 for custom association of data columns
431#            -> 1 for all data columns to first one
432#            -> 2 for all data columns to generic
433#            -> 3 for even data columns to odd ones
434#   pairs    -> when type is 0 pairs is the list of correspondence beetwen index
435#               columns to data columns (x-y pairs)
436#   names    -> names for the series/points,..
437#   fileGcf  -> file configuration graph
438#   title    -> list of title of chart
439#   holdon   -> tell if the new graph goes into a new context or an existing one
440#
441#/////////////////////////////////////////////////////////////////////////////
442  variable data
443
444  ::SetGraphDialog::InitData $tableset
445
446  switch [CheckGraphicable] {
447    0 {
448      tk_messageBox -type ok -icon warning -title [mc Warning]\
449          -message [mc "Set not graphicable"]
450      return 0
451    }
452    1 {
453      # fill listX and listY
454      ::SetGraphDialog::SetDataVarList
455      switch $type {
456        0 {
457          # custom
458          set lstLines {}
459          set len [llength $pairs]
460          for {set i 0} {[expr $i < $len]} {incr i} {
461            set xy   [lindex $pairs $i]
462            set name [lindex $names $i]
463            if {![string length $name]} {
464              set name "Column [expr $i + 1]"
465            }
466            lappend lstLines [::SetGraphDialog::AddLine \
467              [expr [lindex $xy 0] - 1] \
468              [expr [lindex $xy 1] - 1] \
469              $name          \
470              $lstLines]
471          }
472        }
473        1 {
474          # all to one
475          ::SetGraphDialog::GrapthAllLine 1 0 $names
476        }
477        2 {
478          # all to generic
479          ::SetGraphDialog::GrapthAllLine 0 0 $names
480        }
481        3 {
482          # even to odd
483          ::SetGraphDialog::GrapthEvenUneven $names
484        }
485      }
486      # build info to graph
487      if [llength $data(selected)] {
488        ::SetGraphDialog::SetSelection
489        set info [list vectors $data(vectors) names $data(names) xTicks $data(xTicks)]
490        set instance [::SetGraph::Create $path $info $set $tableset $fileGCF $title]
491        bind $path <Destroy> +[list ::SetGraphDialog::OnDestroyGraph $data(nameVectors)]
492        return $instance
493      } else {
494        set msg [mc "Series do not exist that to draw"]
495        ::TolConsole::HciWriter "<W>$msg</W>"
496      }
497    }
498  }
499}
500
501#/////////////////////////////////////////////////////////////////////////////
502  proc ::SetGraphDialog::Init {path tableset set} {
503#
504# PURPOSE: Checks if the set is graphicable and if so, draws and assistant
505#          that allows to choose x and y columns for the elements to draw.
506#
507# PARAMETERS:
508#   path     -> path of the blt graph
509#   tableset -> command of the set
510#   set      -> reference to the TOL set
511#
512#/////////////////////////////////////////////////////////////////////////////
513  variable data
514
515  ::SetGraphDialog::InitData $tableset
516
517  switch [CheckGraphicable] {
518    0 {
519      tk_messageBox -type ok -icon warning -title [mc Warning]\
520          -message [mc "Set not graphicable"]
521      return 0
522    }
523    1 {
524      DrawDialog
525      if [llength $data(vectors)] {
526        set info [list vectors $data(vectors) names $data(names) xTicks $data(xTicks)]
527        set Instance [::SetGraph::Create $path $info $set $tableset]
528        bind $path <Destroy> +[list ::SetGraphDialog::OnDestroyGraph $data(nameVectors)]
529        return $Instance
530      } else {
531        return 0
532      }
533    }
534  }
535}
536
537
538#/////////////////////////////////////////////////////////////////////////////
539proc ::SetGraphDialog::OnDestroyGraph {list} {
540#
541#///////////////////////////////////////////////////////////////////////////// 
542  if [llength $list] {
543    eval blt::vector destroy $list
544  }
545}
546
547#/////////////////////////////////////////////////////////////////////////////
548  proc ::SetGraphDialog::GetColTypes {tableset} {
549#
550# PURPOSE: Extracts information about the types of the columns of the tableset
551#          and stores this in the 'data' array of the namespace. There are
552#          four types of columns:
553#            1- Graficable in X and Y axis (Real without ? or Inf)
554#            2- Graficable only in X axis  (Text or Date)
555#            3- Graficable only in Y axis  (Real with ?)
556#            4- Not graficable             (Real with Inf)
557#
558# PARAMETERS:
559#   tableset  -> command of the tableset
560#
561#/////////////////////////////////////////////////////////////////////////////
562
563  variable data
564
565  set idx 0
566  for {set i 1} {$i <= 4} {incr i} {
567    set data(idxColsType$i) ""
568    set data(nameColsType$i) ""
569  }
570  foreach it [$tableset info columns] {
571    foreach {key value} $it {
572      set data(infCols,$idx,$key) $value
573    }
574    switch -- $data(infCols,$idx,type) {
575      Date -
576      Text {
577        # first column
578        if {![info exists data(firstcolumn)] || ![string length $data(firstcolumn)]} {
579          set data(firstcolumn) $idx
580        }
581
582        lappend data(idxColsType2) $idx
583      }
584      Real {
585        # first column
586        if {![info exists data(firstcolumn)] || ![string length $data(firstcolumn)]} {
587          set data(firstcolumn) $idx
588        }
589        if {$data(infCols,$idx,infinity)} {
590          lappend data(idxColsType4) $idx
591#         lappend data(idxColsType1) $idx
592        } elseif {$data(infCols,$idx,unknown)} {
593          lappend data(idxColsType3) $idx
594        } else {
595          lappend data(idxColsType1) $idx
596        }
597      }
598    }
599    incr idx
600  }
601}
602
603#/////////////////////////////////////////////////////////////////////////////
604  proc ::SetGraphDialog::CheckGraphicable {} {
605#
606# PURPOSE: Check if the set is graphicable and returns a code
607#
608# RETURN:
609#    0 if the set isn't graphicable
610#    1 if there are some posibilities for choosing columns (assistant will be
611#   drawn)
612#/////////////////////////////////////////////////////////////////////////////
613  variable data
614
615  #Para poder graficar =>
616  # debe haber al menos una col. tipo 1 o 2 y al menos otra col. tipo 1 o 3.
617  set tot1 [llength $data(idxColsType1)]
618  set tot2 [llength $data(idxColsType2)]
619  set tot3 [llength $data(idxColsType3)]
620  if { ([expr $tot1 + $tot2] >= 1) && ([expr $tot1 + $tot3] >= 1) } {
621    return 1
622  } else  {
623    return 0
624  }
625}
626
627#/////////////////////////////////////////////////////////////////////////////
628  proc ::SetGraphDialog::DrawDialog {} {
629#
630# PURPOSE: Draw an assistant to select the columns to plot
631#
632#/////////////////////////////////////////////////////////////////////////////
633  variable data
634  variable tmpOpt
635
636  set dialog [Dialog .t -title [mc "Columns Selector"] -separator yes\
637                -modal local -parent .]
638  set tmpOpt(dialog) $dialog
639
640  wm protocol $dialog WM_DELETE_WINDOW [list ::SetGraphDialog::Cancel $dialog]
641  set w [$dialog getframe]
642
643  set f1 [frame $w.f1]
644 
645  # fill listX and listY
646  ::SetGraphDialog::SetDataVarList
647
648  set values ""
649  set lst    ""
650  foreach it $data(var,listX) {
651    lappend values [lindex $it 1]
652    lappend lst    [lindex $it 0]
653  }
654  label $f1.lXAxis -text [mc "X Values"]:
655  set tmpOpt(widget,cbXAxis) [ComboBox $f1.cbXAxis -width 16 -height 5\
656     -editable false -justify right\
657     -values $values\
658     -modifycmd  [list ::SetGraphDialog::OnModifyXValues $lst ]]
659
660  set values ""
661  set lst    ""
662  foreach it $data(var,listY) {
663    lappend values [lindex $it 1]
664    lappend lst    [lindex $it 0]
665  }
666
667  label $f1.lInfoSelect -text [mc "Select series"]:
668  label $f1.lYAxis      -text [mc "Y Values"]:
669  set tmpOpt(widget,cbYAxis) [ComboBox $f1.cbYAxis -width 16 -height 5\
670     -editable false -justify right\
671     -values $values\
672     -modifycmd  [list ::SetGraphDialog::OnModifyYValues $lst ]]
673  label $f1.lName -text [mc Name]:
674  set tmpOpt(widget,eName) [entry $f1.eName -width 18]
675
676  grid $f1.lInfoSelect   -           -sticky nws -pady 2
677  grid $f1.lXAxis        $f1.cbXAxis -sticky news -pady 2
678  grid $f1.lYAxis        $f1.cbYAxis -sticky news -pady 2
679  grid $f1.lName         $f1.eName   -sticky news -pady 2
680
681  grid rowconfigure    $f1 4 -weight 1
682  grid columnconfigure $f1 1 -weight 1
683
684  set f2 [frame $w.f2]
685  label $f2.lSeries -text [mc "Series to draw"]:
686
687  set tmpOpt(widget,lbSeries) [blistboxplus $f2.lb \
688    -selectmode multiple -nomenu true \
689    -cols { lines } \
690    -readonly false -parent $f2 -orientation vertical]
691  bind $tmpOpt(widget,lbSeries) <Button-1> +[list focus -force %W]
692
693  button $f2.bAdd -width 6 -text [mc Add]    -command ::SetGraphDialog::AddItem
694  button $f2.bDel -width 6 -text [mc Delete] -command ::SetGraphDialog::DelItem
695
696  grid $f2.lSeries  -     -sticky nw    -pady 0
697  grid $f2.lb       -     -sticky news  -pady 0
698  grid $f2.bAdd $f2.bDel -sticky new   -pady 0
699
700  grid rowconfigure    $f2 1 -weight 1
701  grid columnconfigure $f2 0 -weight 1
702  grid columnconfigure $f2 1 -weight 1
703
704  # options advanced
705  TitleFrame $w.f3 -text [mc "Automatic generation"] 
706  set f3 [$w.f3 getframe]
707
708  radiobutton $f3.rbAllFirst -text [mc SetGraphAllFirst] \
709     -value f -highlightthickness 0 -pady 0 \
710     -variable ::SetGraphDialog::data(var,genAut)
711  DynamicHelp::add $f3.rbAllFirst -text [mc SetGraphAllFirstHint]
712  radiobutton $f3.rbAllGeneric -text [mc SetGraphAllGeneric] \
713     -value g -highlightthickness 0 -pady 0\
714     -variable ::SetGraphDialog::data(var,genAut)
715  DynamicHelp::add $f3.rbAllGeneric -text [mc SetGraphAllGenericHint]
716  radiobutton $f3.rbEvenUneven -text [mc SetGraphEvenUneven] \
717     -value e -highlightthickness 0 -pady 0 \
718     -variable ::SetGraphDialog::data(var,genAut)
719  DynamicHelp::add $f3.rbEvenUneven -text [mc SetGraphEvenUnevenHint]
720  Button $f3.bAddGenAut -text [mc Add] \
721    -width 6 -command [list ::SetGraphDialog::AddGenAut]
722
723  grid $f3.rbAllFirst    -              -sticky nws  -pady 1
724  grid $f3.rbAllGeneric  -              -sticky nws  -pady 1
725  grid $f3.rbEvenUneven  $f3.bAddGenAut -sticky nws  -pady 1
726
727  grid rowconfigure    $f3 0 -weight 1
728  grid rowconfigure    $f3 1 -weight 1
729  grid rowconfigure    $f3 2 -weight 1
730  grid columnconfigure $f3 0 -weight 1
731
732  set w_bbox \
733    [ButtonBox $w.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
734    -homogeneous false]
735  $w_bbox add -text [mc "Accept"] -relief link \
736    -helptext [mc "Accept"] \
737    -image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
738    -command [list ::SetGraphDialog::Finish $dialog]
739  $w_bbox add -text [mc "Cancel"] -relief link \
740    -helptext [mc "Cancel"]\
741    -image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \
742    -command [list ::SetGraphDialog::Cancel $dialog]
743 
744  grid $f1   $f2 -sticky news
745  grid $w.f3 -   -sticky news
746  grid $w_bbox -   -sticky news
747
748  grid rowconfigure    $w 0 -weight 1
749  grid columnconfigure $w 0 -weight 1
750  grid columnconfigure $w 1 -weight 3
751
752  bind $dialog <F1> "ShowHelp Tb4GraSetSel"
753  $dialog draw
754}
755
756#/////////////////////////////////////////////////////////////////////////////
757  proc ::SetGraphDialog::SetDataVarList {} {
758#
759# PURPOSE: Fill varible data(var,listX) and data(var,listY)
760#
761#/////////////////////////////////////////////////////////////////////////////
762  variable data
763
764  # fill data(var,listX)
765  set data(var,listX) {}
766
767  set data(var,listX) \
768    [list [list -1 "<Generic 1-[$data(tableset) info datarows]>"]]
769
770  foreach it [concat $data(idxColsType2) $data(idxColsType1)] {
771    lappend data(var,listX) [list $it $data(infCols,$it,name)]
772  }
773
774  if {![string equal [$data(tableset) info header] "generic"] } {
775    set data(var,listX) [lsort -index 1 $data(var,listX)]
776  }
777  #set data(var,listX) [lsort $data(var,listX)] 
778
779  # fill data(var,listY)
780  set data(var,listY) {}
781  foreach it [concat $data(idxColsType1) $data(idxColsType3)] {
782    lappend data(var,listY) [list $it $data(infCols,$it,name)]
783  }
784  if {![string equal [$data(tableset) info header] "generic"] } {
785    set data(var,listY) [lsort -index 1 $data(var,listY)]
786  }
787  #set data(var,listY) [lsort $data(var,listY)]
788}
789
790
791#/////////////////////////////////////////////////////////////////////////////
792  proc ::SetGraphDialog::AddGenAut {} {
793#
794# PURPOSE: Control de la opción seleccionada para la generacion automatica de
795#          series
796#
797#/////////////////////////////////////////////////////////////////////////////
798  variable data
799  switch -exact $data(var,genAut) {
800    f {
801      ::SetGraphDialog::GrapthAllLine 1 0
802    }
803    g {
804      ::SetGraphDialog::GrapthAllLine 0 0
805    }
806    e {
807      ::SetGraphDialog::GrapthEvenUneven
808    }
809  }
810}
811
812
813#/////////////////////////////////////////////////////////////////////////////
814  proc ::SetGraphDialog::GrapthAllLine {indexX rangeY {names {}}} {
815#
816# PURPOSE: Seleccionamos todas las series contra una de ellas
817#
818# PARAMETERS: indexX -> Indice en X con el que se cruzan las demas columnas
819#             rangeY -> Rango inicial de columnas a usar en Y
820#
821#/////////////////////////////////////////////////////////////////////////////
822  variable tmpOpt
823  variable data
824  # first line ?
825  if {[expr $indexX == 1]} {
826    set firLinX $data(firstcolumn)
827  } else {
828    set firLinX [lindex [lindex $data(var,listX) $indexX] 0]
829  }
830  # control: uniqueXAxis
831  set ok [::SetGraphDialog::CheckAddSerie $firLinX]
832  if {!$ok} {
833    if {[info exists tmpOpt(dialog)]} {
834      set parent $tmpOpt(dialog)
835    } else {
836      set parent .
837    }
838    set parent 
839    set msg "[mc {Item not selectionable}].\n[mc UniqueXAxis]"
840    tk_messageBox -type ok -icon warning -message $msg\
841                  -parent $parent        -title [mc Warning]
842  } else {
843    # find line axis X ?
844    if {([lindex $firLinX 0]==-1) ||
845        ([lsearch -exact $data(idxColsType1) $firLinX]!=-1) ||
846        ([lsearch -exact $data(idxColsType2) $firLinX]!=-1)} {
847      # remove first line
848      set row 0
849      set lst [lrange $data(var,listY) $rangeY end]
850      foreach it $lst {
851        # line is graph Y ?
852        if {([lsearch -exact $data(idxColsType1) [lindex $it 0]]!=-1) ||
853            ([lsearch -exact $data(idxColsType3) [lindex $it 0]]!=-1)} {
854          if {![string equal $firLinX [lindex $it 0]]} {             
855            set name [lindex $names $row]
856            if {![string length $name]} {
857              set name [lindex $it 1]
858            }
859            lappend data(selected) [list $firLinX [lindex $it 0] $name]
860            if {([info  exists  tmpOpt(widget,lbSeries)]) && \
861                ([winfo exists $tmpOpt(widget,lbSeries)])} {
862              $tmpOpt(widget,lbSeries) insert end \
863                [list "$name ( X: $firLinX Y: [lindex $it 0] )"]
864            }
865            incr row           
866          }
867        } else {
868        # no se puede graficar
869Tolcon_Trace "Y. No se puede graficar: $it" 
870        }
871      }
872    } else {
873    # No se puede graficar
874Tolcon_Trace "X. No se puede graficar [lindex $data(var,listX) $indexX]: $firLinX"
875    }
876  }
877}
878
879
880#/////////////////////////////////////////////////////////////////////////////
881  proc ::SetGraphDialog::GrapthEvenUneven {{names {}}} {
882#
883# PURPOSE: Seleccionamos las serie impar contr la impar y las agregamos
884#          a la lista series a dibujar. Por ejemplo 1-2, 3-4, 5-6
885#
886#/////////////////////////////////////////////////////////////////////////////
887  variable tmpOpt
888  variable data
889  # travel all columuns
890  #puts "DEBUG: ::SetGraphDialog::GrapthEvenUneven"
891  set row 0
892  for {set i 0} {$i<[expr [llength $data(var,listY)] - 1]} {incr i 2} {
893    set colX [lindex [lindex $data(var,listY) $i] 0]
894    set colY [lindex $data(var,listY) [expr $i + 1]]
895    # control: uniqueXAxis
896    set ok [::SetGraphDialog::CheckAddSerie $colX]
897    if {$ok} {
898      # find line axis X ?
899      if {([lsearch -exact $data(idxColsType1) $colX]!=-1) ||
900          ([lsearch -exact $data(idxColsType2) $colX]!=-1)} {
901        # line is graph Y ?
902        if {([lsearch -exact $data(idxColsType1) [lindex $colY 0]]!=-1) ||
903            ([lsearch -exact $data(idxColsType3) [lindex $colY 0]]!=-1)} {
904          set name [lindex $names $row]
905          if {![string length $name]} {
906            set name [lindex $colY 1]
907          }
908          lappend data(selected) [list $colX [lindex $colY 0] $name]
909          if {(([info  exists  tmpOpt(widget,lbSeries)]) && \
910               ([winfo exists $tmpOpt(widget,lbSeries)]))} {
911            $tmpOpt(widget,lbSeries) insert end \
912              [list "$name ( X: $colX Y: [lindex $colY 0] )"]
913          }
914        } else {
915          # no se puede graficar
916Tolcon_Trace "Y. No se puede graficar: $colY" 
917        }
918      } else {
919      # No se puede graficar
920Tolcon_Trace "X. No se puede graficar: $colX"
921      }
922    }
923    incr row
924  }
925}
926
927
928#/////////////////////////////////////////////////////////////////////////////
929  proc ::SetGraphDialog::CheckAddSerie {indexX} {
930#
931# PURPOSE: Comprobamos si una serie se puede anhadir a la lista de seleccion
932#
933# PARAMETERS: indexX -> index column X
934#
935# RETURN: true  -> ok
936#         false -> not added
937#
938#/////////////////////////////////////////////////////////////////////////////
939  variable data
940  set ok 1
941  # si el elemento que intento insertar es de tipo 2
942  if {[string length $data(uniqueXAxis)]} {
943    if {$data(uniqueXAxis)!=$indexX} {
944      set ok 0
945    }
946  } else {
947    if {[string length $data(selected)]} {
948      if {[lsearch -exact $data(idxColsType1) $indexX] == -1} {
949        # trere are items selection with type 1
950        set ok 0
951      }
952    } else {
953      if {($indexX==-1) ||
954          ([lsearch -exact $data(idxColsType2) $indexX] != -1)} {
955        set data(uniqueXAxis) $indexX
956      } else {
957        # Type 1
958      }
959    }
960  }
961  return $ok
962}
963
964
965#/////////////////////////////////////////////////////////////////////////////
966  proc ::SetGraphDialog::OnModifyXValues {list} {
967#
968# PURPOSE: Update variable tmpOpt(var,cbXAxis) with the index of the column
969#          when combo that shows names of possible X columns is changed
970#
971# PARAMETERS:
972#   list -> list of tranlated values (indexes) of the columns names
973#
974#/////////////////////////////////////////////////////////////////////////////
975  variable tmpOpt
976
977  ::Objects::ComboUnTranslate $tmpOpt(widget,cbXAxis) $list\
978      ::SetGraphDialog::tmpOpt(var,cbXAxis)
979}
980
981#/////////////////////////////////////////////////////////////////////////////
982  proc ::SetGraphDialog::OnModifyYValues {list} {
983#
984# PURPOSE: Update variable tmpOpt(var,cbYAxis) with the index of the column
985#          when combo that shows names of possible Y columns is changed.
986#          It also changes the default name of the element
987#
988# PARAMETERS:
989#   list -> list of tranlated values (indexes) of the columns names
990#
991#/////////////////////////////////////////////////////////////////////////////
992  variable tmpOpt
993
994  ::Objects::ComboUnTranslate $tmpOpt(widget,cbYAxis) $list\
995      ::SetGraphDialog::tmpOpt(var,cbYAxis)
996  CheckName
997}
998
999
1000#/////////////////////////////////////////////////////////////////////////////
1001  proc ::SetGraphDialog::CheckName {} {
1002#
1003# PURPOSE: Sets the element's default name to the y column's name
1004#
1005#/////////////////////////////////////////////////////////////////////////////
1006
1007  variable tmpOpt
1008  $tmpOpt(widget,eName) delete 0 end
1009  $tmpOpt(widget,eName) insert 0 [$tmpOpt(widget,cbYAxis) cget -text]
1010}
1011
1012
1013#/////////////////////////////////////////////////////////////////////////////
1014  proc ::SetGraphDialog::AddItem {} {
1015#
1016# PURPOSE:  Adds a element to the selected series listbox checking if it can
1017#          be added.
1018#
1019#/////////////////////////////////////////////////////////////////////////////
1020  variable tmpOpt
1021  variable data
1022  if { [$tmpOpt(widget,cbXAxis) getvalue] == -1} {
1023    tk_messageBox -type ok -icon warning -message [mc "You must fill X Values"]\
1024                  -parent $tmpOpt(dialog) -title [mc Warning]
1025    return
1026  }
1027  if { [$tmpOpt(widget,cbYAxis) getvalue] == -1} {
1028    tk_messageBox -type ok -icon warning -message [mc "You must fill Y Values"]\
1029                  -parent $tmpOpt(dialog) -title [mc Warning]
1030    return
1031  }
1032  if {[string equal [$tmpOpt(widget,eName) get] ""]} {
1033    tk_messageBox -type ok -icon warning -message [mc "You must specify a name"]\
1034                  -parent $tmpOpt(dialog) -title [mc Warning]
1035    return
1036  }
1037 
1038  #  uniqueXAxis es un flag que indica que se ha elegido un elemento cuyos datos
1039  # en X provienen de una columna de tipo 2 (guardamos su indice)
1040  #  En los comentarios de este bloque diremos que un elemento es de tipo 2 si sus
1041  # datos para el eje X provienen de una columna tipo 2 (solo graficable en X)
1042
1043  # lst names
1044  set lstNames {}
1045  set inx [$tmpOpt(widget,lbSeries) get 0 end]
1046  foreach it $inx {
1047    lappend lstNames [$tmpOpt(widget,lbSeries) get $it]
1048  }
1049  set name [::SetGraphDialog::AddLine \
1050    $tmpOpt(var,cbXAxis) \
1051    $tmpOpt(var,cbYAxis) \
1052    [$tmpOpt(widget,eName) get]        \
1053    $lstNames]
1054  if {[string length $name]} {
1055    $tmpOpt(widget,lbSeries) insert end [list $name]
1056  }
1057}
1058
1059#/////////////////////////////////////////////////////////////////////////////
1060  proc ::SetGraphDialog::AddLine {colX colY name lstLines} {
1061#
1062# PURPOSE:  Adds a element to the selected series listbox checking if it can
1063#          be added.
1064#
1065#/////////////////////////////////////////////////////////////////////////////
1066  variable tmpOpt
1067  variable data
1068  # parent ?
1069  if {[info exists tmpOpt(dialog)]} {
1070    set parent $tmpOpt(dialog)
1071  } else {
1072    set parent .
1073  }
1074  # uniqueXAxis es un flag que indica que se ha elegido un elemento cuyos
1075  #  datos en X provienen de una columna de tipo 2 (guardamos su indice)
1076  # En los comentarios de este bloque diremos que un elemento es de tipo 2 si
1077  #  sus datos para el eje X provienen de una columna tipo 2
1078  #  (solo graficable en X)
1079
1080  # si no hay ningun elemento tipo 2
1081  if {[string equal $data(uniqueXAxis) ""]} {
1082    # si el elemento que intento insertar es de tipo 2
1083    if {(($colX == -1) ||
1084         ([lsearch -exact $data(idxColsType2) $colX] != -1))} {
1085      # si no hay ningún elemento insertado
1086      if {[llength $lstLines]} {
1087        set msg "[mc {Item not selectionable}].\n[mc UniqueXAxis]"
1088        tk_messageBox -type ok -icon warning -message $msg\
1089             -parent $parent -title [mc Warning]
1090        return {}
1091      } else {
1092        set data(uniqueXAxis) $colX
1093      }
1094    }
1095  # si ya hay algún elemento tipo 2
1096  } else {
1097    # si el que intento insertar no es el mismo que el que ya hay
1098    if { ![string equal $data(uniqueXAxis) $colX] } {
1099      set msg "[mc {Item not selectionable}].\n[mc UniqueXAxis]"
1100      tk_messageBox -type ok -icon warning -message $msg\
1101                    -parent $parent -title [mc Warning]
1102      return {}
1103    }
1104  }
1105
1106  if {[lsearch $name $lstLines] != -1} {
1107    tk_messageBox -type ok -icon warning\
1108        -parent $parent -title [mc Warning]\
1109        -message [mc "You have added another serie with this name"]
1110#    return {}
1111  }
1112  lappend data(selected) [list $colX $colY $name]
1113  return "$name ( X: $colX Y: $colY )"
1114}
1115
1116#/////////////////////////////////////////////////////////////////////////////
1117  proc ::SetGraphDialog::DelItem {} {
1118#
1119# PURPOSE: Deletes an elements selected from the selected series listbox
1120#
1121#/////////////////////////////////////////////////////////////////////////////
1122  variable tmpOpt
1123  variable data
1124  set idx [$tmpOpt(widget,lbSeries) curselection]
1125  if {![llength $idx]} {
1126    tk_messageBox -type ok -icon warning -message [mc "You must select a serie"]\
1127                  -parent $tmpOpt(dialog) -title [mc Warning]   
1128  } else {
1129    set ids [lsearch -all -regexp [$tmpOpt(widget,lbSeries) get] \
1130      [join [ListToStr $idx " " ^ $] |]]
1131    for {set i [expr [llength $ids] - 1]} {[expr $i >= 0]} { incr i -1} {
1132      set id [lindex $ids $i]
1133      set data(selected) [lreplace $data(selected) $id $id]
1134    }
1135    foreach id $idx {
1136      $tmpOpt(widget,lbSeries) delete $id
1137    }
1138    # si eliminamos todos los elementos
1139    if {[$tmpOpt(widget,lbSeries) size]==0} {
1140      set data(uniqueXAxis) ""
1141    }
1142  }
1143}
1144
1145#/////////////////////////////////////////////////////////////////////////////
1146  proc ::SetGraphDialog::Finish {dialog} {
1147#
1148# PURPOSE: Creates the blt vectors acording to the columns selection done by
1149#          the user. It also get the maximun and minimun x value of the
1150#          selected series
1151#
1152# PARAMETERS:
1153#   dialog   -> path of the dialog
1154#
1155#/////////////////////////////////////////////////////////////////////////////
1156  ::SetGraphDialog::SetSelection
1157  Cancel $dialog
1158}
1159
1160#/////////////////////////////////////////////////////////////////////////////
1161  proc ::SetGraphDialog::SetSelection {} {
1162#
1163# PURPOSE: Creates the blt vectors acording to the columns selection done by
1164#          the user. It also get the maximun and minimun x value of the
1165#          selected series
1166#
1167# PARAMETERS:
1168#
1169#/////////////////////////////////////////////////////////////////////////////
1170  variable tmpOpt
1171  variable data
1172 
1173  #puts "DEBUG: ::SetGraphDialog::SetSelection"
1174  set colX [lindex [lindex $data(selected) 0] 0]
1175  # Si la columna que fija el X del primer elemento es genérica o de tipo 2
1176  # (será la misma para todas)
1177  if {($colX == -1) || ([lsearch -exact $data(idxColsType2) $colX] != -1)} {
1178    for {set i 0} {$i < [$data(tableset) info datarows]} {incr i} {
1179      lappend lst $i
1180    }
1181    if {($colX != -1)} {
1182      set data(xTicks) [$data(tableset) data column $colX]
1183    }
1184    set uniqueXAxis 1
1185  } else  {
1186    set uniqueXAxis 0
1187  }
1188
1189  # cross the selection
1190  foreach it $data(selected) {
1191    set colX [lindex $it 0]
1192    set colY [lindex $it 1]
1193    set name [lindex $it 2]
1194    if {$uniqueXAxis} {
1195      set vecX $lst
1196    } else {
1197      set vecX  [$data(tableset) data column $colX]
1198    }
1199    set vecsY [$data(tableset) data column $colY]
1200    if {[llength $vecsY] > 1} {
1201      set i 0
1202      set subVectors ""
1203      set lstX {}
1204      set lstY {}
1205      foreach item $vecsY {
1206        #si no es un omitido (vacio o ?)
1207        if {[string equal $item ""] || [string equal $item "?"]} {
1208          incr i
1209        } else  {
1210          set datX [lindex $vecX $i]
1211          lappend lstX $datX
1212          lappend lstY $item
1213          incr i
1214        }
1215      }
1216      lappend data(vectors) [list $lstX $lstY]
1217    } else {
1218      lappend data(vectors) [list [list $vecX $vecsY]]
1219    }
1220    lappend data(names) $name
1221  }
1222}
1223
1224
1225#/////////////////////////////////////////////////////////////////////////////
1226  proc ::SetGraphDialog::Cancel {dialog} {
1227#
1228# PURPOSE: Destroy the dialog
1229#
1230# PARAMETERS:
1231#   dialog   -> path of the dialog
1232#
1233#/////////////////////////////////////////////////////////////////////////////
1234  destroy $dialog
1235}
Note: See TracBrowser for help on using the repository browser.