source: tol/tolbase/lib/toltk/sergraph.tcl @ 1e43dec

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

fixes #1630, a aplica un ZoomExtend

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@5526 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 50.1 KB
Line 
1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : sergraph.tcl
3# PURPOSE : This file
4#           It's a child of bayesGraph so inherites all its functionalities.
5#/////////////////////////////////////////////////////////////////////////////
6
7package require bcolor
8package require bmultiselect
9
10namespace eval ::SeriesGraph {
11  variable tmpOpt
12}
13
14proc ::SeriesGraph::ShowSerieInfo { Instance graph x y } {
15  upvar \#0 ${Instance}::widgets widgets
16  upvar \#0 ${Instance}::data data
17 
18  if ![$graph element closest $x $y info -interpolate yes] {
19    beep
20    return
21  }
22  parray info
23}
24
25proc ::SeriesGraph::BindSerieInfo { Instance } {
26  upvar \#0 ${Instance}::widgets widgets
27  upvar \#0 ${Instance}::data data
28
29  set graph $widgets(gr,0)
30  bind closest-point-$graph <Control-ButtonPress-2>  \
31      [ string map [list %I $Instance] {
32        ::SeriesGraph::ShowSerieInfo %I %W %x %y
33      } ]
34  blt::AddBindTag $graph closest-point-$graph
35 
36}
37
38#/////////////////////////////////////////////////////////////////////////////
39proc ::SeriesGraph::Create { path list args } {
40#
41# PURPOSE:
42#     
43# PARAMETERS:
44#   path
45#   this -> bayesgraph instance
46#   structure ->
47#   fileGCF -> file the graphic configuration file. Default ""
48#
49#/////////////////////////////////////////////////////////////////////////////
50#puts "SeriesGraph::Create path=$path list=$list args=$args ........"
51  array set opts {
52    -struct g
53    -fileGCF ""
54    -photo 0
55    -title {}
56  }
57  array set opts $args
58  set t0 [time {
59  set Instance [::bayesGraph::Create $path $opts(-struct) -photo $opts(-photo)]
60  }]
61  puts "time in ::bayesGraph::Create = $t0"
62  upvar \#0 ${Instance}::widgets widgets
63  upvar \#0 ${Instance}::data data
64
65  #::SeriesGraph::BindSerieInfo $Instance
66  #Blt_ClosestPoint $widgets(gr,0)
67
68  set data(namespace)            SeriesGraph
69  set data(proc,OnGetLabel)      ::SeriesGraph::GetLabel
70  set data(proc,OnOptionCreate)  ::SeriesGraph::OptionsCreate
71  set data(proc,OnOptionDestroy) ::SeriesGraph::OptionsDestroy
72  set data(proc,OnOptionApply)   ::SeriesGraph::OptionsApply
73  set data(proc,OnComputeStepX)  ::SeriesGraph::ComputeStepX
74  set data(proc,OnFixStepX)      ::SeriesGraph::FixStepX
75  set data(proc,OnEvalWindow)    ::SeriesGraph::EvalWindow
76  set data(proc,OnToTable)       ::SeriesGraph::ToTable
77  set data(proc,OnWriteIni)      ::SeriesGraph::WriteIni
78  set data(proc,xAxisCommand)    [list ::SeriesGraph::GetTickLabel $Instance]
79  set data(proc,x2AxisCommand)   [list ::SeriesGraph::GetTickLabel $Instance] 
80
81  PushButtons $Instance
82
83  # Fill graph
84  set lstInfo [::SeriesGraph::CreateLine $Instance $list]
85  set lstname [lindex $lstInfo 0]
86  set lstdesc [lindex $lstInfo 1]
87
88  #Establecer el fichero GCF del que se lee
89  if {[string length $opts(-fileGCF)]} {
90    ::bayesGraph::LoadGCF $Instance $opts(-fileGCF)
91  } else  {
92    ::bayesGraph::LoadGCF $Instance
93  }
94  ReadIni   $Instance
95  Configure $Instance
96
97  SetLabelSerie $Instance $lstname $lstdesc
98 
99  #set title chart
100  if {[string length $opts(-title)]} {
101    ::bayesGraph::SetMainTitle $Instance $opts(-title)
102  }
103  ::bayesGraph::ZoomExtend  $Instance
104  return $Instance
105}
106
107#/////////////////////////////////////////////////////////////////////////////
108  proc ::SeriesGraph::CreateLine { this lst } {
109#
110# PURPOSE:
111#     
112# PARAMETERS:
113#   this -> bayesgraph instance
114#   lst  -> values to draw
115#
116#/////////////////////////////////////////////////////////////////////////////
117  upvar \#0 ${this}::data data
118  upvar \#0 ${this}::widgets widgets
119
120  for  {set gr 0} {$gr<$data(gr,numGraph)} {incr gr 1} {
121    set grpath $widgets(gr,$gr)
122    set sergrp [lindex $lst $gr]
123    # variables especificas de cada grafico
124    set data(gr,active) $gr
125    set data(gr,$gr,sergrp) $sergrp
126    set data(gr,$gr,n_ser) [$sergrp serie size]
127    set data(gr,$gr,OnGetXTicks)  ::SeriesGraph::GetXTicks
128    set data(gr,$gr,OnGetXValues) ::SeriesGraph::GetXValues
129    # insert the series into the graph
130    for {set i 0} {$i < $data(gr,$gr,n_ser)} {incr i} {
131      # names and description
132      set objref  [$sergrp serie $i reference]
133      if {[llength $objref]>1} {
134        array set objinfo [TclInfoRef $objref]
135      } else {
136        array set objinfo [TclInfoVar Serie $objref]
137      }
138      if {[info exists objinfo(DESC)]} {
139        lappend lstdesc $objinfo(DESC)
140      } else  {
141        lappend lstdesc {}
142      }
143      lappend lstname l$i-0
144      # values
145      set j 0
146      set segs {}
147      foreach vec_data [$sergrp serie $i data] {
148        $grpath line create l$i-$j -xdata [lindex $vec_data 0] \
149                                   -ydata [lindex $vec_data 1]
150        lappend segs l$i-$j
151        if { $j } {
152          $grpath line configure l$i-$j -label ""
153        } else {
154          set nameSerie [$sergrp serie $i name]
155          $grpath line configure l$i-0 -label $nameSerie
156          set data(labels,l$i) $nameSerie
157        }
158        incr j
159      }
160      lappend data(gr,$gr,elements) $segs
161    }
162 
163    global zoomInfo
164  }
165  ::bayesGraph::BindLegend $this
166  return [list $lstname $lstdesc]
167}
168
169#/////////////////////////////////////////////////////////////////////////////
170proc ::SeriesGraph::AddSerieToGraph { this newSer {typSer LineElement} } {
171#
172# PURPOSE: Anhadimos una nueva Serie a un grafico existente.
173#   Los pasos a seguir son los siguientes:
174#   1. borramos todas las lineas existentes
175#   2. capturamos las Series anteriores
176#   3. creamos un nuevo conjunto de Series
177#   4. pintamos las nuevas series
178#   5. ?? dejar el grafico como estaba (exactamente no se lo que implica)
179#
180# PARAMETERS:
181#   this -> bayesgraph instance
182#   newSer -> new serie
183#   typSer -> type of line [LineElement | BarElement]
184#
185#/////////////////////////////////////////////////////////////////////////////
186  upvar \#0 ${this}::data data
187  upvar \#0 ${this}::widgets widgets
188  upvar \#0 ::bayesGraph::tmpOpt ary
189 
190  for  {set gr 0} {$gr<$data(gr,numGraph)} {incr gr 1} {
191    # path of Graph
192    set grpath $widgets(gr,$gr)
193    #   1. borramos todas las lineas existentes
194    # type of series
195    foreach item $data(gr,$gr,elements) {
196      lappend typesSeries [$grpath element type $item]
197    }
198    lappend typesSeries $typSer
199    # clear lines
200    set data(gr,$gr,elements) {}
201    set namLin [$grpath element names]
202    foreach item $namLin {
203      $grpath element delete $item
204    }
205    #   2. capturamos las Series anteriores
206    for {set s 0} {$s<$data(gr,$gr,n_ser)} {incr s 1} {
207      lappend series [$data(gr,$gr,sergrp) serie $s name]
208    } 
209    #   3. creamos un nuevo conjunto de Series
210    if {[info exists data(gr,$gr,sergrp)]} {
211      ::tol::seriegrp destroy $data(gr,$gr,sergrp)
212    }
213    lappend series $newSer
214    set sergrp $data(gr,$gr,sergrp)
215    eval "::tol::seriegrp create $sergrp $series"
216    #   4. pintamos las nuevas series   
217    set lstInfo [::SeriesGraph::CreateLine $this $sergrp]
218    set lstname [lindex $lstInfo 0]
219    set lstdesc [lindex $lstInfo 1]
220    #   5. ?? dejar el grafico como estaba (exactamente no se lo que implica)
221    ::SeriesGraph::Configure     $this
222    ::SeriesGraph::SetLabelSerie $this $lstname $lstdesc
223    # change types
224    foreach git $data(gr,$gr,elements) typ $typesSeries {
225      if ![string equal $typ [$grpath element type [lindex $git 0]]] {
226        ::bayesGraph::ElemOptChangeType $this [lindex $git 0] $git
227      }
228    }
229    # show info
230    #set data(gr,$gr,listNames)  $lstname
231    #set data(gr,$gr,listLabels) $lstdesc
232  }
233}
234
235
236#/////////////////////////////////////////////////////////////////////////////
237proc ::SeriesGraph::SetLabelSerie {this lines lstdesc} {
238#
239# PURPOSE: Establecemos nombres de las lineas con la descripcion de las
240#          series pintadas
241#
242# PARAMETERS: this -> Instancia bysgraph
243#             lines -> nombre de las series pintadas
244#             lstdesc -> descripciones de las lineas pintadas
245#
246#/////////////////////////////////////////////////////////////////////////////
247  upvar \#0 ${this}::options opt
248  upvar \#0 ${this}::data data
249  upvar \#0 ${this}::widgets widgets
250  for {set gr 0} {$gr<$data(gr,numGraph)} {incr gr} {
251    set grpath $widgets(gr,$gr)
252    if {$opt(gr,$gr,sergrp,lineShowDescription)==1} {
253      foreach l $lines d $lstdesc {
254        if {[string length $d]} {
255          $grpath element configure $l -label $d
256        }
257      }
258    }
259  }
260}
261
262
263#/////////////////////////////////////////////////////////////////////////////
264proc ::SeriesGraph::PushButtons {this} {
265#
266#///////////////////////////////////////////////////////////////////////////// 
267  upvar \#0 ${this}::widgets widgets
268  upvar \#0 ${this}::data data
269  set widgets(tbe,path) [frame $widgets(tb,path).tbe -bd 2]
270  set tbe $widgets(tbe,path) 
271  pack $tbe -side left
272  #grid $tbe -sticky ew
273  set data(tb,btes) ""
274  set widgets(tb,bte,sep) [Separator $tbe.sep -orient vertical]
275  lappend data(tb,btes) sep
276  set widgets(tb,bte,average) [Button $tbe.average -image [::Bitmap::get "average"] \
277                              -highlightthickness 0 -activebackground \#ececec \
278                              -takefocus 0 -relief link -bd 1 -padx 1 -pady 1 \
279                              -helptext [mc "Show/Hide Average"] \
280                              -command [list ::SeriesGraph::OptionAverage $this]]
281  lappend data(tb,btes) average
282  set widgets(tb,bte,stddev) [Button $tbe.stddev -image [::Bitmap::get "stddev"] \
283                              -highlightthickness 0 -activebackground \#ececec \
284                              -takefocus 0 -relief link -bd 1 -padx 1 -pady 1 \
285                              -helptext [mc "Show/Hide Std. Dev."] \
286                              -command [list ::SeriesGraph::OptionStdDev $this]]
287  lappend data(tb,btes) stddev
288  set widgets(tb,bte,stattb) [Button $tbe.stattb -image [::Bitmap::get "tablestat"] \
289                              -highlightthickness 0 -activebackground \#ececec \
290                              -takefocus 0 -relief link -bd 1 -padx 1 -pady 1 \
291                              -helptext [mc "View Statistics table"] \
292                              -command [list ::SeriesGraph::StatisticsTable $this]]
293  lappend data(tb,btes) stattb
294
295 # set widgets(tb,bte,accgra) [Button $tbe.acugra -image [::Bitmap::get "Serie"] \
296                              -highlightthickness 0 -activebackground \#ececec \
297                              -takefocus 0 -relief link -bd 1 -padx 1 -pady 1 \
298                              -helptext [mc "Accumulate graph"] \
299                              -command [list ::SeriesGraph::AccumulateGraph $this]]
300 # lappend data(tb,btes) accgra
301
302
303  # pack de los botones especificos
304  set but_col 0
305  foreach but $data(tb,btes) {
306    if { [string equal -length 3 $but "sep"] } {
307      grid $widgets(tb,bte,$but) -row 0 -column $but_col -sticky ns -padx 3
308    } else  {
309      grid $widgets(tb,bte,$but) -row 0 -column $but_col -sticky w -ipadx 2 -ipady 2 -pady 1
310    }
311    incr but_col
312  }
313  grid columnconfigure $tbe $but_col -weight 1
314}
315
316
317#/////////////////////////////////////////////////////////////////////////////
318proc ::SeriesGraph::Configure {this} {
319#
320#///////////////////////////////////////////////////////////////////////////// 
321  upvar \#0 ${this}::data data
322  upvar \#0 ${this}::options opt
323  ::bayesGraph::Configure $this
324  set old_active $data(gr,active)
325  for {set gr 0} {$gr<$data(gr,numGraph)} {incr gr} {
326    set data(gr,active) $gr
327
328    OptionsApplyDateFormat $this $opt(gr,$gr,sergrp,dateString)
329    OptionsApplyAxis       $this $opt(gr,$gr,sergrp,xAxis)
330    OptionsApplyXMarkers $this $opt(gr,$gr,sergrp,xMarkers) $opt(gr,$gr,sergrp,xMarkersColors)\
331           $opt(gr,$gr,sergrp,xMarkersDashes) $opt(gr,$gr,sergrp,xMarkersWidths)
332    OptionsApplyYMarkers    $this ${this}::options gr,$gr,sergrp
333  }
334  set data(gr,active) $old_active
335}
336
337
338#/////////////////////////////////////////////////////////////////////////////
339proc ::SeriesGraph::GetLabel { this bltg name tick y} {
340#
341#///////////////////////////////////////////////////////////////////////////// 
342  upvar \#0 ${this}::data data
343  set gr $data(gr,active)
344
345  set t [ expr {round($tick)} ]
346  if { [ catch { $data(gr,$gr,sergrp) dating $t } labelTick ] } {
347    set labelTick $tick
348  }
349  if { [ regexp {(l[0-9])+(-[0-9])*} $name ==> codeLine ] } {
350    set nameLine $data(labels,$codeLine)
351  } else {
352    set nameLine "NO LINE"   
353  }
354  return "$nameLine: ($labelTick,$y)"
355}
356
357
358#/////////////////////////////////////////////////////////////////////////////
359proc ::SeriesGraph::GetTickLabel { this bltg tick } {
360#
361#///////////////////////////////////////////////////////////////////////////// 
362  set sergrp [getSerGroup $this]
363  if [string is int $tick] {
364    set str ""
365    catch {
366      set str [$sergrp dating $tick]
367    }
368    return $str
369  } else {
370#    return $tick
371     return ""
372  }
373}
374
375#/////////////////////////////////////////////////////////////////////////////
376  proc ::SeriesGraph::GetXTicks {Instance} {
377#
378# PURPOSE:
379#
380# PARAMETERS:
381#   Instance -> Instancia bysgraph
382#
383# RETURN:
384#
385#/////////////////////////////////////////////////////////////////////////////
386  upvar \#0 ${Instance}::data data
387  upvar \#0 ${Instance}::widgets widgets
388 
389  set gr $data(gr,active)
390  set values [::bayesGraph::GetLimitsValueAxis $Instance x]
391  if {[llength $values]} {
392    for {set i [expr int([lindex $values 0])]} \
393        {$i <= [expr int([lindex $values 1])]} {incr i} {
394      lappend lst [GetTickLabel $Instance $widgets(gr,$gr) $i]
395    }
396  } else {
397    set lst {}
398  }
399  return $lst
400}
401
402#/////////////////////////////////////////////////////////////////////////////
403  proc ::SeriesGraph::GetXValues {Instance } {
404#
405# PURPOSE:
406#
407# PARAMETERS:
408#   Instance -> Instancia bysgraph
409#
410# RETURN:
411#
412#/////////////////////////////////////////////////////////////////////////////
413  upvar \#0 ${Instance}::data data
414  set gr $data(gr,active)
415  set values [::bayesGraph::GetLimitsValueAxis $Instance y]
416  if {[llength $values]} {
417    for {set i [expr int([lindex $values 0])]} \
418        {$i <= [expr int([lindex $values 1])]} {incr i} {
419      lappend lst $i
420    }
421  } else  {
422    set lst {}
423  }
424  return $lst
425}
426
427#/////////////////////////////////////////////////////////////////////////////
428  proc ::SeriesGraph::ComputeStepX {this min max total} {
429#
430# PURPOSE:
431#
432# PARAMETERS:
433#   this  -> Instancia bysgraph
434#   min   ->
435#   max   ->
436#   total ->
437#
438# RETURN:
439#
440#/////////////////////////////////////////////////////////////////////////////
441  set step {}
442  if {[string length $min] && [string length $max]} {
443    set dif [expr $max - $min]
444    if {$total > $dif} {
445      set step 1
446    } else {
447#puts "SeriesGraph:.ComputeStepX $this  min=$min  max=$max  total=$total  dif=$dif"
448      if {![catch {expr int(ceil($dif/$total))} res]} {
449        set step $res
450      } else {
451        #puts "SeriesGraph.ComputeStepX. $res"
452        Tolcon_Trace "SeriesGraph.ComputeStepX. $res"
453        set step 0
454      }
455      #set step [expr int(ceil($dif/$total))]
456    }
457  }
458  return $step
459}
460
461
462#/////////////////////////////////////////////////////////////////////////////
463proc ::SeriesGraph::FixStepX {this min max step} {
464#
465#///////////////////////////////////////////////////////////////////////////// 
466#TODO: Error en la resta
467  set ok 1
468  if {[string length $max] && [string length $min]} {
469    set dif [expr $max - $min]
470  } else  {
471    set ok 0
472  }
473  if {($ok) && ($step>$dif)} {
474    set step [expr round($dif)]
475  } else {
476    set step [expr round($step)]
477  }
478  return $step
479}
480
481
482#/////////////////////////////////////////////////////////////////////////////
483proc ::SeriesGraph::getSerGroup {this} {
484#
485#///////////////////////////////////////////////////////////////////////////// 
486  upvar \#0 ${this}::data data
487
488  set gr $data(gr,active)
489  set sergrp $data(gr,$gr,sergrp)
490  return $sergrp
491}
492
493
494#/////////////////////////////////////////////////////////////////////////////
495proc ::SeriesGraph::EvalWindow {this} {
496#
497#///////////////////////////////////////////////////////////////////////////// 
498  set sergrp [getSerGroup $this]
499  set result ""
500  set numCols [$sergrp serie size]
501  for {set i 0} {$i < $numCols} {incr i} {
502    lappend result [$sergrp serie $i name]
503  }
504  return [ListToStr $result]
505}
506
507
508#/////////////////////////////////////////////////////////////////////////////
509proc ::SeriesGraph::ToTable {this} {
510#
511#///////////////////////////////////////////////////////////////////////////// 
512  set grpath [::bayesGraph::getActiveGraph $this]
513  set sergrp [getSerGroup $this]
514  set tl .tbl_from_$sergrp
515  if [winfo exists $tl] {
516     raise $tl
517  } else {
518    # create
519        set tl [::project::CreateForm \
520        -title [mc "Time series table"] \
521        -type Tables \
522        -iniconfig SeriesTable -helpkey "Tb4GraSer"
523    ]
524        set tlf [$tl getframe]
525    # config
526    btable $tlf.t -parent $tl \
527                  -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
528                  -iniconfig btable
529    set tempformat [$sergrp format]
530    $sergrp format ""
531    $tlf.t fillSerie $sergrp [TolDateFormat2TclDateFormat $tempformat]
532    $sergrp format $tempformat
533    $tl bind <Control-F4> [list $tl kill]
534    pack $tlf.t -fill both -expand yes
535  }
536}
537
538
539#/////////////////////////////////////////////////////////////////////////////
540proc ::SeriesGraph::StatisticsTable {this} {
541#
542#///////////////////////////////////////////////////////////////////////////// 
543  set grpath [::bayesGraph::getActiveGraph $this]
544  set sergrp [getSerGroup $this]
545
546  set tl .stattbl_from_$sergrp
547  if [winfo exists $tl] {
548    raise $tl
549  } else {
550    # create
551    set tl [::project::CreateForm \
552        -title [mc "Statistics table"] \
553        -type Tables \
554        -labelini StatisticsTable
555    ]
556        set tlf [$tl getframe]
557    # config
558    btable $tlf.t -parent $tl \
559                  -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
560                  -iniconfig btable
561    $tlf.t fillStatistics $sergrp
562    $tl bind <Control-F4> [list $tl kill]
563    pack $tlf.t -fill both -expand yes
564  }
565}
566
567
568#/////////////////////////////////////////////////////////////////////////////
569proc ::SeriesGraph::OptionAverage {this} {
570#
571#///////////////////////////////////////////////////////////////////////////// 
572  upvar \#0 ${this}::data data
573  upvar \#0 ${this}::options opt
574  set gr $data(gr,active)
575 
576  set opt(gr,$gr,sergrp,yMarkerAve) [expr !$opt(gr,$gr,sergrp,yMarkerAve)]
577  OptionsApplyYMarker    $this ${this}::options gr,$gr,sergrp {Ave Average}
578
579}
580
581
582#/////////////////////////////////////////////////////////////////////////////
583proc ::SeriesGraph::OptionStdDev {this} {
584#
585#///////////////////////////////////////////////////////////////////////////// 
586  upvar \#0 ${this}::data data
587  upvar \#0 ${this}::options opt
588  set gr $data(gr,active)
589 
590  set opt(gr,$gr,sergrp,yMarkerDev) [expr !$opt(gr,$gr,sergrp,yMarkerDev)]
591  OptionsApplyYMarkerNDev    $this ${this}::options gr,$gr,sergrp
592}
593
594
595#/////////////////////////////////////////////////////////////////////////////
596proc ::SeriesGraph::AccumulateGraph {this} {
597#
598#///////////////////////////////////////////////////////////////////////////// 
599  set grpath [::bayesGraph::getActiveGraph $this]
600  set sergrpOld [getSerGroup $this]
601
602  set tl .accgra_from_$sergrpOld
603  if [winfo exists $tl] {
604    raise $tl
605  } else {
606    set tl [::project::CreateForm $tl \
607              -title    [mc "Accumulate Time series graph"] \
608              -type     Graphs ]
609
610    set sergrp groupFrom$sergrpOld
611    eval "::tol::seriegrp create $sergrp {FinSemMes}"
612    wm withdraw $tl
613
614    set Instance [::SeriesGraph::Create $tl.g $sergrp]
615    bind $tl.g <Destroy> +[list ::tol::seriegrp destroy $sergrp]
616    pack $tl.g -fill both -expand yes
617    wm withdraw $tl
618    wm deiconify $tl
619    update
620    # Esta opción se debe aplicar cuando el gráfico esté empacado
621    ::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0
622    $tl bind <Control-F4> [list $tl kill]
623  }
624}
625
626
627#/////////////////////////////////////////////////////////////////////////////
628  proc ::SeriesGraph::OptionsDestroy {this} {
629#
630# PURPOSE: Called before options dialog is destroyed. This procedure is called
631#          by parent BayesGraph. Actually doesn't do anything.
632#
633# PARAMETERS:
634#   this -> Instance of BayesGraph
635#
636#/////////////////////////////////////////////////////////////////////////////
637}
638
639#/////////////////////////////////////////////////////////////////////////////
640  proc ::SeriesGraph::OptionsCreate {this ts} {
641#
642# PURPOSE: Creates especific options of a series graph. It's called by
643#          BayesGraph when general graph options are created.
644#
645# PARAMETERS:
646#   this -> Instance of BayesTable
647#   ts   -> tabset in which options must be created
648#
649#/////////////////////////////////////////////////////////////////////////////
650  #insertar tabset
651  $ts insert end Series
652  set f [frame $ts.f]
653  $ts tab configure "Series" -text "Series" -window $f\
654    -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
655
656  set w_tabset [::blt::tabset $f.ts -relief flat -highlightthickness 0\
657                        -bd 0 -outerpad 0 -tier 2 -slant right -textside right]
658  $w_tabset insert end DateFormat Axis X-Markers Y-Markers Legend
659
660  set f1 [frame $w_tabset.f1]
661  set f2 [frame $w_tabset.f2]
662  set f3 [frame $w_tabset.f3]
663  set f4 [frame $w_tabset.f4]
664  set f5 [frame $w_tabset.f5]
665
666
667  $w_tabset tab configure "DateFormat" -text [mc "Date Format"]\
668    -window $f1 -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
669  $w_tabset tab configure "Axis" -text [mc "Axis"] \
670    -window $f2 -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
671  $w_tabset tab configure "X-Markers" -text [mc "X-Markers"]\
672    -window $f3 -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
673  $w_tabset tab configure "Y-Markers" -text [mc "Y-Markers"]\
674    -window $f4 -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
675  $w_tabset tab configure "Legend" -text [mc "Legend"]\
676    -window $f5 -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
677
678
679  OptionsGet $this
680
681  OptionsCreateDateFormat $this $f1
682  OptionsCreateAxis       $this $f2
683  OptionsCreateXMarkers   $this $f3
684  OptionsCreateYMarkers   $this $f4
685  OptionsCreateLegend     $this $f5
686
687  OptionsInit  $this
688  OptionsCheck $this
689  OptionsSet   $this
690
691  grid $w_tabset -sticky news 
692  grid rowconfigure    $f 0 -weight 1
693  grid columnconfigure $f 0 -weight 1
694     
695}
696
697
698#/////////////////////////////////////////////////////////////////////////////
699proc ::SeriesGraph::ShowSpecifiers {w} {
700#
701#///////////////////////////////////////////////////////////////////////////// 
702  if [winfo exist $w.t] {
703    raise $w.t
704    return
705  }
706  set dialog [Dialog $w.t -title [mc "Format Specifiers"]\
707              -default 0 -parent $w -modal none -separator true]
708  wm resizable $dialog 0 0
709  set w [$dialog getframe]
710
711  set f1 [frame $w.f1]
712  set f2 [frame $w.f2]
713  set f3 [frame $w.f3]
714  set f4 [frame $w.f4]
715  set f5 [frame $w.f5]
716  set color1 red
717
718  label $f1.lwda -text "%W" -foreground $color1
719  label $f1.lwd  -text [mc "Long Weekday"]
720  label $f1.lmna -text "%N" -foreground $color1
721  label $f1.lmn  -text [mc "Long Month Name"]
722  label $f1.swda -text "%w" -foreground $color1
723  label $f1.swd  -text [mc "Short Weekday"]
724  label $f1.smna -text "%n" -foreground $color1
725  label $f1.smn  -text [mc "Short Month Name"]
726  grid $f1.lwda $f1.lwd -sticky nw -padx 5
727  grid $f1.lmna $f1.lmn -sticky nw -padx 5
728  grid $f1.swda $f1.swd -sticky nw -padx 5
729  grid $f1.smna $f1.smn -sticky nw -padx 5
730
731  label $f2.dna  -text "%d" -foreground $color1
732  label $f2.dn   -text [mc "Day Number"]
733  label $f2.mna  -text "%m" -foreground $color1
734  label $f2.mn   -text [mc "Month Number"]
735  label $f2.tyda -text "%y" -foreground $color1
736  label $f2.tyd  -text [mc "Two Year Digit"]
737  label $f2.fyda -text "%Y" -foreground $color1
738  label $f2.fyd  -text [mc "Four Year Digit"]
739  grid $f2.dna  $f2.dn  -sticky nw -padx 5
740  grid $f2.mna  $f2.mn  -sticky nw -padx 5
741  grid $f2.tyda $f2.tyd -sticky nw -padx 5
742  grid $f2.fyda $f2.fyd -sticky nw -padx 5
743
744  label $f3.ha  -text "%h" -foreground $color1
745  label $f3.h   -text [mc "Hour"]
746  label $f3.ia  -text "%i" -foreground $color1
747  label $f3.i   -text [mc "Minute"]
748  label $f3.sa  -text "%s" -foreground $color1
749  label $f3.s   -text [mc "Second"]
750  grid $f3.ha $f3.h   -sticky nw -padx 5
751  grid $f3.ia $f3.i   -sticky nw -padx 5
752  grid $f3.sa $f3.s   -sticky nw -padx 5
753
754
755  label $f4.fuda -text "%u" -foreground $color1
756  label $f4.fud  -text [mc "Forze uncompleted dates"]
757  label $f4.fcda -text "%c" -foreground $color1
758  label $f4.fcd  -text [mc "Forze completed dates"]
759  label $f4.psa  -text "%%" -foreground $color1
760  label $f4.ps   -text [mc "Percent symbol (%)"]
761 
762  grid $f4.fuda $f4.fud   -sticky nw -padx 5
763  grid $f4.fcda $f4.fcd   -sticky nw -padx 5
764  grid $f4.psa  $f4.ps    -sticky nw -padx 5
765 
766  Button $f5.b -image [::Bitmap::get "accept"]\
767      -helptext [mc "OK"] -relief link -compound left -text [mc "Accept"]\
768      -command "destroy $dialog"   
769
770  grid $f5.b -columnspan 2 -sticky ns
771
772  grid $f1 $f2 -sticky nw -padx 20 -pady 5
773  grid $f3 $f4 -sticky n
774  grid $f5 -sticky s -columnspan 2 -pady 3
775
776  bind $dialog <F1> "ShowHelp Tb4GraSerOpc"
777  $dialog draw
778}
779
780
781#/////////////////////////////////////////////////////////////////////////////
782proc ::SeriesGraph::OptionsCreateDateFormat {this w} {
783#
784#///////////////////////////////////////////////////////////////////////////// 
785  variable tmpOpt
786  variable formats
787
788  # X-Axis
789  TitleFrame $w.tf1 -text [mc "Format String"]
790  set f1 [$w.tf1 getframe]
791
792  set formats [list \
793     [mc "TOL Long Format"]        "%cy%Ym%md%d%uh%hi%is%s" \
794     [mc "TOL Short Format"]       "%cy%Ym%md%d" \
795     "Completo YYYY/MM/dd"    "%c%w %Y/%m/%d" \
796     "Completo dd/MM/YYYY"    "%c%w %d/%m/%Y" \
797     "Fecha larga"            "%c%W, %d de %N de %Y" \
798     "Completo dd/Month/YYYY" "%c%w %d/%n/%Y" \
799     [mc "User Defined"]]
800  foreach {cad for} $formats {
801    lappend lstCad $cad
802  }
803
804  label $f1.lFormat -text [mc Format]:
805  ComboBox $f1.cbFormat -width 30 -height 6 -editable false -values $lstCad\
806      -textvariable ::SeriesGraph::tmpOpt(var,dateFormat)\
807      -modifycmd [list ::SeriesGraph::OptionsCheckDateFormat $this]
808  label $f1.lString -text [mc String]:
809  set tmpOpt(widgets,dateString) [Entry $f1.eString -width 45 -state disabled\
810         -textvariable ::SeriesGraph::tmpOpt(var,dateString)]
811  bind $f1.eString <KeyRelease> [list ::SeriesGraph::OptionsCheckDateString $this]
812  label $f1.lView   -text [mc Sample]:
813  set tmpOpt(widgets,dateView) [Entry $f1.eView   -width 45 -state disabled\
814         -textvariable ::SeriesGraph::tmpOpt(var,dateView)]
815  button $f1.bHelp  -text [mc "Format Specifiers"] \
816         -image [::Bitmap::get infor] -compound left \
817         -command [list ::SeriesGraph::ShowSpecifiers $w]
818  frame $f1.f -width 25
819  grid $f1.f $f1.lFormat $f1.cbFormat -sticky nw -padx 2 -pady 2
820  grid ^     $f1.lString $f1.eString  -sticky nw -padx 2 -pady 2
821  grid ^     $f1.lView   $f1.eView    -sticky nw -padx 2 -pady 2
822  grid ^     $f1.bHelp   -            -column 1    -sticky nw -pady 2
823  grid rowconfigure    $f1 3 -weight 1
824  grid columnconfigure $f1 2 -weight 1
825  grid $w.tf1 -sticky news -padx 2
826  grid rowconfigure    $w 0 -weight 1
827  grid columnconfigure $w 0 -weight 1
828}
829
830
831#/////////////////////////////////////////////////////////////////////////////
832proc ::SeriesGraph::OptionsCreateAxis {this w} {
833#
834#///////////////////////////////////////////////////////////////////////////// 
835  variable tmpOpt
836
837  # X-Axis
838
839  TitleFrame $w.tf -text [mc "X-Axis Ticks"]
840  set f [$w.tf getframe]
841
842  label $f.lxAxis -text [mc "Select TimeSets for axis"]:
843  set lst [::tol::info variable TimeSet]
844  # list of values
845  foreach it $tmpOpt(var,xAxis) {
846    if { [set idx [lsearch $lst $it]] != -1} {
847      set lst [lreplace $lst $idx $idx]
848    } else  {
849      set idx [lsearch $tmpOpt(var,xAxis) $it]
850      set tmpOpt(var,xAxis) [lreplace $tmpOpt(var,xAxis) $idx $idx]
851    }
852  }
853  set tmpOpt(widget,xAxisMSEL) \
854    [bmultiselect $f.msel -unsel $lst -sel $tmpOpt(var,xAxis)]
855
856
857  frame $f.f -width 25
858  grid $f.lxAxis - -sticky nw -padx 2
859  #grid $f.f $f.msel   -sticky nw -padx 10 -pady 2
860  grid $f.f $f.msel   -sticky news -padx 10 -pady 2 
861  grid rowconfigure    $f 1 -weight 1
862  grid columnconfigure $f 1 -weight 1
863  grid $w.tf -sticky news -padx 2
864  grid rowconfigure    $w 0 -weight 1
865  grid columnconfigure $w 0 -weight 1
866}
867
868
869#/////////////////////////////////////////////////////////////////////////////
870proc ::SeriesGraph::OptionsCreateXMarkers {this w} {
871#
872#///////////////////////////////////////////////////////////////////////////// 
873  upvar \#0 ${this}::widgets widgets
874  upvar \#0 ${this}::data data
875  upvar \#0 ${this}::options opt
876  variable tmpOpt
877
878  set gr $data(gr,active)
879  set g $widgets(gr,$gr)
880
881  # X-Markers
882  set w_tabset [::blt::tabset $w.ts -relief flat -highlightthickness 0\
883        -bd 0 -outerpad 0 -tier 2 -slant right -textside right]
884  $w_tabset insert end Markers Style
885
886  set f1 [frame $w_tabset.f1]
887  set f2 [frame $w_tabset.f2]
888
889  $w_tabset tab configure "Markers" -text [mc "Markers"]\
890        -window $f1 -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
891  $w_tabset tab configure "Style" -text [mc "Style"] \
892        -window $f2 -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
893
894  TitleFrame $f1.tf -text [mc "X-Markers"]
895  set f [$f1.tf getframe]
896  label $f.lxMarker -text [mc "Select TimeSets to mark"]:
897  set lst [::tol::info variable TimeSet]
898  # list of values
899  foreach it $tmpOpt(var,xMarkers) {
900    if { [set idx [lsearch $lst $it]] != -1} {
901      set lst [lreplace $lst $idx $idx]
902    } else  {
903      set idx [lsearch $tmpOpt(var,xMarkers) $it]
904      set tmpOpt(var,xMarkers) [lreplace $tmpOpt(var,xMarkers) $idx $idx]
905    }
906  }
907
908  set tmpOpt(widget,xMarkerMSEL) \
909    [bmultiselect $f.msel -unsel $lst -sel $tmpOpt(var,xMarkers)] 
910
911  frame $f.f -width 25
912  grid $f.lxMarker - -sticky nw -padx 2
913  grid $f.f $f.msel     -sticky news -padx 10 -pady 2
914  grid rowconfigure    $f 1 -weight 1
915  grid columnconfigure $f 1 -weight 1
916
917  grid $f1.tf -sticky news -padx 2
918  grid rowconfigure    $f1 0 -weight 1
919  grid columnconfigure $f1 0 -weight 1 
920
921
922  TitleFrame $f2.tf -text [mc "X-Markers Style"]
923  set f [$f2.tf getframe]
924 
925  label $f.lStyle -text [mc "Choose lines color, type and width for 5 X-Markers"]:
926  for {set i 0} {$i < 5} {incr i} {
927    label $f.lDesc$i -text "[mc Marker] [expr $i+1]:"
928    label $f.lColor$i -text [mc Color]:
929    bcolor $f.fColor$i -variable ::SeriesGraph::tmpOpt(var,xMarkerColor$i)
930    label $f.lDashes$i -text [mc "Style"]:
931    ::Objects::ComboDashesCreate ::SeriesGraph::tmpOpt(var,xMarkerDashes$i) $f.sbDashes$i
932    label   $f.lWidth$i -text [mc "Width"]:
933    SpinBox $f.sbWidth$i -justify right -width 4 -editable 0 -range {0 10}\
934            -textvariable ::SeriesGraph::tmpOpt(var,xMarkerWidth$i)
935  }
936
937  grid $f.lStyle - - - - - - - -sticky nw -padx 2 -pady 2
938  frame $f.f -width 25
939  for {set i 0} {$i < 5} {incr i} {
940    grid $f.f $f.lDesc$i $f.lColor$i $f.fColor$i $f.lDashes$i $f.sbDashes$i\
941              $f.lWidth$i $f.sbWidth$i -sticky nw -padx 2
942  } 
943
944  grid columnconfigure $f 1 -pad 10
945  grid columnconfigure $f 3 -pad 20
946  grid columnconfigure $f 5 -pad 20
947  grid columnconfigure $f 7 -pad 20
948
949  grid rowconfigure    $f 6 -weight 1
950  grid columnconfigure $f 8 -weight 1
951   
952  grid $f2.tf -sticky news -padx 2
953  grid rowconfigure    $f2 0 -weight 1
954  grid columnconfigure $f2 0 -weight 1
955   
956  grid $w_tabset -sticky news
957  grid rowconfigure    $w 0 -weight 1
958  grid columnconfigure $w 0 -weight 1
959}
960
961
962#/////////////////////////////////////////////////////////////////////////////
963proc ::SeriesGraph::OptionsCreateYMarkers {this w} {
964#
965#///////////////////////////////////////////////////////////////////////////// 
966  upvar \#0 ${this}::widgets widgets
967  upvar \#0 ${this}::data data
968  variable tmpOpt
969 
970  set gr $data(gr,active)
971  set g $widgets(gr,$gr) 
972
973  # Y-Markers
974  TitleFrame $w.tf -text [mc "Y-Markers"]
975  set f [$w.tf getframe]
976  label $f.lyMarker -text [mc "Select Statistics to mark"]:
977
978  foreach {key txt} {Ave "Average" Dev "Std. Dev." Var "Varianze" Med "Median"
979                     Max "Maximun" Min "Minimun"} {
980    checkbutton $f.ch$key -text [mc $txt]   -highlightthickness 0\
981     -pady 0 -padx 0 -variable ::SeriesGraph::tmpOpt(var,yMarker$key) 
982    label $f.lColor$key -text [mc Color]:
983    bcolor $f.fColor$key -optmenu 2 \
984      -variable ::SeriesGraph::tmpOpt(var,yMarkerColor$key)
985    label $f.lDashes$key -text [mc "Style"]:
986    ::Objects::ComboDashesCreate ::SeriesGraph::tmpOpt(var,yMarkerDashes$key) $f.sbDashes$key
987    label   $f.lWidth$key -text [mc "Width"]:
988    SpinBox $f.sbWidth$key -justify right -width 4 -editable 0 -range {0 10}\
989            -textvariable ::SeriesGraph::tmpOpt(var,yMarkerWidth$key)
990  }
991  frame $f.fNDev
992  label $f.fNDev.lNDev -text [mc "Draw Average +- "]
993  SpinBox $f.fNDev.sbNDev -justify right -width 4 -editable 0 -range {1 10}\
994            -textvariable ::SeriesGraph::tmpOpt(var,yMarkerNDev)
995  label $f.fNDev.lNDev2 -text [mc "Std. Dev."]
996 
997  grid $f.fNDev.lNDev $f.fNDev.sbNDev $f.fNDev.lNDev2 -sticky nw -padx 2
998
999  grid $f.lyMarker - - - - - - -sticky nw -padx 2 -pady 4
1000  frame $f.f -width 25
1001  set key Ave
1002  grid $f.f $f.ch$key $f.lColor$key $f.fColor$key $f.lDashes$key $f.sbDashes$key \
1003         $f.lWidth$key $f.sbWidth$key -sticky nw -padx 2
1004  foreach key {Dev Var Med Max Min} {
1005    grid ^ $f.ch$key $f.lColor$key $f.fColor$key $f.lDashes$key $f.sbDashes$key \
1006         $f.lWidth$key $f.sbWidth$key -sticky nw -padx 2
1007  }
1008  grid ^ ^ $f.fNDev - - - - - -sticky nw -padx 2 -pady 4
1009  grid rowconfigure    $f 7 -weight 1
1010  grid columnconfigure $f 1 -pad 10
1011  grid columnconfigure $f 3 -pad 20
1012  grid columnconfigure $f 5 -pad 20
1013  grid columnconfigure $f 7 -weight 1
1014 
1015  grid $w.tf -sticky news -padx 2
1016  grid rowconfigure    $w 0 -weight 1
1017  grid columnconfigure $w 0 -weight 1
1018
1019}
1020
1021#/////////////////////////////////////////////////////////////////////////////
1022proc ::SeriesGraph::OptionsCreateLegend {this w} {
1023#
1024# PURPOSE: Opciones sobre la leyenda
1025#
1026# PARAMETERS:
1027#   this   -> Instance of BayesGraph
1028#   w -> frame
1029#
1030#/////////////////////////////////////////////////////////////////////////////
1031  variable tmpOpt
1032
1033  # Legend
1034  TitleFrame $w.tf -text [mc "Legend"]
1035  set f [$w.tf getframe]
1036  checkbutton $f.cbshow -text [mc "showDesc"] -highlightthickness 0\
1037     -pady 0 -padx 0 -variable ::SeriesGraph::tmpOpt(var,lineShowDescription)
1038
1039  grid $f.cbshow       -sticky nw
1040  grid rowconfigure    $f 1 -weight 1
1041  grid columnconfigure $f 1 -weight 1
1042 
1043  grid $w.tf           -sticky news -padx 2
1044  grid rowconfigure    $w 0 -weight 1
1045  grid columnconfigure $w 0 -weight 1
1046}
1047
1048#/////////////////////////////////////////////////////////////////////////////
1049  proc ::SeriesGraph::OptionsGet {this} {
1050#
1051# PURPOSE: Initializes all options variables and stores them into the
1052#          temporary 'tmpOpt' array.
1053#
1054# PARAMETERS:
1055#   this   -> Instance of BayesGraph
1056#
1057#/////////////////////////////////////////////////////////////////////////////
1058  upvar \#0 ${this}::data data
1059  upvar \#0 ${this}::options opt
1060  variable tmpOpt
1061
1062  set gr $data(gr,active)
1063  set g [::bayesGraph::getActiveGraph $this]
1064  set sergrp [getSerGroup $this]
1065
1066  set tmpOpt(var,dateString)   $opt(gr,${gr},sergrp,dateString)
1067
1068  #Opciones inicializadas desde código
1069  #if {[info exist ${this}::options(gr,${gr},sergrp,xMarkers)]}
1070  set tmpOpt(var,xMarkers)  $opt(gr,$gr,sergrp,xMarkers)
1071  set tmpOpt(var,yMarkers)  $opt(gr,$gr,sergrp,yMarkers)
1072  set tmpOpt(var,xAxis)     $opt(gr,$gr,sergrp,xAxis)
1073  set i 0
1074  foreach color $opt(gr,$gr,sergrp,xMarkersColors) {
1075    set tmpOpt(var,xMarkerColor$i) $color
1076    incr i
1077  }
1078  set i 0
1079  foreach width $opt(gr,$gr,sergrp,xMarkersWidths) {
1080    set tmpOpt(var,xMarkerWidth$i) $width
1081    incr i
1082  }
1083  set i 0
1084  foreach dashes $opt(gr,$gr,sergrp,xMarkersDashes) {
1085    set tmpOpt(var,xMarkerDashes$i) $dashes
1086    incr i
1087  }
1088  foreach key {Ave Dev Var Med Max Min} {
1089    set tmpOpt(var,yMarker$key)       $opt(gr,$gr,sergrp,yMarker$key)
1090    set tmpOpt(var,yMarkerColor$key)  $opt(gr,$gr,sergrp,yMarkerColor$key) 
1091    set tmpOpt(var,yMarkerDashes$key) $opt(gr,$gr,sergrp,yMarkerDashes$key)
1092    set tmpOpt(var,yMarkerWidth$key)  $opt(gr,$gr,sergrp,yMarkerWidth$key)
1093  }
1094  set tmpOpt(var,yMarkerNDev) $opt(gr,$gr,sergrp,yMarkerNDev)
1095
1096  set tmpOpt(var,lineShowDescription) $opt(gr,$gr,sergrp,lineShowDescription)
1097
1098}
1099
1100
1101#/////////////////////////////////////////////////////////////////////////////
1102proc ::SeriesGraph::OptionsInit {this} {
1103#
1104#///////////////////////////////////////////////////////////////////////////// 
1105
1106}
1107
1108
1109#/////////////////////////////////////////////////////////////////////////////
1110  proc ::SeriesGraph::OptionsSet {this} {
1111#
1112# PURPOSE: Commits all options values from the temporary 'tmpOpt' array to
1113#          other structure.
1114#
1115# PARAMETERS:
1116#   this   -> Instance of BayesGraph
1117#
1118#/////////////////////////////////////////////////////////////////////////////
1119  upvar \#0 ${this}::widgets widgets
1120  upvar \#0 ${this}::data data
1121  upvar \#0 ${this}::options options
1122  set gr $data(gr,active)
1123  variable tmpOpt
1124
1125  regsub -all var, [array names ::SeriesGraph::tmpOpt var,*] "" optNames
1126  foreach it $optNames {
1127    set options(gr,$gr,sergrp,$it) $tmpOpt(var,$it)
1128  }
1129}
1130
1131
1132#/////////////////////////////////////////////////////////////////////////////
1133proc ::SeriesGraph::OptionsApply {this} {
1134#
1135#///////////////////////////////////////////////////////////////////////////// 
1136  variable tmpOpt
1137  OptionsApplyDateFormat $this $tmpOpt(var,dateString)
1138
1139  set lstXAxis  [$tmpOpt(widget,xAxisMSEL) cget -sel] 
1140  set tmpOpt(var,xAxis) $lstXAxis
1141  OptionsApplyAxis       $this $lstXAxis
1142
1143  set ::SeriesGraph::tmpOpt(var,xMarkersColors) {}
1144  set ::SeriesGraph::tmpOpt(var,xMarkersDashes) {}
1145  set ::SeriesGraph::tmpOpt(var,xMarkersWidths) {}
1146  for {set i 0} {$i < 5} {incr i} {
1147    lappend tmpOpt(var,xMarkersColors) $tmpOpt(var,xMarkerColor$i)
1148    lappend tmpOpt(var,xMarkersDashes) $tmpOpt(var,xMarkerDashes$i)
1149    lappend tmpOpt(var,xMarkersWidths) $tmpOpt(var,xMarkerWidth$i)
1150  }
1151
1152  set lstXMarkers [$tmpOpt(widget,xMarkerMSEL) cget -sel] 
1153  set tmpOpt(var,xMarkers) $lstXMarkers
1154  OptionsApplyXMarkers $this $lstXMarkers $tmpOpt(var,xMarkersColors) \
1155         $tmpOpt(var,xMarkersDashes) $tmpOpt(var,xMarkersWidths)
1156
1157  OptionsApplyYMarkers  $this ::SeriesGraph::tmpOpt var
1158  #Save options after apply
1159  OptionsSet $this
1160}
1161
1162
1163#/////////////////////////////////////////////////////////////////////////////
1164proc ::SeriesGraph::OptionsApplyDateFormat {this dateString} {
1165#
1166#///////////////////////////////////////////////////////////////////////////// 
1167  set g [::bayesGraph::getActiveGraph $this]
1168  set sergrp [getSerGroup $this]
1169  $sergrp format $dateString
1170  $g axis view x
1171}
1172
1173
1174#/////////////////////////////////////////////////////////////////////////////
1175proc ::SeriesGraph::OptionsApplyAxis {this lstXAxis} {
1176#
1177#/////////////////////////////////////////////////////////////////////////////
1178  set  MAXTICKS 10001.0
1179  set g      [::bayesGraph::getActiveGraph $this]
1180  set sergrp [getSerGroup $this]
1181
1182  $g axis configure x -majorticks ""
1183  if {[llength $lstXAxis]} {   
1184    catch {eval $sergrp ticks add $lstXAxis}
1185    set _majorticks [list ]
1186    foreach tms $lstXAxis {
1187      if {![catch {::tol::info var TimeSet $tms}]} {
1188        set _majorticks [lunion $_majorticks [$sergrp ticks get $tms]]
1189      }
1190    }
1191    set _majorticks [lsort $_majorticks]
1192    set length [llength $_majorticks]
1193    if {$length >= $MAXTICKS} {
1194      set P [expr {int(ceil($length/$MAXTICKS))}]
1195      set majorticks [list]
1196      for {set idx 0} {$idx < $length} {incr idx $P} {
1197        lappend majorticks [lindex $_majorticks $idx]
1198      }
1199    } else {
1200      set majorticks $_majorticks
1201    }
1202    $g axis configure x -majorticks $majorticks
1203    catch {eval $sergrp ticks remove $lstXAxis}
1204  }
1205}
1206
1207
1208#/////////////////////////////////////////////////////////////////////////////
1209proc ::SeriesGraph::OptionsApplyXMarkers {this lstXMarkers lstColors lstDashes lstWidths} {
1210#
1211#///////////////////////////////////////////////////////////////////////////// 
1212  variable tmpOpt
1213  set g      [::bayesGraph::getActiveGraph $this]
1214  set sergrp [getSerGroup $this]
1215 
1216  #foreach marker [$g marker names] {
1217  #  $g marker delete $marker
1218  #}
1219 
1220  #X-Markers
1221  if [llength $lstXMarkers] {
1222    set coltbl $lstColors
1223    ::bayesGraph::CreateColorTable coltbl [llength $lstXMarkers]
1224    set dif [expr [llength $lstXMarkers] - [llength lstDashes]]
1225    for {set i 0} {$i < $dif} {incr i} {
1226       lappend lstDashes {2 2}
1227       lappend lstWidths 1
1228    }
1229    set i 0
1230    catch {eval $sergrp ticks add $lstXMarkers}
1231    foreach tms $lstXMarkers {
1232      if {![catch {::tol::info var [list TimeSet $tms]}]} {
1233        $g marker bind $tms <Enter> [list ::bayesGraph::WriteInfo $this "[mc Marker]X: $tms"]
1234        $g marker bind $tms <Leave> [list ::bayesGraph::WriteInfo $this ""]
1235        set color  [lindex $coltbl $i]
1236        set dashes [lindex $lstDashes $i]
1237        set width  [lindex $lstWidths $i]
1238        Tolcon_Trace "DEBUG=[$sergrp ticks get $tms]"
1239        foreach x [$sergrp ticks get $tms] {
1240          catch {$g marker create line -name ${i}_$x -coords [list $x -Inf $x Inf] \
1241                        -outline $color -dashes $dashes -linewidth $width -bindtags $tms}
1242        }
1243        incr i
1244      }
1245    }
1246    catch {eval $sergrp ticks remove $lstXMarkers}
1247  }
1248}
1249
1250
1251#/////////////////////////////////////////////////////////////////////////////
1252  proc ::SeriesGraph::OptionsApplyYMarker {this var pre marker} {
1253#
1254# PURPOSE:
1255#
1256# PARAMETERS:
1257#   this  ->
1258#   var   ->
1259#   pre   ->
1260#   maker -> list with {key name} of statistic. Example: {Ave Average}
1261#
1262#/////////////////////////////////////////////////////////////////////////////
1263  upvar \#0 $var ary
1264  set g      [::bayesGraph::getActiveGraph $this]
1265  set sergrp [getSerGroup $this]
1266  foreach {key name} $marker { }
1267  for {set i 0} {$i < [$sergrp serie size]} {incr i} {
1268    if $ary(${pre},yMarker$key) {
1269      array set stats [ $sergrp serie $i stats ]
1270      set y $stats($name)
1271      if {[string equal $y "?"]} {
1272        tk_messageBox -parent $g -type ok -title [mc "Warning"] \
1273          -message [mc "Cant draw %1\$s y marker because its value is ?" [mc $name]]
1274      } else  {
1275        set nameSer [$g line cget l${i}-0 -label]
1276#rcsoto
1277        set mapY    [$g line cget l${i}-0 -mapy]
1278        set text "[mc Marker]Y: [mc $name] [mc of] $nameSer: $y"
1279        if [string equal $ary(${pre},yMarkerColor$key) "defcolor"] {
1280          if {[$g element type l${i}-0] eq "LineElement"} {
1281            set color [$g line cget l${i}-0 -color]
1282          } else {
1283            set color [$g line cget l${i}-0 -background]
1284          }
1285        } else  {
1286          set color $ary(${pre},yMarkerColor$key)
1287        }
1288        set dashes  $ary(${pre},yMarkerDashes$key)
1289        set width   $ary(${pre},yMarkerWidth$key)
1290        $g marker bind $name$nameSer <Enter> [list ::bayesGraph::WriteInfo $this $text]
1291        $g marker bind $name$nameSer <Leave> [list ::bayesGraph::WriteInfo $this ""]
1292        $g marker create line -name ${i}_$key -coords [list -Inf $y Inf $y]\
1293          -outline $color -dashes $dashes -linewidth $width \
1294          -bindtags $name$nameSer -mapy $mapY
1295      }   
1296    } else  {
1297      if [llength [$g marker names ${i}_$key]] {
1298        $g marker delete ${i}_$key
1299      }
1300    }
1301  }
1302}
1303
1304
1305#/////////////////////////////////////////////////////////////////////////////
1306proc ::SeriesGraph::OptionsApplyYMarkerNDev {this var pre} {
1307#
1308#///////////////////////////////////////////////////////////////////////////// 
1309  upvar \#0 $var ary
1310  set g      [::bayesGraph::getActiveGraph $this]
1311  set sergrp [getSerGroup $this]
1312
1313  for {set i 0} {$i < [$sergrp serie size]} {incr i} {
1314    if $ary(${pre},yMarkerDev) {
1315      array set stats [ $sergrp serie $i stats ]
1316      set dev $stats(Std. Dev.)
1317      set avg $stats(Average)
1318      if { $dev eq "?" || $avg eq "?" } {
1319        tk_messageBox -parent $g -type ok -title [mc "Warning"] \
1320            -message [mc "Cant draw '%1\$s' y marker because its value is ?" [mc {Std. Dev.}]]
1321      } else {
1322        set y1 [expr $avg + $ary(${pre},yMarkerNDev) * $dev]
1323        set y2 [expr $avg - $ary(${pre},yMarkerNDev) * $dev]
1324        set nameSer [$g line cget l${i}-0 -label]
1325       
1326        set text1 "[mc Marker] Y: [mc "Average"] + $ary(${pre},yMarkerNDev) * [mc "Std. Dev."] [mc of] $nameSer: $y1"
1327        set text2 "[mc Marker] Y: [mc "Average"] - $ary(${pre},yMarkerNDev) * [mc "Std. Dev."] [mc of] $nameSer: $y2"
1328        if [string equal $ary(${pre},yMarkerColorDev) "defcolor"] {
1329          if {[$g element type l${i}-0] eq "LineElement"} {
1330            set color [$g line cget l${i}-0 -color]
1331          } else {
1332            set color [$g line cget l${i}-0 -background]
1333          }
1334        } else  {
1335            set color $ary(${pre},yMarkerColorDev)
1336        }
1337        set dashes  $ary(${pre},yMarkerDashesDev)
1338        set width   $ary(${pre},yMarkerWidthDev)
1339        $g marker bind StdDev1$nameSer <Enter> [list ::bayesGraph::WriteInfo $this $text1]
1340        $g marker bind StdDev2$nameSer <Enter> [list ::bayesGraph::WriteInfo $this $text2]
1341        $g marker bind StdDev1$nameSer <Leave> [list ::bayesGraph::WriteInfo $this ""]
1342        $g marker bind StdDev2$nameSer <Leave> [list ::bayesGraph::WriteInfo $this ""]
1343        $g marker create line -name ${i}_std1 -coords [list -Inf $y1 Inf $y1]\
1344                -outline $color -dashes $dashes -linewidth $width -bindtags StdDev1$nameSer
1345        $g marker create line -name ${i}_std2 -coords [list -Inf $y2 Inf $y2]\
1346                -outline $color -dashes $dashes -linewidth $width -bindtags StdDev2$nameSer
1347      }   
1348    } else {
1349      if [llength [$g marker names ${i}_std1]] {
1350        $g marker delete ${i}_std1
1351        $g marker delete ${i}_std2
1352      }
1353    }
1354  }
1355}
1356
1357
1358#/////////////////////////////////////////////////////////////////////////////
1359proc ::SeriesGraph::OptionsApplyYMarkers {this var pre} {
1360#
1361#///////////////////////////////////////////////////////////////////////////// 
1362  foreach stat {{Ave "Average"} {Var "Varianze"} {Med "Median"} {Max "Maximun"} {Min "Minimun"}} {
1363    OptionsApplyYMarker $this $var $pre $stat
1364  }
1365  OptionsApplyYMarkerNDev $this $var $pre
1366}
1367
1368
1369#/////////////////////////////////////////////////////////////////////////////
1370proc ::SeriesGraph::OptionsCheck {this} {
1371#
1372#///////////////////////////////////////////////////////////////////////////// 
1373  OptionsCheckDateString $this
1374  #OptionsCheckDateFormat $this
1375}
1376
1377
1378#/////////////////////////////////////////////////////////////////////////////
1379proc ::SeriesGraph::OptionsCheckDateFormat {this} {
1380#
1381#///////////////////////////////////////////////////////////////////////////// 
1382  variable tmpOpt
1383  variable formats
1384
1385  if [string equal $tmpOpt(var,dateFormat) [mc "User Defined"]] {
1386    $tmpOpt(widgets,dateString) configure -state normal
1387    #set tmpOpt(var,dateString) ""
1388  } else  {
1389    $tmpOpt(widgets,dateString) configure -state disabled
1390    set idx [lsearch -exact $formats $tmpOpt(var,dateFormat)]
1391    set tmpOpt(var,dateString) [lindex $formats [expr $idx+1]]
1392    #Coger la fecha del sistema, aplicarle el formato y mostrarla
1393    set tmpOpt(var,dateView) [::tol::date now $tmpOpt(var,dateString)]
1394
1395  }
1396}
1397
1398
1399#/////////////////////////////////////////////////////////////////////////////
1400proc ::SeriesGraph::OptionsCheckDateString {this} {
1401#
1402#///////////////////////////////////////////////////////////////////////////// 
1403  variable tmpOpt
1404  variable formats
1405
1406  if {[set idx [lsearch -exact $formats $tmpOpt(var,dateString)]] != -1} {
1407    set tmpOpt(var,dateFormat) [lindex $formats [expr $idx-1]]
1408  } else  {
1409    set tmpOpt(var,dateFormat) [lindex $formats end]
1410    $tmpOpt(widgets,dateString) configure -state normal
1411  }
1412  set tmpOpt(var,dateView) [::tol::date now $tmpOpt(var,dateString)]
1413}
1414
1415
1416#/////////////////////////////////////////////////////////////////////////////
1417  proc ::SeriesGraph::ReadIni {this} {
1418#
1419# PURPOSE: Reads series graph specific options from .ini file. First of all,
1420#          reads options from BayesGraph. Ini file is the active graphic
1421#          configuration file.
1422#
1423# PARAMETERS:
1424#   this  -> Instance of BayesGraph
1425#
1426#/////////////////////////////////////////////////////////////////////////////
1427  upvar \#0 ${this}::data data
1428  upvar \#0 ${this}::options opt
1429  #set rini ::iniFile::Read
1430  set rini ::iniFile::ReadGCF
1431  #Leer las opciones específicas
1432
1433  for  {set gr 0} {$gr<$data(gr,numGraph)} {incr gr} {
1434    set sergrp $data(gr,$gr,sergrp)
1435    set opt(gr,$gr,sergrp,dateString) [$rini SeriesGraph dateString [$sergrp format]]
1436    set opt(gr,$gr,sergrp,xMarkers)   [$rini SeriesGraph SxMarkers   {}]
1437    set opt(gr,$gr,sergrp,xMarkersColors) [$rini SeriesGraph SxMarkersColors\
1438         {#356a6a #804000 #05eefa #009148 #ffffbb}]
1439    set opt(gr,$gr,sergrp,xMarkersWidths) \
1440        [$rini SeriesGraph SxMarkersWidths   {1 1 1 1 1}]
1441    set opt(gr,$gr,sergrp,xMarkersDashes) \
1442        [$rini SeriesGraph SxMarkersDashes   {{1 1} {2 2} {3 3} {4 4} {5 5}}]
1443    foreach key {Ave Dev Var Med Max Min} {
1444      set opt(gr,$gr,sergrp,yMarker$key)  [$rini SeriesGraph SyMarker$key  0]
1445      set opt(gr,$gr,sergrp,yMarkerColor$key)  [$rini SeriesGraph SyMarkerColor$key  defcolor]
1446      set opt(gr,$gr,sergrp,yMarkerDashes$key) [$rini SeriesGraph SyMarkerDashes$key  {3 1}]
1447      set opt(gr,$gr,sergrp,yMarkerWidth$key)  [$rini SeriesGraph SyMarkerWidth$key   1]
1448    }
1449    set opt(gr,$gr,sergrp,yMarkerNDev)  [$rini SeriesGraph SyMarkerNDev   2]
1450    set opt(gr,$gr,sergrp,yMarkers)     [$rini SeriesGraph SyMarkers   {}]
1451    set opt(gr,$gr,sergrp,xAxis)        [$rini SeriesGraph SxAxis      {}]
1452    set opt(gr,$gr,sergrp,lineShowDescription) \
1453      [$rini SeriesGraph lineShowDescription 0]
1454  }
1455  #Leer las opciones de bayesGraph
1456  ::bayesGraph::ReadIni $this
1457}
1458
1459
1460#/////////////////////////////////////////////////////////////////////////////
1461  proc ::SeriesGraph::WriteIni {this} {
1462#
1463# PURPOSE: Writes series graph specific options to .ini file. This procedure
1464#          is called by parent BayesGraph. Ini file is the active graphic
1465#          configuration file.
1466#
1467# PARAMETERS:
1468#   this  -> Instance of BayesGraph
1469#
1470#/////////////////////////////////////////////////////////////////////////////
1471  upvar \#0 ${this}::data data
1472  upvar \#0 ${this}::widgets widgets
1473  upvar \#0 ${this}::options opt
1474 
1475  set gr $data(gr,active)
1476  #set wini ::iniFile::Write
1477  set wini ::iniFile::WriteGCF
1478
1479  $wini SeriesGraph dateString $opt(gr,$gr,sergrp,dateString)
1480  $wini SeriesGraph SxMarkers  $opt(gr,$gr,sergrp,xMarkers)
1481  $wini SeriesGraph SxMarkersColors  $opt(gr,$gr,sergrp,xMarkersColors)
1482  $wini SeriesGraph SxMarkersWidths  $opt(gr,$gr,sergrp,xMarkersWidths)
1483  $wini SeriesGraph SxMarkersDashes  $opt(gr,$gr,sergrp,xMarkersDashes)
1484  foreach key {Ave Dev Var Med Max Min} {
1485    $wini SeriesGraph SyMarker$key       $opt(gr,$gr,sergrp,yMarker$key)
1486    $wini SeriesGraph SyMarkerColor$key  $opt(gr,$gr,sergrp,yMarkerColor$key) 
1487    $wini SeriesGraph SyMarkerDashes$key $opt(gr,$gr,sergrp,yMarkerDashes$key)
1488    $wini SeriesGraph SyMarkerWidth$key  $opt(gr,$gr,sergrp,yMarkerWidth$key)
1489  }
1490  $wini SeriesGraph SyMarkerNDev $opt(gr,$gr,sergrp,yMarkerNDev)
1491  $wini SeriesGraph SyMarkers  $opt(gr,$gr,sergrp,yMarkers)
1492  $wini SeriesGraph SxAxis     $opt(gr,$gr,sergrp,xAxis)
1493
1494  $wini SeriesGraph lineShowDescription \
1495    $opt(gr,$gr,sergrp,lineShowDescription)
1496}
Note: See TracBrowser for help on using the repository browser.