source: tol/tolbase/lib/toltk/sergraph.tcl @ 5e157f6

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

Refs #1933
Se sustituye BLT por RBC.
Se prescinde de otros widgets no usados, dependientes de BLT. (Véanse loadByswidget.tcl y pkgIndex.tcl)

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7340 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 49.6 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  rbc::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 (=>NoteBook) in which options must be created
648#
649#/////////////////////////////////////////////////////////////////////////////
650  #insertar tabset
651  set num_i 1
652  set lab_i Series
653  $ts insert $num_i $lab_i -text "  [mc $lab_i]  " -background \#d9d9d9
654  set tab_i [$ts getframe $lab_i]
655  $tab_i configure -borderwidth 2 -background \#d9d9d9 
656  set f [frame $tab_i.f]
657  pack $tab_i.f -fill both -expand yes
658 
659  set w_tabset [NoteBook $f.nb -tabbevelsize 8 -tabpady {2 6} -font {Arial 8}]
660  set num_i 0
661  foreach lab_i [list "Date Format" Axis "X-Markers" "Y-Markers" Legend] {
662    $w_tabset insert $num_i $lab_i -text "  [mc $lab_i]  " -background \#d9d9d9
663    set tab_i [$w_tabset getframe $lab_i]
664    $tab_i configure -borderwidth 2 -background \#d9d9d9
665    incr num_i
666    set f$num_i [frame $tab_i.f]
667    pack $tab_i.f -fill both -expand yes
668  }
669  $w_tabset raise [$w_tabset pages 0]
670 
671  OptionsGet $this
672  OptionsCreateDateFormat $this $f1
673  OptionsCreateAxis       $this $f2
674  OptionsCreateXMarkers   $this $f3
675  OptionsCreateYMarkers   $this $f4
676  OptionsCreateLegend     $this $f5
677
678  OptionsInit  $this
679  OptionsCheck $this
680  OptionsSet   $this
681
682  $w_tabset compute_size
683  grid $w_tabset -sticky news 
684  grid rowconfigure    $f 0 -weight 1
685  grid columnconfigure $f 0 -weight 1
686     
687}
688
689
690#/////////////////////////////////////////////////////////////////////////////
691proc ::SeriesGraph::ShowSpecifiers {w} {
692#
693#///////////////////////////////////////////////////////////////////////////// 
694  if [winfo exist $w.t] {
695    raise $w.t
696    return
697  }
698  set dialog [Dialog $w.t -title [mc "Format Specifiers"]\
699              -default 0 -parent $w -modal none -separator true]
700  wm resizable $dialog 0 0
701  set w [$dialog getframe]
702
703  set f1 [frame $w.f1]
704  set f2 [frame $w.f2]
705  set f3 [frame $w.f3]
706  set f4 [frame $w.f4]
707  set f5 [frame $w.f5]
708  set color1 red
709
710  label $f1.lwda -text "%W" -foreground $color1
711  label $f1.lwd  -text [mc "Long Weekday"]
712  label $f1.lmna -text "%N" -foreground $color1
713  label $f1.lmn  -text [mc "Long Month Name"]
714  label $f1.swda -text "%w" -foreground $color1
715  label $f1.swd  -text [mc "Short Weekday"]
716  label $f1.smna -text "%n" -foreground $color1
717  label $f1.smn  -text [mc "Short Month Name"]
718  grid $f1.lwda $f1.lwd -sticky nw -padx 5
719  grid $f1.lmna $f1.lmn -sticky nw -padx 5
720  grid $f1.swda $f1.swd -sticky nw -padx 5
721  grid $f1.smna $f1.smn -sticky nw -padx 5
722
723  label $f2.dna  -text "%d" -foreground $color1
724  label $f2.dn   -text [mc "Day Number"]
725  label $f2.mna  -text "%m" -foreground $color1
726  label $f2.mn   -text [mc "Month Number"]
727  label $f2.tyda -text "%y" -foreground $color1
728  label $f2.tyd  -text [mc "Two Year Digit"]
729  label $f2.fyda -text "%Y" -foreground $color1
730  label $f2.fyd  -text [mc "Four Year Digit"]
731  grid $f2.dna  $f2.dn  -sticky nw -padx 5
732  grid $f2.mna  $f2.mn  -sticky nw -padx 5
733  grid $f2.tyda $f2.tyd -sticky nw -padx 5
734  grid $f2.fyda $f2.fyd -sticky nw -padx 5
735
736  label $f3.ha  -text "%h" -foreground $color1
737  label $f3.h   -text [mc "Hour"]
738  label $f3.ia  -text "%i" -foreground $color1
739  label $f3.i   -text [mc "Minute"]
740  label $f3.sa  -text "%s" -foreground $color1
741  label $f3.s   -text [mc "Second"]
742  grid $f3.ha $f3.h   -sticky nw -padx 5
743  grid $f3.ia $f3.i   -sticky nw -padx 5
744  grid $f3.sa $f3.s   -sticky nw -padx 5
745
746
747  label $f4.fuda -text "%u" -foreground $color1
748  label $f4.fud  -text [mc "Forze uncompleted dates"]
749  label $f4.fcda -text "%c" -foreground $color1
750  label $f4.fcd  -text [mc "Forze completed dates"]
751  label $f4.psa  -text "%%" -foreground $color1
752  label $f4.ps   -text [mc "Percent symbol (%)"]
753 
754  grid $f4.fuda $f4.fud   -sticky nw -padx 5
755  grid $f4.fcda $f4.fcd   -sticky nw -padx 5
756  grid $f4.psa  $f4.ps    -sticky nw -padx 5
757 
758  Button $f5.b -image [::Bitmap::get "accept"]\
759      -helptext [mc "OK"] -relief link -compound left -text [mc "Accept"]\
760      -command "destroy $dialog"   
761
762  grid $f5.b -columnspan 2 -sticky ns
763
764  grid $f1 $f2 -sticky nw -padx 20 -pady 5
765  grid $f3 $f4 -sticky n
766  grid $f5 -sticky s -columnspan 2 -pady 3
767
768  bind $dialog <F1> "ShowHelp Tb4GraSerOpc"
769  $dialog draw
770}
771
772
773#/////////////////////////////////////////////////////////////////////////////
774proc ::SeriesGraph::OptionsCreateDateFormat {this w} {
775#
776#///////////////////////////////////////////////////////////////////////////// 
777  variable tmpOpt
778  variable formats
779
780  # X-Axis
781  TitleFrame $w.tf1 -text [mc "Format String"]
782  set f1 [$w.tf1 getframe]
783
784  set formats [list \
785     [mc "TOL Long Format"]        "%cy%Ym%md%d%uh%hi%is%s" \
786     [mc "TOL Short Format"]       "%cy%Ym%md%d" \
787     "Completo YYYY/MM/dd"    "%c%w %Y/%m/%d" \
788     "Completo dd/MM/YYYY"    "%c%w %d/%m/%Y" \
789     "Fecha larga"            "%c%W, %d de %N de %Y" \
790     "Completo dd/Month/YYYY" "%c%w %d/%n/%Y" \
791     [mc "User Defined"]]
792  foreach {cad for} $formats {
793    lappend lstCad $cad
794  }
795
796  label $f1.lFormat -text [mc Format]:
797  ComboBox $f1.cbFormat -width 30 -height 6 -editable false -values $lstCad\
798      -textvariable ::SeriesGraph::tmpOpt(var,dateFormat)\
799      -modifycmd [list ::SeriesGraph::OptionsCheckDateFormat $this]
800  label $f1.lString -text [mc String]:
801  set tmpOpt(widgets,dateString) [Entry $f1.eString -width 45 -state disabled\
802         -textvariable ::SeriesGraph::tmpOpt(var,dateString)]
803  bind $f1.eString <KeyRelease> [list ::SeriesGraph::OptionsCheckDateString $this]
804  label $f1.lView   -text [mc Sample]:
805  set tmpOpt(widgets,dateView) [Entry $f1.eView   -width 45 -state disabled\
806         -textvariable ::SeriesGraph::tmpOpt(var,dateView)]
807  button $f1.bHelp  -text [mc "Format Specifiers"] \
808         -image [::Bitmap::get infor] -compound left \
809         -command [list ::SeriesGraph::ShowSpecifiers $w]
810  frame $f1.f -width 25
811  grid $f1.f $f1.lFormat $f1.cbFormat -sticky nw -padx 2 -pady 2
812  grid ^     $f1.lString $f1.eString  -sticky nw -padx 2 -pady 2
813  grid ^     $f1.lView   $f1.eView    -sticky nw -padx 2 -pady 2
814  grid ^     $f1.bHelp   -            -column 1    -sticky nw -pady 2
815  grid rowconfigure    $f1 3 -weight 1
816  grid columnconfigure $f1 2 -weight 1
817  grid $w.tf1 -sticky news -padx 2
818  grid rowconfigure    $w 0 -weight 1
819  grid columnconfigure $w 0 -weight 1
820}
821
822
823#/////////////////////////////////////////////////////////////////////////////
824proc ::SeriesGraph::OptionsCreateAxis {this w} {
825#
826#///////////////////////////////////////////////////////////////////////////// 
827  variable tmpOpt
828
829  # X-Axis
830
831  TitleFrame $w.tf -text [mc "X-Axis Ticks"]
832  set f [$w.tf getframe]
833
834  label $f.lxAxis -text [mc "Select TimeSets for axis"]:
835  set lst [::tol::info variable TimeSet]
836  # list of values
837  foreach it $tmpOpt(var,xAxis) {
838    if { [set idx [lsearch $lst $it]] != -1} {
839      set lst [lreplace $lst $idx $idx]
840    } else  {
841      set idx [lsearch $tmpOpt(var,xAxis) $it]
842      set tmpOpt(var,xAxis) [lreplace $tmpOpt(var,xAxis) $idx $idx]
843    }
844  }
845  set tmpOpt(widget,xAxisMSEL) \
846    [bmultiselect $f.msel -unsel $lst -sel $tmpOpt(var,xAxis)]
847
848
849  frame $f.f -width 25
850  grid $f.lxAxis - -sticky nw -padx 2
851  #grid $f.f $f.msel   -sticky nw -padx 10 -pady 2
852  grid $f.f $f.msel   -sticky news -padx 10 -pady 2 
853  grid rowconfigure    $f 1 -weight 1
854  grid columnconfigure $f 1 -weight 1
855  grid $w.tf -sticky news -padx 2
856  grid rowconfigure    $w 0 -weight 1
857  grid columnconfigure $w 0 -weight 1
858}
859
860
861#/////////////////////////////////////////////////////////////////////////////
862proc ::SeriesGraph::OptionsCreateXMarkers {this w} {
863#
864#///////////////////////////////////////////////////////////////////////////// 
865  upvar \#0 ${this}::widgets widgets
866  upvar \#0 ${this}::data data
867  variable tmpOpt
868 
869  # X-Markers
870  set w_tabset [NoteBook $w.nb -tabbevelsize 8 -tabpady {2 6} -font {Arial 8}]
871  set num_i 0
872  foreach lab_i [list Markers Style] {
873    $w_tabset insert $num_i $lab_i -text "  [mc $lab_i]  " -background \#d9d9d9
874    set tab_i [$w_tabset getframe $lab_i]
875    $tab_i configure -borderwidth 2 -background \#d9d9d9
876    incr num_i   
877    set f$num_i [frame $tab_i.f]
878    pack $tab_i.f -fill both -expand yes 
879  }
880  $w_tabset raise [$w_tabset pages 0]
881 
882  TitleFrame $f1.tf -text [mc "X-Markers"]
883  set f [$f1.tf getframe]
884  label $f.lxMarker -text [mc "Select TimeSets to mark"]:
885  set lst [::tol::info variable TimeSet]
886  # list of values
887  foreach it $tmpOpt(var,xMarkers) {
888    if { [set idx [lsearch $lst $it]] != -1} {
889      set lst [lreplace $lst $idx $idx]
890    } else  {
891      set idx [lsearch $tmpOpt(var,xMarkers) $it]
892      set tmpOpt(var,xMarkers) [lreplace $tmpOpt(var,xMarkers) $idx $idx]
893    }
894  }
895
896  set tmpOpt(widget,xMarkerMSEL) \
897    [bmultiselect $f.msel -unsel $lst -sel $tmpOpt(var,xMarkers)] 
898
899  frame $f.f -width 25
900  grid $f.lxMarker - -sticky nw -padx 2
901  grid $f.f $f.msel     -sticky news -padx 10 -pady 2
902  grid rowconfigure    $f 1 -weight 1
903  grid columnconfigure $f 1 -weight 1
904
905  grid $f1.tf -sticky news -padx 2
906  grid rowconfigure    $f1 0 -weight 1
907  grid columnconfigure $f1 0 -weight 1 
908
909
910  TitleFrame $f2.tf -text [mc "X-Markers Style"]
911  set f [$f2.tf getframe]
912 
913  label $f.lStyle -text [mc "Choose lines color, type and width for 5 X-Markers"]:
914  for {set i 0} {$i < 5} {incr i} {
915    label $f.lDesc$i -text "[mc Marker] [expr $i+1]:"
916    label $f.lColor$i -text [mc Color]:
917    bcolor $f.fColor$i -variable ::SeriesGraph::tmpOpt(var,xMarkerColor$i)
918    label $f.lDashes$i -text [mc "Style"]:
919    ::Objects::ComboDashesCreate ::SeriesGraph::tmpOpt(var,xMarkerDashes$i) $f.sbDashes$i
920    label   $f.lWidth$i -text [mc "Width"]:
921    SpinBox $f.sbWidth$i -justify right -width 4 -editable 0 -range {0 10}\
922            -textvariable ::SeriesGraph::tmpOpt(var,xMarkerWidth$i)
923  }
924
925  grid $f.lStyle - - - - - - - -sticky nw -padx 2 -pady 2
926  frame $f.f -width 25
927  for {set i 0} {$i < 5} {incr i} {
928    grid $f.f $f.lDesc$i $f.lColor$i $f.fColor$i $f.lDashes$i $f.sbDashes$i\
929              $f.lWidth$i $f.sbWidth$i -sticky nw -padx 2
930  } 
931
932  grid columnconfigure $f 1 -pad 10
933  grid columnconfigure $f 3 -pad 20
934  grid columnconfigure $f 5 -pad 20
935  grid columnconfigure $f 7 -pad 20
936
937  grid rowconfigure    $f 6 -weight 1
938  grid columnconfigure $f 8 -weight 1
939   
940  grid $f2.tf -sticky news -padx 2
941  grid rowconfigure    $f2 0 -weight 1
942  grid columnconfigure $f2 0 -weight 1
943 
944  $w_tabset compute_size
945  grid $w_tabset -sticky news
946  grid rowconfigure    $w 0 -weight 1
947  grid columnconfigure $w 0 -weight 1
948}
949
950
951#/////////////////////////////////////////////////////////////////////////////
952proc ::SeriesGraph::OptionsCreateYMarkers {this w} {
953#
954#///////////////////////////////////////////////////////////////////////////// 
955  upvar \#0 ${this}::widgets widgets
956  upvar \#0 ${this}::data data
957  variable tmpOpt
958 
959  set gr $data(gr,active)
960  set g $widgets(gr,$gr) 
961
962  # Y-Markers
963  TitleFrame $w.tf -text [mc "Y-Markers"]
964  set f [$w.tf getframe]
965  label $f.lyMarker -text [mc "Select Statistics to mark"]:
966
967  foreach {key txt} {Ave "Average" Dev "Std. Dev." Var "Varianze" Med "Median"
968                     Max "Maximun" Min "Minimun"} {
969    checkbutton $f.ch$key -text [mc $txt]   -highlightthickness 0\
970     -pady 0 -padx 0 -variable ::SeriesGraph::tmpOpt(var,yMarker$key) 
971    label $f.lColor$key -text [mc Color]:
972    bcolor $f.fColor$key -optmenu 2 \
973      -variable ::SeriesGraph::tmpOpt(var,yMarkerColor$key)
974    label $f.lDashes$key -text [mc "Style"]:
975    ::Objects::ComboDashesCreate ::SeriesGraph::tmpOpt(var,yMarkerDashes$key) $f.sbDashes$key
976    label   $f.lWidth$key -text [mc "Width"]:
977    SpinBox $f.sbWidth$key -justify right -width 4 -editable 0 -range {0 10}\
978            -textvariable ::SeriesGraph::tmpOpt(var,yMarkerWidth$key)
979  }
980  frame $f.fNDev
981  label $f.fNDev.lNDev -text [mc "Draw Average +- "]
982  SpinBox $f.fNDev.sbNDev -justify right -width 4 -editable 0 -range {1 10}\
983            -textvariable ::SeriesGraph::tmpOpt(var,yMarkerNDev)
984  label $f.fNDev.lNDev2 -text [mc "Std. Dev."]
985 
986  grid $f.fNDev.lNDev $f.fNDev.sbNDev $f.fNDev.lNDev2 -sticky nw -padx 2
987
988  grid $f.lyMarker - - - - - - -sticky nw -padx 2 -pady 4
989  frame $f.f -width 25
990  set key Ave
991  grid $f.f $f.ch$key $f.lColor$key $f.fColor$key $f.lDashes$key $f.sbDashes$key \
992         $f.lWidth$key $f.sbWidth$key -sticky nw -padx 2
993  foreach key {Dev Var Med Max Min} {
994    grid ^ $f.ch$key $f.lColor$key $f.fColor$key $f.lDashes$key $f.sbDashes$key \
995         $f.lWidth$key $f.sbWidth$key -sticky nw -padx 2
996  }
997  grid ^ ^ $f.fNDev - - - - - -sticky nw -padx 2 -pady 4
998  grid rowconfigure    $f 7 -weight 1
999  grid columnconfigure $f 1 -pad 10
1000  grid columnconfigure $f 3 -pad 20
1001  grid columnconfigure $f 5 -pad 20
1002  grid columnconfigure $f 7 -weight 1
1003 
1004  grid $w.tf -sticky news -padx 2
1005  grid rowconfigure    $w 0 -weight 1
1006  grid columnconfigure $w 0 -weight 1
1007
1008}
1009
1010#/////////////////////////////////////////////////////////////////////////////
1011proc ::SeriesGraph::OptionsCreateLegend {this w} {
1012#
1013# PURPOSE: Opciones sobre la leyenda
1014#
1015# PARAMETERS:
1016#   this   -> Instance of BayesGraph
1017#   w -> frame
1018#
1019#/////////////////////////////////////////////////////////////////////////////
1020  variable tmpOpt
1021
1022  # Legend
1023  TitleFrame $w.tf -text [mc "Legend"]
1024  set f [$w.tf getframe]
1025  checkbutton $f.cbshow -text [mc "showDesc"] -highlightthickness 0\
1026     -pady 0 -padx 0 -variable ::SeriesGraph::tmpOpt(var,lineShowDescription)
1027
1028  grid $f.cbshow       -sticky nw
1029  grid rowconfigure    $f 1 -weight 1
1030  grid columnconfigure $f 1 -weight 1
1031 
1032  grid $w.tf           -sticky news -padx 2
1033  grid rowconfigure    $w 0 -weight 1
1034  grid columnconfigure $w 0 -weight 1
1035}
1036
1037#/////////////////////////////////////////////////////////////////////////////
1038  proc ::SeriesGraph::OptionsGet {this} {
1039#
1040# PURPOSE: Initializes all options variables and stores them into the
1041#          temporary 'tmpOpt' array.
1042#
1043# PARAMETERS:
1044#   this   -> Instance of BayesGraph
1045#
1046#/////////////////////////////////////////////////////////////////////////////
1047  upvar \#0 ${this}::data data
1048  upvar \#0 ${this}::options opt
1049  variable tmpOpt
1050
1051  set gr $data(gr,active)
1052  set g [::bayesGraph::getActiveGraph $this]
1053  set sergrp [getSerGroup $this]
1054
1055  set tmpOpt(var,dateString)   $opt(gr,${gr},sergrp,dateString)
1056
1057  #Opciones inicializadas desde código
1058  #if {[info exist ${this}::options(gr,${gr},sergrp,xMarkers)]}
1059  set tmpOpt(var,xMarkers)  $opt(gr,$gr,sergrp,xMarkers)
1060  set tmpOpt(var,yMarkers)  $opt(gr,$gr,sergrp,yMarkers)
1061  set tmpOpt(var,xAxis)     $opt(gr,$gr,sergrp,xAxis)
1062  set i 0
1063  foreach color $opt(gr,$gr,sergrp,xMarkersColors) {
1064    set tmpOpt(var,xMarkerColor$i) $color
1065    incr i
1066  }
1067  set i 0
1068  foreach width $opt(gr,$gr,sergrp,xMarkersWidths) {
1069    set tmpOpt(var,xMarkerWidth$i) $width
1070    incr i
1071  }
1072  set i 0
1073  foreach dashes $opt(gr,$gr,sergrp,xMarkersDashes) {
1074    set tmpOpt(var,xMarkerDashes$i) $dashes
1075    incr i
1076  }
1077  foreach key {Ave Dev Var Med Max Min} {
1078    set tmpOpt(var,yMarker$key)       $opt(gr,$gr,sergrp,yMarker$key)
1079    set tmpOpt(var,yMarkerColor$key)  $opt(gr,$gr,sergrp,yMarkerColor$key) 
1080    set tmpOpt(var,yMarkerDashes$key) $opt(gr,$gr,sergrp,yMarkerDashes$key)
1081    set tmpOpt(var,yMarkerWidth$key)  $opt(gr,$gr,sergrp,yMarkerWidth$key)
1082  }
1083  set tmpOpt(var,yMarkerNDev) $opt(gr,$gr,sergrp,yMarkerNDev)
1084
1085  set tmpOpt(var,lineShowDescription) $opt(gr,$gr,sergrp,lineShowDescription)
1086
1087}
1088
1089
1090#/////////////////////////////////////////////////////////////////////////////
1091proc ::SeriesGraph::OptionsInit {this} {
1092#
1093#///////////////////////////////////////////////////////////////////////////// 
1094
1095}
1096
1097
1098#/////////////////////////////////////////////////////////////////////////////
1099  proc ::SeriesGraph::OptionsSet {this} {
1100#
1101# PURPOSE: Commits all options values from the temporary 'tmpOpt' array to
1102#          other structure.
1103#
1104# PARAMETERS:
1105#   this   -> Instance of BayesGraph
1106#
1107#/////////////////////////////////////////////////////////////////////////////
1108  upvar \#0 ${this}::widgets widgets
1109  upvar \#0 ${this}::data data
1110  upvar \#0 ${this}::options options
1111  set gr $data(gr,active)
1112  variable tmpOpt
1113
1114  regsub -all var, [array names ::SeriesGraph::tmpOpt var,*] "" optNames
1115  foreach it $optNames {
1116    set options(gr,$gr,sergrp,$it) $tmpOpt(var,$it)
1117  }
1118}
1119
1120
1121#/////////////////////////////////////////////////////////////////////////////
1122proc ::SeriesGraph::OptionsApply {this} {
1123#
1124#///////////////////////////////////////////////////////////////////////////// 
1125  variable tmpOpt
1126  OptionsApplyDateFormat $this $tmpOpt(var,dateString)
1127
1128  set lstXAxis  [$tmpOpt(widget,xAxisMSEL) cget -sel] 
1129  set tmpOpt(var,xAxis) $lstXAxis
1130  OptionsApplyAxis       $this $lstXAxis
1131
1132  set ::SeriesGraph::tmpOpt(var,xMarkersColors) {}
1133  set ::SeriesGraph::tmpOpt(var,xMarkersDashes) {}
1134  set ::SeriesGraph::tmpOpt(var,xMarkersWidths) {}
1135  for {set i 0} {$i < 5} {incr i} {
1136    lappend tmpOpt(var,xMarkersColors) $tmpOpt(var,xMarkerColor$i)
1137    lappend tmpOpt(var,xMarkersDashes) $tmpOpt(var,xMarkerDashes$i)
1138    lappend tmpOpt(var,xMarkersWidths) $tmpOpt(var,xMarkerWidth$i)
1139  }
1140
1141  set lstXMarkers [$tmpOpt(widget,xMarkerMSEL) cget -sel] 
1142  set tmpOpt(var,xMarkers) $lstXMarkers
1143  OptionsApplyXMarkers $this $lstXMarkers $tmpOpt(var,xMarkersColors) \
1144         $tmpOpt(var,xMarkersDashes) $tmpOpt(var,xMarkersWidths)
1145
1146  OptionsApplyYMarkers  $this ::SeriesGraph::tmpOpt var
1147  #Save options after apply
1148  OptionsSet $this
1149}
1150
1151
1152#/////////////////////////////////////////////////////////////////////////////
1153proc ::SeriesGraph::OptionsApplyDateFormat {this dateString} {
1154#
1155#///////////////////////////////////////////////////////////////////////////// 
1156  set g [::bayesGraph::getActiveGraph $this]
1157  set sergrp [getSerGroup $this]
1158  $sergrp format $dateString
1159  $g axis view x
1160}
1161
1162
1163#/////////////////////////////////////////////////////////////////////////////
1164proc ::SeriesGraph::OptionsApplyAxis {this lstXAxis} {
1165#
1166#/////////////////////////////////////////////////////////////////////////////
1167  set  MAXTICKS 10001.0
1168  set g      [::bayesGraph::getActiveGraph $this]
1169  set sergrp [getSerGroup $this]
1170
1171  $g axis configure x -majorticks ""
1172  if {[llength $lstXAxis]} {   
1173    catch {eval $sergrp ticks add $lstXAxis}
1174    set _majorticks [list ]
1175    foreach tms $lstXAxis {
1176      if {![catch {::tol::info var TimeSet $tms}]} {
1177        set _majorticks [lunion $_majorticks [$sergrp ticks get $tms]]
1178      }
1179    }
1180    set _majorticks [lsort $_majorticks]
1181    set length [llength $_majorticks]
1182    if {$length >= $MAXTICKS} {
1183      set P [expr {int(ceil($length/$MAXTICKS))}]
1184      set majorticks [list]
1185      for {set idx 0} {$idx < $length} {incr idx $P} {
1186        lappend majorticks [lindex $_majorticks $idx]
1187      }
1188    } else {
1189      set majorticks $_majorticks
1190    }
1191    $g axis configure x -majorticks $majorticks
1192    catch {eval $sergrp ticks remove $lstXAxis}
1193  }
1194}
1195
1196
1197#/////////////////////////////////////////////////////////////////////////////
1198proc ::SeriesGraph::OptionsApplyXMarkers {this lstXMarkers lstColors lstDashes lstWidths} {
1199#
1200#///////////////////////////////////////////////////////////////////////////// 
1201  variable tmpOpt
1202  set g      [::bayesGraph::getActiveGraph $this]
1203  set sergrp [getSerGroup $this]
1204 
1205  #foreach marker [$g marker names] {
1206  #  $g marker delete $marker
1207  #}
1208 
1209  #X-Markers
1210  if [llength $lstXMarkers] {
1211    set coltbl $lstColors
1212    ::bayesGraph::CreateColorTable coltbl [llength $lstXMarkers]
1213    set dif [expr [llength $lstXMarkers] - [llength lstDashes]]
1214    for {set i 0} {$i < $dif} {incr i} {
1215       lappend lstDashes {2 2}
1216       lappend lstWidths 1
1217    }
1218    set i 0
1219    catch {eval $sergrp ticks add $lstXMarkers}
1220    foreach tms $lstXMarkers {
1221      if {![catch {::tol::info var [list TimeSet $tms]}]} {
1222        $g marker bind $tms <Enter> [list ::bayesGraph::WriteInfo $this "[mc Marker]X: $tms"]
1223        $g marker bind $tms <Leave> [list ::bayesGraph::WriteInfo $this ""]
1224        set color  [lindex $coltbl $i]
1225        set dashes [lindex $lstDashes $i]
1226        set width  [lindex $lstWidths $i]
1227        Tolcon_Trace "DEBUG=[$sergrp ticks get $tms]"
1228        foreach x [$sergrp ticks get $tms] {
1229          catch {$g marker create line -name ${i}_$x -coords [list $x -Inf $x Inf] \
1230                        -outline $color -dashes $dashes -linewidth $width -bindtags $tms}
1231        }
1232        incr i
1233      }
1234    }
1235    catch {eval $sergrp ticks remove $lstXMarkers}
1236  }
1237}
1238
1239
1240#/////////////////////////////////////////////////////////////////////////////
1241  proc ::SeriesGraph::OptionsApplyYMarker {this var pre marker} {
1242#
1243# PURPOSE:
1244#
1245# PARAMETERS:
1246#   this  ->
1247#   var   ->
1248#   pre   ->
1249#   maker -> list with {key name} of statistic. Example: {Ave Average}
1250#
1251#/////////////////////////////////////////////////////////////////////////////
1252  upvar \#0 $var ary
1253  set g      [::bayesGraph::getActiveGraph $this]
1254  set sergrp [getSerGroup $this]
1255  foreach {key name} $marker { }
1256  for {set i 0} {$i < [$sergrp serie size]} {incr i} {
1257    if $ary(${pre},yMarker$key) {
1258      array set stats [ $sergrp serie $i stats ]
1259      set y $stats($name)
1260      if {[string equal $y "?"]} {
1261        tk_messageBox -parent $g -type ok -title [mc "Warning"] \
1262          -message [mc "Cant draw %1\$s y marker because its value is ?" [mc $name]]
1263      } else  {
1264        set nameSer [$g line cget l${i}-0 -label]
1265#rcsoto
1266        set mapY    [$g line cget l${i}-0 -mapy]
1267        set text "[mc Marker]Y: [mc $name] [mc of] $nameSer: $y"
1268        if [string equal $ary(${pre},yMarkerColor$key) "defcolor"] {
1269          if {[$g element type l${i}-0] eq "LineElement"} {
1270            set color [$g line cget l${i}-0 -color]
1271          } else {
1272            set color [$g line cget l${i}-0 -background]
1273          }
1274        } else  {
1275          set color $ary(${pre},yMarkerColor$key)
1276        }
1277        set dashes  $ary(${pre},yMarkerDashes$key)
1278        set width   $ary(${pre},yMarkerWidth$key)
1279        $g marker bind $name$nameSer <Enter> [list ::bayesGraph::WriteInfo $this $text]
1280        $g marker bind $name$nameSer <Leave> [list ::bayesGraph::WriteInfo $this ""]
1281        $g marker create line -name ${i}_$key -coords [list -Inf $y Inf $y]\
1282          -outline $color -dashes $dashes -linewidth $width \
1283          -bindtags $name$nameSer -mapy $mapY
1284      }   
1285    } else  {
1286      if [llength [$g marker names ${i}_$key]] {
1287        $g marker delete ${i}_$key
1288      }
1289    }
1290  }
1291}
1292
1293
1294#/////////////////////////////////////////////////////////////////////////////
1295proc ::SeriesGraph::OptionsApplyYMarkerNDev {this var pre} {
1296#
1297#///////////////////////////////////////////////////////////////////////////// 
1298  upvar \#0 $var ary
1299  set g      [::bayesGraph::getActiveGraph $this]
1300  set sergrp [getSerGroup $this]
1301
1302  for {set i 0} {$i < [$sergrp serie size]} {incr i} {
1303    if $ary(${pre},yMarkerDev) {
1304      array set stats [ $sergrp serie $i stats ]
1305      set dev $stats(Std. Dev.)
1306      set avg $stats(Average)
1307      if { $dev eq "?" || $avg eq "?" } {
1308        tk_messageBox -parent $g -type ok -title [mc "Warning"] \
1309            -message [mc "Cant draw '%1\$s' y marker because its value is ?" [mc {Std. Dev.}]]
1310      } else {
1311        set y1 [expr $avg + $ary(${pre},yMarkerNDev) * $dev]
1312        set y2 [expr $avg - $ary(${pre},yMarkerNDev) * $dev]
1313        set nameSer [$g line cget l${i}-0 -label]
1314       
1315        set text1 "[mc Marker] Y: [mc "Average"] + $ary(${pre},yMarkerNDev) * [mc "Std. Dev."] [mc of] $nameSer: $y1"
1316        set text2 "[mc Marker] Y: [mc "Average"] - $ary(${pre},yMarkerNDev) * [mc "Std. Dev."] [mc of] $nameSer: $y2"
1317        if [string equal $ary(${pre},yMarkerColorDev) "defcolor"] {
1318          if {[$g element type l${i}-0] eq "LineElement"} {
1319            set color [$g line cget l${i}-0 -color]
1320          } else {
1321            set color [$g line cget l${i}-0 -background]
1322          }
1323        } else  {
1324            set color $ary(${pre},yMarkerColorDev)
1325        }
1326        set dashes  $ary(${pre},yMarkerDashesDev)
1327        set width   $ary(${pre},yMarkerWidthDev)
1328        $g marker bind StdDev1$nameSer <Enter> [list ::bayesGraph::WriteInfo $this $text1]
1329        $g marker bind StdDev2$nameSer <Enter> [list ::bayesGraph::WriteInfo $this $text2]
1330        $g marker bind StdDev1$nameSer <Leave> [list ::bayesGraph::WriteInfo $this ""]
1331        $g marker bind StdDev2$nameSer <Leave> [list ::bayesGraph::WriteInfo $this ""]
1332        $g marker create line -name ${i}_std1 -coords [list -Inf $y1 Inf $y1]\
1333                -outline $color -dashes $dashes -linewidth $width -bindtags StdDev1$nameSer
1334        $g marker create line -name ${i}_std2 -coords [list -Inf $y2 Inf $y2]\
1335                -outline $color -dashes $dashes -linewidth $width -bindtags StdDev2$nameSer
1336      }   
1337    } else {
1338      if [llength [$g marker names ${i}_std1]] {
1339        $g marker delete ${i}_std1
1340        $g marker delete ${i}_std2
1341      }
1342    }
1343  }
1344}
1345
1346
1347#/////////////////////////////////////////////////////////////////////////////
1348proc ::SeriesGraph::OptionsApplyYMarkers {this var pre} {
1349#
1350#///////////////////////////////////////////////////////////////////////////// 
1351  foreach stat {{Ave "Average"} {Var "Varianze"} {Med "Median"} {Max "Maximun"} {Min "Minimun"}} {
1352    OptionsApplyYMarker $this $var $pre $stat
1353  }
1354  OptionsApplyYMarkerNDev $this $var $pre
1355}
1356
1357
1358#/////////////////////////////////////////////////////////////////////////////
1359proc ::SeriesGraph::OptionsCheck {this} {
1360#
1361#///////////////////////////////////////////////////////////////////////////// 
1362  OptionsCheckDateString $this
1363  #OptionsCheckDateFormat $this
1364}
1365
1366
1367#/////////////////////////////////////////////////////////////////////////////
1368proc ::SeriesGraph::OptionsCheckDateFormat {this} {
1369#
1370#///////////////////////////////////////////////////////////////////////////// 
1371  variable tmpOpt
1372  variable formats
1373
1374  if [string equal $tmpOpt(var,dateFormat) [mc "User Defined"]] {
1375    $tmpOpt(widgets,dateString) configure -state normal
1376    #set tmpOpt(var,dateString) ""
1377  } else  {
1378    $tmpOpt(widgets,dateString) configure -state disabled
1379    set idx [lsearch -exact $formats $tmpOpt(var,dateFormat)]
1380    set tmpOpt(var,dateString) [lindex $formats [expr $idx+1]]
1381    #Coger la fecha del sistema, aplicarle el formato y mostrarla
1382    set tmpOpt(var,dateView) [::tol::date now $tmpOpt(var,dateString)]
1383
1384  }
1385}
1386
1387
1388#/////////////////////////////////////////////////////////////////////////////
1389proc ::SeriesGraph::OptionsCheckDateString {this} {
1390#
1391#///////////////////////////////////////////////////////////////////////////// 
1392  variable tmpOpt
1393  variable formats
1394
1395  if {[set idx [lsearch -exact $formats $tmpOpt(var,dateString)]] != -1} {
1396    set tmpOpt(var,dateFormat) [lindex $formats [expr $idx-1]]
1397  } else  {
1398    set tmpOpt(var,dateFormat) [lindex $formats end]
1399    $tmpOpt(widgets,dateString) configure -state normal
1400  }
1401  set tmpOpt(var,dateView) [::tol::date now $tmpOpt(var,dateString)]
1402}
1403
1404
1405#/////////////////////////////////////////////////////////////////////////////
1406  proc ::SeriesGraph::ReadIni {this} {
1407#
1408# PURPOSE: Reads series graph specific options from .ini file. First of all,
1409#          reads options from BayesGraph. Ini file is the active graphic
1410#          configuration file.
1411#
1412# PARAMETERS:
1413#   this  -> Instance of BayesGraph
1414#
1415#/////////////////////////////////////////////////////////////////////////////
1416  upvar \#0 ${this}::data data
1417  upvar \#0 ${this}::options opt
1418  #set rini ::iniFile::Read
1419  set rini ::iniFile::ReadGCF
1420  #Leer las opciones específicas
1421
1422  for  {set gr 0} {$gr<$data(gr,numGraph)} {incr gr} {
1423    set sergrp $data(gr,$gr,sergrp)
1424    set opt(gr,$gr,sergrp,dateString) [$rini SeriesGraph dateString [$sergrp format]]
1425    set opt(gr,$gr,sergrp,xMarkers)   [$rini SeriesGraph SxMarkers   {}]
1426    set opt(gr,$gr,sergrp,xMarkersColors) [$rini SeriesGraph SxMarkersColors\
1427         {#356a6a #804000 #05eefa #009148 #ffffbb}]
1428    set opt(gr,$gr,sergrp,xMarkersWidths) \
1429        [$rini SeriesGraph SxMarkersWidths   {1 1 1 1 1}]
1430    set opt(gr,$gr,sergrp,xMarkersDashes) \
1431        [$rini SeriesGraph SxMarkersDashes   {{1 1} {2 2} {3 3} {4 4} {5 5}}]
1432    foreach key {Ave Dev Var Med Max Min} {
1433      set opt(gr,$gr,sergrp,yMarker$key)  [$rini SeriesGraph SyMarker$key  0]
1434      set opt(gr,$gr,sergrp,yMarkerColor$key)  [$rini SeriesGraph SyMarkerColor$key  defcolor]
1435      set opt(gr,$gr,sergrp,yMarkerDashes$key) [$rini SeriesGraph SyMarkerDashes$key  {3 1}]
1436      set opt(gr,$gr,sergrp,yMarkerWidth$key)  [$rini SeriesGraph SyMarkerWidth$key   1]
1437    }
1438    set opt(gr,$gr,sergrp,yMarkerNDev)  [$rini SeriesGraph SyMarkerNDev   2]
1439    set opt(gr,$gr,sergrp,yMarkers)     [$rini SeriesGraph SyMarkers   {}]
1440    set opt(gr,$gr,sergrp,xAxis)        [$rini SeriesGraph SxAxis      {}]
1441    set opt(gr,$gr,sergrp,lineShowDescription) \
1442      [$rini SeriesGraph lineShowDescription 0]
1443  }
1444  #Leer las opciones de bayesGraph
1445  ::bayesGraph::ReadIni $this
1446}
1447
1448
1449#/////////////////////////////////////////////////////////////////////////////
1450  proc ::SeriesGraph::WriteIni {this} {
1451#
1452# PURPOSE: Writes series graph specific options to .ini file. This procedure
1453#          is called by parent BayesGraph. Ini file is the active graphic
1454#          configuration file.
1455#
1456# PARAMETERS:
1457#   this  -> Instance of BayesGraph
1458#
1459#/////////////////////////////////////////////////////////////////////////////
1460  upvar \#0 ${this}::data data
1461  upvar \#0 ${this}::widgets widgets
1462  upvar \#0 ${this}::options opt
1463 
1464  set gr $data(gr,active)
1465  #set wini ::iniFile::Write
1466  set wini ::iniFile::WriteGCF
1467
1468  $wini SeriesGraph dateString $opt(gr,$gr,sergrp,dateString)
1469  $wini SeriesGraph SxMarkers  $opt(gr,$gr,sergrp,xMarkers)
1470  $wini SeriesGraph SxMarkersColors  $opt(gr,$gr,sergrp,xMarkersColors)
1471  $wini SeriesGraph SxMarkersWidths  $opt(gr,$gr,sergrp,xMarkersWidths)
1472  $wini SeriesGraph SxMarkersDashes  $opt(gr,$gr,sergrp,xMarkersDashes)
1473  foreach key {Ave Dev Var Med Max Min} {
1474    $wini SeriesGraph SyMarker$key       $opt(gr,$gr,sergrp,yMarker$key)
1475    $wini SeriesGraph SyMarkerColor$key  $opt(gr,$gr,sergrp,yMarkerColor$key) 
1476    $wini SeriesGraph SyMarkerDashes$key $opt(gr,$gr,sergrp,yMarkerDashes$key)
1477    $wini SeriesGraph SyMarkerWidth$key  $opt(gr,$gr,sergrp,yMarkerWidth$key)
1478  }
1479  $wini SeriesGraph SyMarkerNDev $opt(gr,$gr,sergrp,yMarkerNDev)
1480  $wini SeriesGraph SyMarkers  $opt(gr,$gr,sergrp,yMarkers)
1481  $wini SeriesGraph SxAxis     $opt(gr,$gr,sergrp,xAxis)
1482
1483  $wini SeriesGraph lineShowDescription \
1484    $opt(gr,$gr,sergrp,lineShowDescription)
1485}
Note: See TracBrowser for help on using the repository browser.