source: tol/tolbaseBLT/lib/toltk/bysgraph.tcl @ 56ade3b

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

fixes #1932, se ha creado la rama trunk/tolbaseBLT copia de trunk/tolbase

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7330 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 42.9 KB
RevLine 
[56ade3b]1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : bysgraph.tcl
3# PURPOSE : This file contains a namespace called bayesGraph with its
4#           functions. Its for creating a graph and managing its events and
5#           changing its options. It is used as parent for other namespaces
6#           that fills graphs elements. Its abstracts the general funcionality
7#           of all kind of graphs.
8#/////////////////////////////////////////////////////////////////////////////
9
10
11#/////////////////////////////////////////////////////////////////////////////
12# TESTING
13#/////////////////////////////////////////////////////////////////////////////
14# Put if {1} for testing this file.
15if {0} {
16  package require Tk
17  package require BWidget
18  package require BLT 
19  Bitmap::use
20  set toltk_script_path [file dirname [info script]]
21  set toltk_images_path [file join $toltk_script_path images]
22  lappend Bitmap::path $toltk_images_path
23  package require msgcat
24  namespace import msgcat::*
25  source bysgropt.tcl
26}
27
28package require Img
29
30#/////////////////////////////////////////////////////////////////////////////
31  namespace eval ::bayesGraph {
32#
33# PURPOSE: The purpose of this namespace is organize code and functions.
34#          A special namespace is created for each instance of bayesGraph.
35#
36# VARIABLES:
37#   tmpOpt  -> temporary array used to store the widgets and variables of the
38#              options dialog.
39#   instance -> asociative array of blt graph widget's path with the instance
40#              of bayesGraph.
41#
42#/////////////////////////////////////////////////////////////////////////////
43  variable tmpOpt
44  variable instance
45 
46  variable optLinesGen [list \
47    linehides        linetypes        barwidth       linewidth \
48    dashes           smooth           barrelief      borderwidth \
49    colors           areaTypes        areaTypesBar   areaTiles \
50    areaForegrounds  areaBackgrounds  stippleimages  stippledegradeds]
51  variable optLinesData [list \
52    showvalues      valuefont    valuerotate  valuecolor \
53    valueformatdec  valueshadow  valueanchor]
54  variable optLinesSymbol [list \
55    showsymbols  symbol   pixels        scalesymbols \
56    fill         outline  outlinewidth]
57  variable optLines "$optLinesGen $optLinesData $optLinesSymbol"
58  variable optLinesAll "$optLines xyMappedAxis"
59}
60
61
62#/////////////////////////////////////////////////////////////////////////////
63  proc ::bayesGraph::Create {path {structure g} args} {
64#
65# PURPOSE: Creates an instance of a bayesGraph. It creates the widget composed
66#          by several panels (one for each graph), a toolbar and a statusbar.
67#
68# PARAMETERS:
69#   path      ->
70#   structure ->
71#
72# RETURN: BayesGraph instance
73#
74#/////////////////////////////////////////////////////////////////////////////
75  variable instance
76  global tcl_platform toltk_images_path
77  set Instance ::bayesGraph::$path
78
79  #  A namespace is created for each bayes graph widget.
80  namespace eval $Instance {
81    # data -> array with information about the instance:
82    #
83    # options ->
84    #
85    # widgets ->
86
87    variable data
88    variable options
89    variable widgets
90  }
91
92  upvar \#0 ${Instance}::widgets widgets
93  upvar \#0 ${Instance}::data data
94  upvar \#0 ${Instance}::options options
95
96  array set opts {
97    -photo 0
98  }
99  array set opts $args
100  set data(onlyphoto) $opts(-photo)
101  # se crea el frame del gráfico 
102  set widgets(this)  [frame $path -class bayesGraph]
103  bind $widgets(this) <Destroy> [list ::bayesGraph::Destroy $Instance]
104  set widgets(frame) ${Instance}::$path
105  # el gráfico consta de 3 sub-frames
106  # 1.- frame de la toolbar
107  set widgets(tb,path) [frame $widgets(this).tb -bd 2 -relief raised]
108  set tb $widgets(tb,path) 
109  set data(tb,btgs) "" 
110  set data(view,active) ""
111  set data(zoom,active) ""
112  ButtonsCreateGeneral $Instance
113  set data(tb,zoomPack) {home zoom-frame zoom-in scale zoom-out scroll}
114
115  # pack de los objetos de la toolbar
116  set but_col 0
117  foreach but $data(tb,btgs) {
118    if { $but == "scale" } {
119      grid $widgets(tb,btg,scale) -row 0 -column $but_col -sticky w
120    } elseif { [string equal -length 3 $but "sep"] } {
121      grid $widgets(tb,btg,$but) -row 0 -column $but_col -sticky ns -padx 3
122    } else {
123      grid $widgets(tb,btg,$but) -row 0 -column $but_col -sticky w -ipadx 2\
124           -ipady 2 -pady 1
125    }
126    incr but_col
127  }
128  grid columnconfigure $tb $but_col -weight 1
129 
130  # 2.- frame de el/los gráfico/s -> $widgets(this).gr   
131  set framegr [frame $widgets(this).gr -bd 2 -relief raised]
132  # procedimiento recursivo que crea los sub-frames y los pw
133  set pw_panel [getPanel $framegr $structure]
134  set pw [lindex $pw_panel 0]
135  set panel [lindex $pw_panel 1]
136  # incluir en cada frames un graph. Pack de los .gr .pn .pw
137
138  set i 0
139  foreach fr $panel {
140    set widgets(gr,$i) [blt::graph $fr.gr]
141    set instance($fr.gr) $Instance
142    pack $widgets(gr,$i) -fill both -expand yes
143    incr i
144  }
145  set data(gr,numGraph) $i
146  #guardamos los panelwindows
147  set widgets(pws) $pw
148  foreach pan $pw {
149    pack $pan -fill both -expand yes
150  }
151
152  # 3.- frame de la status bar -> $widgets(this).sb   
153  set widgets(sb,path) [frame $widgets(this).sb]
154  set sb $widgets(sb,path)
155  set sepPath [Separator $sb.ss -orient horizontal]
156  set sfPath [frame $sb.sf]
157  set widgets(sb,lCursor) [label $sfPath.cursor -anchor w -text "t= ,z= " -relief sunken]
158  set widgets(sb,lInfo)   [label $sfPath.info   -anchor w -text "" -relief sunken]
159
160  global zoomInfo
161  set data(gr,active) 0
162  activeGraph 0 $Instance
163
164  # configurar acciones de cada graph
165  for  {set i 0} {$i<$data(gr,numGraph)} {incr i 1} {
166    set item $widgets(gr,$i)
167    trace variable zoomInfo($item,scale) w "::bayesGraph::OnChangeScale $Instance;\#"
168    set zoomInfo($item,scale) 0.5
169    #bind $item <ButtonPress-1> [list bayesGraph::activeGraph $i $Instance]
170    bind $item <ButtonPress-3> [list bayesGraph::activeGraph $i $Instance]
171    bind $item <Any-Motion> [list ::bayesGraph::UpdateCursorLabel $i $Instance %x %y]
172    bind $item <Control-c> [list ::bayesGraph::Copy $Instance]
173  }
174  # set the cursors for each mode
175  if { [string equal $tcl_platform(platform) "windows"] } {
176    set tail ".cur"
177  } else {
178    set tail "_cur.xbm black"
179  }
180
181  foreach cur_info {{zoom-frame zoomframe} {zoom-in zoomin} {zoom-out zoomout}} {
182    set tvcur [file join ${toltk_images_path} [lindex $cur_info 1]]
183    regsub -all " " $tvcur {\ } tvcur
184    set widgets(cursor,[lindex $cur_info 0]) "@$tvcur$tail"
185  }
186  set widgets(cursor,scroll) hand2
187  set widgets(cursor,) [$widgets(gr,$data(gr,active)) cget -cursor]
188  # bind AXIS
189  ::bayesGraph::BindAxis $Instance
190  # pack de los objetos de la status bar
191  grid $widgets(sb,lInfo)   -row 0 -column 0 -sticky ew -padx 5
192  grid $widgets(sb,lCursor) -row 0 -column 1 -sticky w  -padx 5
193  grid columnconfigure $sfPath 0 -weight 1
194  grid $sepPath -sticky ew -pady 2
195  grid $sfPath -sticky ew
196  grid columnconfigure $widgets(sb,path) 0 -weight 1
197 
198  # pack frames...
199  grid $tb -sticky ew
200  grid $framegr  -sticky news
201  grid $sb -sticky ew 
202  grid columnconfigure $path 0 -weight 1
203  grid rowconfigure    $path 1 -weight 1
204
205   focus $widgets(tb,btg,scale)
206#  focus $widgets(this)
207
208  ::bayesGraph::ZoomFrame $Instance
209  return $Instance
210}
211
212
213#/////////////////////////////////////////////////////////////////////////////
214proc ::bayesGraph::FormatAxis {this axis bltg tick} {
215#
216#///////////////////////////////////////////////////////////////////////////// 
217  return "$tick"
218}
219
220
221#/////////////////////////////////////////////////////////////////////////////
222proc ::bayesGraph::BindLegend {Instance} {
223#
224#/////////////////////////////////////////////////////////////////////////////
225  upvar \#0 ${Instance}::data data
226  upvar \#0 ${Instance}::widgets widgets
227
228  for  {set gr 0} {$gr<$data(gr,numGraph)} {incr gr 1} {
229    set grpath $widgets(gr,$gr)
230    $grpath legend bind all <Enter> \
231       [list ::bayesGraph::changeCursor $Instance $grpath $widgets(cursor,scroll)]
232    $grpath legend bind all <Leave> \
233       [list ::bayesGraph::changeCursor $Instance $grpath last]
234    set idx 1
235    foreach git $data(gr,$gr,elements) {
236      foreach it $git {
237        $grpath legend bind $it <Double-Button-1> \
238           [list ::bayesGraph::GrapOpt $Instance -tabshow Lines -nline $idx]
239      }
240      incr idx       
241    }
242  }
243}
244
245#/////////////////////////////////////////////////////////////////////////////
246proc ::bayesGraph::BindAxis {Instance} {
247#
248#/////////////////////////////////////////////////////////////////////////////
249  upvar \#0 ${Instance}::data data
250  upvar \#0 ${Instance}::widgets widgets
251
252  for  {set gr 0} {$gr<$data(gr,numGraph)} {incr gr 1} {
253    set grpath $widgets(gr,$gr)
254    $grpath axis bind all <Enter> \
255       [list ::bayesGraph::changeCursor $Instance $grpath $widgets(cursor,scroll)]
256    $grpath axis bind all <Leave> \
257       [list ::bayesGraph::changeCursor $Instance $grpath last]
258
259    foreach it {x x2 y y2} {
260      $grpath axis bind $it <Double-Button-1> \
261        [list ::bayesGraph::GrapOpt $Instance -tabshow Axis -iniaxis $it]
262    }
263  }
264}
265
266
267#/////////////////////////////////////////////////////////////////////////////
268proc ::bayesGraph::getInstance {graph} {
269#
270#///////////////////////////////////////////////////////////////////////////// 
271  variable instance
272  return $instance($graph)
273}
274
275
276#/////////////////////////////////////////////////////////////////////////////
277proc ::bayesGraph::Configure {this} {
278# 
279#///////////////////////////////////////////////////////////////////////////// 
280  upvar \#0 ${this}::data data
281  upvar \#0 ${this}::options opt
282  set old_active $data(gr,active)
283  for {set gr 0} {$gr<$data(gr,numGraph)} {incr gr} {
284    set data(gr,active) $gr
285
286    GrapOptApplyMappedLines  $this ${this}::options gr,$gr
287    GrapOptApplyAxisPos      $this ${this}::options gr,$gr
288    GrapOptApplyAxisTicks    $this ${this}::options gr,$gr
289    GrapOptApplyTicksStyle   $this ${this}::options gr,$gr
290    GrapOptApplyTitles       $this ${this}::options gr,$gr
291    GrapOptApplyLnesAll      $this ${this}::options gr,$gr
292    GrapOptApplyMarkers      $this ${this}::options gr,$gr
293    GrapOptApplyMarkersIn    $this ${this}::options gr,$gr
294    GrapOptApplyGrid         $this ${this}::options gr,$gr,grid
295    GrapOptApplyLegend       $this ${this}::options gr,$gr,legend
296    GrapOptApplyStyle        $this ${this}::options gr,$gr
297    #Esta opción solo tiene efecto cuando el gráfico está empacado
298    GrapOptApplyAxisTicks    $this ${this}::options gr,$gr
299    GrapOptApplyOrder        $this ${this}::options gr,$gr
300    # Show Line
301    if {![info exists opt(gr,$gr,linehides)] || \
302        ![info exists tmpOpt(${this}::options,linehides)] || \
303        ![string equal $opt(gr,$gr,linehides) $tmpOpt(${this}::options,linehides)]} {
304      GrapOptApplyLineDefault $this ${this}::options gr,$gr hide linehides
305    }     
306   
307   
308    # Ajust axis chart of values
309    if {$opt(gr,$gr,selffit)} {
310      ::bayesGraph::ZoomExtend $this
311    }
312  }
313  set data(gr,active) $old_active
314  if $opt(grid) {
315    ::bayesGraph::ToggleGrid $this
316  }
317}
318
319
320#/////////////////////////////////////////////////////////////////////////////
321proc ::bayesGraph::ButtonsCreateGeneral {this} {
322#
323#///////////////////////////////////////////////////////////////////////////// 
324  upvar \#0 ${this}::widgets widgets
325  upvar \#0 ${this}::data data
326  set widgets(tbg,path) [frame $widgets(tb,path).tbg -bd 2]
327  set tbg $widgets(tbg,path) 
328
329  pack $tbg -side left
330  #grid $tbg -sticky ew
331  # anexamos botones generales
332  set widgets(tb,btg,home) [Button $tbg.home -image [::Bitmap::get "home"] \
333    -highlightthickness 0 -activebackground \#ececec -takefocus 0 \
334    -relief link -bd 1 -padx 1 -pady 1 -helptext [mc "Zoom extend"] \
335    -command [list ::bayesGraph::ZoomExtend $this]]
336  lappend data(tb,btgs) home
337  set widgets(tb,btg,zoom-frame) [Button $tbg.zframe \
338    -image [::Bitmap::get "zoomframe"] -highlightthickness 0 \
339    -activebackground \#ececec -takefocus 0 -relief link -bd 1 -padx 1 \
340    -pady 1 -helptext [mc "Zoom frame"] \
341    -command [list ::bayesGraph::ZoomFrame $this]]
342  lappend data(tb,btgs) zoom-frame
343  set widgets(tb,btg,zoom-in) [Button $tbg.zoomin -image [::Bitmap::get "zoomin"] \
344    -highlightthickness 0 -activebackground \#ececec -takefocus 0 \
345    -relief link -bd 1 -padx 1 -pady 1 -helptext [mc "Zoom In"] \
346    -command [list ::bayesGraph::ZoomIn $this]]
347  lappend data(tb,btgs) zoom-in
348  set widgets(tb,btg,scale) [scale $tbg.sc -orient horizontal -width 8 -bd 1 \
349    -sliderlength 15 -from 0.01 -to 1 -resolution 0.01 -showvalue 0]
350  lappend data(tb,btgs) scale
351  set widgets(tb,btg,zoom-out) [Button $tbg.zoomout -image [::Bitmap::get "zoomout"] \
352    -highlightthickness 0 -activebackground \#ececec -takefocus 0 \
353    -relief link -bd 1 -padx 1 -pady 1 -helptext [mc "Zoom Out"] \
354    -command [list ::bayesGraph::ZoomOut $this]]
355  lappend data(tb,btgs) zoom-out
356  set widgets(tb,btg,scroll) [Button $tbg.scroll -image [::Bitmap::get "scroll"] \
357    -highlightthickness 0 -activebackground \#ececec -takefocus 0 \
358    -relief link -bd 1 -padx 1 -pady 1 -helptext [mc "Scroll view"] \
359    -command [list ::bayesGraph::ScrollView $this]]
360  lappend data(tb,btgs) scroll
361  set widgets(tb,btg,sep1) [Separator $tbg.sep1 -orient vertical]
362  lappend data(tb,btgs) sep1 
363  set widgets(tb,btg,grid) [Button $tbg.grid -image [::Bitmap::get "grid"] \
364    -highlightthickness 0 -activebackground \#ececec -takefocus 0 \
365    -relief link -bd 1 -padx 1 -pady 1 -helptext [mc "Toggle grid mode"] \
366    -command [list ::bayesGraph::ToggleGrid $this]]
367  lappend data(tb,btgs) grid
368  set widgets(tb,btg,crosshair) [Button $tbg.cross \
369    -image [::Bitmap::get "crosshair"] -highlightthickness 0 \
370    -activebackground \#ececec -takefocus 0 -relief link -bd 1 -padx 1 \
371    -pady 1 -helptext [mc "Toggle crosshair mode"] \
372    -command [list ::bayesGraph::ToggleCrosshair $this]]
373  lappend data(tb,btgs) crosshair
374  set widgets(tb,btg,gobegin) [Button $tbg.beg -image [::Bitmap::get "begin"] \
375    -highlightthickness 0 -activebackground \#ececec -takefocus 0 \
376    -relief link -bd 1 -padx 1 -pady 1 -helptext [mc "Skip to first data"] \
377    -command [list ::bayesGraph::SeeBegin $this]]
378  lappend data(tb,btgs) gobegin
379  set widgets(tb,btg,playback) [Button $tbg.playb \
380    -image [::Bitmap::get "backward"] -highlightthickness 0 \
381    -activebackground \#ececec -takefocus 0 -relief link -bd 1 -padx 1 \
382    -pady 1 -helptext [mc "Play backward"] \
383    -command [list ::bayesGraph::PlayBackward $this]]
384  lappend data(tb,btgs) playback
385  set widgets(tb,btg,stop) [Button $tbg.stop -image [::Bitmap::get "stopplay"] \
386    -highlightthickness 0 -activebackground \#ececec -takefocus 0 \
387    -relief link -bd 1 -padx 1 -pady 1 -helptext [mc "Stop playing"] \
388    -command [list ::bayesGraph::StopPlaying $this]]
389  lappend data(tb,btgs) stop
390  set widgets(tb,btg,playfor) [Button $tbg.playf \
391    -image [::Bitmap::get "forward"] -highlightthickness 0 \
392    -activebackground \#ececec -takefocus 0 -relief link -bd 1 -padx 1 \
393    -pady 1 -helptext [mc "Play forward"] \
394    -command [list ::bayesGraph::PlayForward $this]] 
395  lappend data(tb,btgs) playfor
396  set widgets(tb,btg,goend) [Button $tbg.end -image [::Bitmap::get "end"] \
397    -highlightthickness 0 -activebackground \#ececec -takefocus 0 \
398    -relief link -bd 1 -padx 1 -pady 1 -helptext [mc "Skip to last data"] \
399    -command [list ::bayesGraph::SeeEnd $this]]
400  lappend data(tb,btgs) goend
401  set widgets(tb,btg,snap) [Button $tbg.snap -image [::Bitmap::get "camera"] \
402    -highlightthickness 0 -activebackground \#ececec -takefocus 0 \
403    -relief link -bd 1 -padx 1 -pady 1 \
404    -helptext [mc "Take a photo of the graphic"] \
405    -command [list ::bayesGraph::TakePhoto $this]] 
406  lappend data(tb,btgs) snap
407  set widgets(tb,btg,copy) [Button $tbg.copy -image [::Bitmap::get "bcopy"] \
408    -highlightthickness 0 -activebackground \#ececec -takefocus 0 \
409    -relief link -bd 1 -padx 1 -pady 1 -helptext [mc "Copy to clipboard"] \
410    -command [list ::bayesGraph::Copy $this]] 
411  lappend data(tb,btgs) copy
412  set widgets(tb,btg,calc) [Button $tbg.calc -image [::Bitmap::get "calc"] \
413    -highlightthickness 0 -activebackground \#ececec -takefocus 0 \
414    -relief link -bd 1 -padx 1 -pady 1 -helptext [mc "To Eval window"] \
415    -command [list ::bayesGraph::ToEvalWindow $this]]
416  lappend data(tb,btgs) calc
417  set widgets(tb,btg,table) [Button $tbg.table -image [::Bitmap::get "table"] \
418    -highlightthickness 0 -activebackground \#ececec -takefocus 0 \
419    -relief link -bd 1 -padx 1 -pady 1 -helptext [mc "View as table"] \
420    -command [list ::bayesGraph::ToTable $this]]
421  lappend data(tb,btgs) table
422  set widgets(tb,btg,sep2) [Separator $tbg.sep2 -orient vertical]
423  lappend data(tb,btgs) sep2 
424  set widgets(tb,btg,options) [Button $tbg.options \
425    -image [::Bitmap::get "tools"] -highlightthickness 0 \
426    -activebackground \#ececec -takefocus 0 -relief link -bd 1 -padx 1 \
427    -pady 1 -helptext [mc "Graphic Options"] \
428    -command [list ::bayesGraph::GrapOpt $this]]
429  lappend data(tb,btgs) options
430  trace variable ${this}::options(GCFFile) w [list ::bayesGraph::TraceGCFFile $this]
431  set widgets(tb,btg,editConf) [Entry $tbg.editConf -width 12 \
432    -textvariable ${this}::options(GCFName) -state disabled]
433  lappend data(tb,btgs) editConf
434  set widgets(tb,btg,openConf) [Button $tbg.openConf \
435    -image [::Bitmap::get "bopen"] -highlightthickness 0 \
436    -activebackground \#ececec -takefocus 0 -relief link -bd 1 -padx 1 \
437    -pady 1 \
438    -helptext [mc "Load graph options from a Graphic Configuration File"] \
439    -command [list ::bayesGraph::OpenGraphOpt $this]]
440  lappend data(tb,btgs) openConf
441  set widgets(tb,btg,saveConf) [Button $tbg.saveConf -image [::Bitmap::get "bsave"] \
442    -highlightthickness 0 -activebackground \#ececec -takefocus 0 \
443    -relief link -bd 1 -padx 1 -pady 1 \
444    -helptext [mc "Save the current graph options in a Graphic Configuration File"] \
445    -command [list ::bayesGraph::SaveGraphOpt $this]]
446  lappend data(tb,btgs) saveConf
447
448}
449
450
451#/////////////////////////////////////////////////////////////////////////////
452proc ::bayesGraph::TraceGCFFile {this name1 name2 op} {
453#
454#///////////////////////////////////////////////////////////////////////////// 
455  upvar \#0 ${this}::options opt
456
457  set opt(GCFName) [file tail $opt(GCFFile)]
458}
459
460
461#/////////////////////////////////////////////////////////////////////////////
462proc ::bayesGraph::getPanel {panel list} {
463#
464#///////////////////////////////////////////////////////////////////////////// 
465  set lpw ""
466  set lpn ""
467  set resp ""
468  set tside [lindex $list 0]
469  if {$tside == "g"} {
470    lappend lpn $panel
471  } else  {
472    if {$tside == "v"} {
473      set pw [PanedWindow $panel.pw -side bottom -pad 0]
474    } else  {
475      set pw [PanedWindow $panel.pw -side left -pad 0]
476    }
477    lappend lpw $pw
478    for  {set i 1} {$i <= 2} {incr i 1} {
479      if {[lindex $list $i] == "g"} {
480        lappend lpn [$pw add -weight 1]
481      } else  {
482        set x [getPanel [$pw add -weight 1] [lindex $list $i]]
483        foreach but [lindex $x 0] {       
484          lappend lpw $but
485        }
486        foreach but [lindex $x 1] {       
487          lappend lpn $but
488        }
489      }
490    }
491  }
492  lappend resp $lpw $lpn
493  #Tolcon_Trace "Resp: $resp"
494  return $resp
495}
496
497
498#/////////////////////////////////////////////////////////////////////////////
499proc bayesGraph::activeGraph {numGraph this} {
500#
501#///////////////////////////////////////////////////////////////////////////// 
502  upvar \#0 ${this}::widgets widgets
503  upvar \#0 ${this}::data data
504  # inicializo el entorno del gragh seleccionado
505  set data(gr,active) $numGraph
506
507  $widgets(tb,btg,scale) configure -variable zoomInfo($widgets(gr,$data(gr,active)),scale)
508  #Tolcon_Trace "scale widget variable configurada a zoomInfo($widgets(gr,$data(gr,active)),scale) "
509  # resaltar el gráfico
510  focus $widgets(gr,$numGraph)
511}
512
513
514#/////////////////////////////////////////////////////////////////////////////
515proc ::bayesGraph::Destroy {this} {
516#
517#///////////////////////////////////////////////////////////////////////////// 
518  upvar \#0 ${this}::data data
519  if {!$data(onlyphoto)} {
520    WriteIni $this 0
521  }
522  namespace delete $this
523}
524
525
526#/////////////////////////////////////////////////////////////////////////////
527proc ::bayesGraph::OnChangeScale { this } {
528#
529#///////////////////////////////////////////////////////////////////////////// 
530  upvar \#0 ${this}::widgets widgets
531  upvar \#0 ${this}::data data 
532  global zoomInfo
533  set gr $data(gr,active)
534  ::DynamicHelp::register $widgets(tb,btg,scale) \
535      balloon $zoomInfo($widgets(gr,$gr),scale)
536}
537
538
539#/////////////////////////////////////////////////////////////////////////////
540proc ::bayesGraph::UpdateCursorLabel { numGraph this x y } {
541#
542#///////////////////////////////////////////////////////////////////////////// 
543  upvar \#0 ${this}::widgets widgets
544  upvar \#0 ${this}::data data
545
546  set graph $widgets(gr,$numGraph)
547  if { [ $graph inside $x $y ] } {
548    #set t [expr round([$widgets(gr,$numGraph) axis invtransform x $x])]
549    set t [ $graph axis invtransform x $x ]
550    set z [ format "%.2f" [ $graph axis invtransform y $y ] ]
551    if { [ info exists ${this}::data(proc,OnGetLabel) ] } {
552      if { [$graph element closest $x $y infoLine -interpolate yes] } {
553        set nameLine $infoLine(name)
554      } else {
555        set nameLine ""
556      }
557      set label [$data(proc,OnGetLabel) \
558                     $this $graph $nameLine $t $z]
559    } else {
560      set label "X = $t, Y = $z"
561    }
562    $widgets(sb,lCursor) configure -text $label
563  }
564}
565
566
567#/////////////////////////////////////////////////////////////////////////////
568proc ::bayesGraph::CreateColorTable { table ncolors } {
569#
570#///////////////////////////////////////////////////////////////////////////// 
571  upvar $table tbl
572  set ncol [ expr $ncolors - 1]
573  if { $ncol <= 0} { set ncol 1}
574  set xfir [ expr $ncol * 0.10]
575  set xqua [ expr $ncol * 0.35]
576  set xmed [ expr $ncol * 0.50]
577  set xthi [ expr $ncol * 0.65]
578  set xlas [ expr $ncol * 0.90]
579  set xdiv1 [ expr $xqua - $xfir]
580  set xdiv2 [ expr $xmed - $xqua]
581 
582  for { set jcolor 1} { $jcolor <= $ncolors} { incr jcolor} {
583    set xcolor [ expr $jcolor - 1]
584   
585    # Los Azules
586    if { $xcolor <= $xfir } {
587      set blue [ expr 0.5 + $xcolor / ( $xfir * 2.0)]
588    } elseif { $xcolor <= $xqua } {
589      set blue 1.0
590    } elseif { $xcolor <= $xmed } {
591      set blue [ expr 1.0 - ( $xcolor - $xqua) / $xdiv2]
592    } else { set blue 0.0 }
593   
594    # Los Verdes
595    if { $xcolor <= $xfir } {
596      set green 0.0
597    } elseif { $xcolor <= $xqua } {
598      set green [ expr ( $xcolor - $xfir) / $xdiv1]
599    } elseif { $xcolor <= $xthi } {
600      set green 1.0
601    } elseif { $xcolor <= $xlas } {
602      set green [ expr 1.0 - ( $xcolor - $xthi) / $xdiv1]
603    } else { set green 0.0 }
604   
605    # I los Rohos
606    if { $xcolor <= $xmed } {
607      set red 0.0
608    } elseif { $xcolor <= $xthi} {
609      set red [ expr ( $xcolor - $xmed) / $xdiv2]
610    } elseif { $xcolor <= $xlas} {
611      set red 1.0
612    } else {
613      set red [ expr 1.0 - ( $xcolor - $xlas) / ( $xfir * 2.0)]
614    }
615   
616    if { $red < 0.0 } { set red 0.0 }
617    if { $green < 0.0 } { set green 0.0 }
618    if { $blue < 0.0 } { set blue 0.0 }
619    if { $red > 1.0 } { set red 1.0 }
620    if { $green > 1.0 } { set green 1.0 }
621    if { $blue > 1.0 } { set blue 1.0 }
622   
623    set red [ expr int( $red * 255.0)]
624    set green [ expr int( $green * 255.0)]
625    set blue [ expr int( $blue * 255.0)]
626    lappend tbl [format \#%02x%02x%02x $red $green $blue]
627  }
628}
629
630#/////////////////////////////////////////////////////////////////////////////
631# TOOLBAR GRAPH OPTIONS IMPLEMENTATION
632#/////////////////////////////////////////////////////////////////////////////
633
634#/////////////////////////////////////////////////////////////////////////////
635  proc ::bayesGraph::ZoomExtend { this } {
636#
637# PURPOSE: Expands x and y axis to its initial maximum values for the active
638#          graph.
639#
640# PARAMETERS:
641#   this -> bayesgraph instance
642#
643#/////////////////////////////////////////////////////////////////////////////
644  upvar \#0 ${this}::widgets widgets
645  upvar \#0 ${this}::data data
646  set gr $data(gr,active)
647 
648  variable tmpOpt
649  # valor maximo y minimo
650  foreach axis {x y x2 y2} {
651    set values_${axis} [::bayesGraph::GetLimitsValueAxis $this $axis]
652  }
653  # comprobamos que existan valores y aplicamos
654  if {([info exists values_y]) && ([llength $values_y])} {
655
656    set tmpOpt(var,yAxisMin) [lindex $values_y 0]
657    set tmpOpt(var,yAxisMax) [lindex $values_y 1]
658    ::bayesGraph::GrapOptApplyAxisLimits $this y \
659      [expr $tmpOpt(var,yAxisMin) - abs($tmpOpt(var,yAxisMin) / 100)] \
660      [expr $tmpOpt(var,yAxisMax) + abs($tmpOpt(var,yAxisMax) / 100)]
661  }
662  if {([info exists values_y2]) && ([llength $values_y2])} {
663    set tmpOpt(var,y2AxisMin) [lindex $values_y2 0]
664    set tmpOpt(var,y2AxisMax) [lindex $values_y2 1]
665    ::bayesGraph::GrapOptApplyAxisLimits $this y2 \
666      [expr $tmpOpt(var,y2AxisMin) - abs($tmpOpt(var,y2AxisMin) / 100)] \
667      [expr $tmpOpt(var,y2AxisMax) + abs($tmpOpt(var,y2AxisMax) / 100)]
668  }
669  if {([info exists values_x]) && ([llength $values_x])} {
670    set tmpOpt(var,xAxisMin) [lindex $values_x 0]
671    set tmpOpt(var,xAxisMax) [lindex $values_x 1]
672    ::bayesGraph::GrapOptApplyAxisLimits $this x \
673      $tmpOpt(var,xAxisMin) $tmpOpt(var,xAxisMax)
674  }
675  if {([info exists values_x2]) && ([llength $values_x2])} {
676    set tmpOpt(var,x2AxisMin) [lindex $values_x2 0]
677    set tmpOpt(var,x2AxisMax) [lindex $values_x2 1]
678    ::bayesGraph::GrapOptApplyAxisLimits $this x2 \
679      $tmpOpt(var,x2AxisMin) $tmpOpt(var,x2AxisMax)
680  }
681  #Aplicamos valores a loe ejes
682  GrapOptApplyAxisTicks    $this ${this}::options gr,$gr
683}
684
685#/////////////////////////////////////////////////////////////////////////////
686  proc ::bayesGraph::ZoomFrame { this } {
687#
688# PURPOSE: Sets zoom-frame mode for the blt graph
689#     
690# PARAMETERS:
691#   this -> bayesgraph instance
692#
693#/////////////////////////////////////////////////////////////////////////////
694  SetViewMode $this zoom-frame
695}
696
697
698#/////////////////////////////////////////////////////////////////////////////
699  proc ::bayesGraph::ZoomIn { this } {
700#
701# PURPOSE: Sets zoom-in mode for the blt graph
702#     
703# PARAMETERS:
704#   this -> bayesgraph instance
705#
706#/////////////////////////////////////////////////////////////////////////////
707
708  SetViewMode $this zoom-in
709}
710
711
712#/////////////////////////////////////////////////////////////////////////////
713  proc ::bayesGraph::ZoomOut { this } {
714#
715# PURPOSE: Sets zoom-out mode for the blt graph
716#     
717# PARAMETERS:
718#   this -> bayesgraph instance
719#
720#/////////////////////////////////////////////////////////////////////////////
721
722  SetViewMode $this zoom-out
723}
724
725
726#/////////////////////////////////////////////////////////////////////////////
727  proc ::bayesGraph::ScrollView { this } {
728#
729# PURPOSE: Sets scroll mode for the blt graph
730#     
731# PARAMETERS:
732#   this -> bayesgraph instance
733#
734#/////////////////////////////////////////////////////////////////////////////
735
736  SetViewMode $this scroll
737}
738
739
740#/////////////////////////////////////////////////////////////////////////////
741  proc ::bayesGraph::SetViewMode { this mode } {
742#
743# PURPOSE: Sets zoom (or scroll) mode for the blt graph. It also enables and
744#          disables toolbar buttons and sets cursors types acording to the
745#          mode choosen.
746#     
747# PARAMETERS:
748#   this -> bayesgraph instance
749#   mode -> mode for the blt graph
750#
751#/////////////////////////////////////////////////////////////////////////////
752
753  upvar \#0 ${this}::data data
754  upvar \#0 ${this}::widgets widgets
755  set active $data(zoom,active)
756  if { $active != "" } {
757    $widgets(tb,btg,$active) configure -relief link
758  }
759  if { [string compare $active $mode] } {
760    set active [set data(zoom,active) $mode]
761    $widgets(tb,btg,$mode) configure -relief sunken   
762  } else {
763    set active [set data(zoom,active) ""]     
764  }
765  for  {set gr 0} {$gr<$data(gr,numGraph)} {incr gr 1} {
766    set item $widgets(gr,$gr)
767    $item configure -cursor $widgets(cursor,$active)
768    Blt_ViewMode $item $active
769  }
770
771}
772
773
774#/////////////////////////////////////////////////////////////////////////////
775  proc ::bayesGraph::ToggleButton { this button } {
776#
777# PURPOSE: Changes state of a button between on (relief sunken) and off
778#          (relief link)
779#     
780# PARAMETERS:
781#   this   -> bayesgraph instance
782#   button -> button to toggle
783#
784#/////////////////////////////////////////////////////////////////////////////
785
786  upvar \#0 ${this}::widgets widgets
787  upvar \#0 ${this}::data data
788  if { [string equal [$widgets(tb,btg,$button) cget -relief] "link"] } {
789    set relief "sunken"
790    set state 1
791  } else {
792    set relief "link"
793    set state 0
794  }
795  $widgets(tb,btg,$button) configure -relief $relief
796  return $state
797}
798
799
800#/////////////////////////////////////////////////////////////////////////////
801  proc ::bayesGraph::ToggleGrid { this } {
802#
803# PURPOSE: Changes grid option between enabled and disabled for all graphs in
804#          the instance.
805#     
806# PARAMETERS:
807#   this -> bayesgraph instance
808#
809#/////////////////////////////////////////////////////////////////////////////
810
811  upvar \#0 ${this}::widgets widgets
812  upvar \#0 ${this}::data data
813  upvar \#0 ${this}::options opt
814
815  set opt(grid) [ToggleButton $this "grid"]
816  for  {set i 0} {$i<$data(gr,numGraph)} {incr i 1} {
817    set item $widgets(gr,$i)
818    $item grid toggle
819  }
820}
821
822
823#/////////////////////////////////////////////////////////////////////////////
824  proc ::bayesGraph::ToggleCrosshair { this } {
825#
826# PURPOSE: Changes crosshair option between enabled and disabled for all
827#          graphs in the instance.
828#     
829# PARAMETERS:
830#   this -> bayesgraph instance
831#
832#/////////////////////////////////////////////////////////////////////////////
833
834  upvar \#0 ${this}::widgets widgets
835  upvar \#0 ${this}::data data
836  if { [ToggleButton $this "crosshair"] } {
837    for  {set i 0} {$i<$data(gr,numGraph)} {incr i 1} {
838      set item $widgets(gr,$i)
839      blt::Crosshairs $item
840    }   
841  } else {
842    for  {set i 0} {$i<$data(gr,numGraph)} {incr i 1} {
843      set item $widgets(gr,$i)
844      blt::ClearCrosshairs $item
845    }
846  }
847}
848
849
850#/////////////////////////////////////////////////////////////////////////////
851  proc ::bayesGraph::DisableView { this } {
852#
853# PURPOSE:
854#     
855# PARAMETERS:
856#   this -> bayesgraph instance
857#
858#/////////////////////////////////////////////////////////////////////////////
859
860  upvar \#0 ${this}::widgets widgets
861  upvar \#0 ${this}::data data
862  set active $data(view,active)
863  if { [string length $active] } {
864    # this disable (toggle) the current view mode
865    SetViewMode $this $active
866  }
867  foreach but $data(tb,zoomPack) {
868    $widgets(tb,btg,$but) configure -state disable
869  }
870}
871
872
873#/////////////////////////////////////////////////////////////////////////////
874  proc ::bayesGraph::EnableView { this mode } {
875#
876# PURPOSE:
877#     
878# PARAMETERS:
879#   this -> bayesgraph instance
880#   mode ->
881#
882#/////////////////////////////////////////////////////////////////////////////
883
884  upvar \#0 ${this}::widgets widgets
885  upvar \#0 ${this}::data data
886  if { [string length $mode] } {
887    SetViewMode $this $mode
888  }
889  foreach but $data(tb,zoomPack) {
890    $widgets(tb,btg,$but) configure -state normal
891  }
892}
893
894
895#/////////////////////////////////////////////////////////////////////////////
896  proc ::bayesGraph::StatePlay { this state} {
897#
898# PURPOSE:
899#     
900# PARAMETERS:
901#   this -> bayesgraph instance
902#
903#/////////////////////////////////////////////////////////////////////////////
904
905  upvar \#0 ${this}::widgets widgets
906  upvar \#0 ${this}::data data
907  foreach but [list gobegin playback playfor goend] {
908    $widgets(tb,btg,$but) configure -state $state
909  }
910}
911 
912
913#/////////////////////////////////////////////////////////////////////////////
914  proc ::bayesGraph::SeeBegin { this } {
915#
916# PURPOSE:
917#     
918# PARAMETERS:
919#   this -> bayesgraph instance
920#
921#/////////////////////////////////////////////////////////////////////////////
922  upvar \#0 ${this}::widgets widgets
923  upvar \#0 ${this}::data data
924  global zoomInfo
925  set gr $data(gr,active)
926  set active $data(view,active)
927  DisableView $this
928  set limits  [$widgets(gr,$gr) axis limits x]
929  set limits2 [$widgets(gr,$gr) axis limits x2]
930 
931  set delta  [expr [lindex $limits  1] - [lindex $limits  0]]
932  set delta2 [expr [lindex $limits2 1] - [lindex $limits2 0]]
933  if {[string length $limits] } {
934    ::bayesGraph::GrapOptApplyAxisLimits $this x  0 $delta
935  }
936  if {[string length $limits2]} {
937    ::bayesGraph::GrapOptApplyAxisLimits $this x2 0 $delta2
938  }
939  EnableView $this $active
940  set zoomInfo($widgets(gr,$gr),stack) {}
941}
942
943#/////////////////////////////////////////////////////////////////////////////
944  proc ::bayesGraph::PlayBackward { this } {
945#
946# PURPOSE:
947#
948# PARAMETERS:
949#   this -> bayesgraph instance
950#
951#/////////////////////////////////////////////////////////////////////////////
952  upvar \#0 ${this}::widgets widgets
953  upvar \#0 ${this}::data data
954  global zoomInfo
955  set gr $data(gr,active)
956  set active $data(view,active)
957  DisableView $this
958  StatePlay $this disable
959  set data(stopflag) 0
960  set limits  [$widgets(gr,$gr) axis limits x]
961  set limits2 [$widgets(gr,$gr) axis limits x2]
962  set t0  [expr round([lindex $limits  0])]
963  set t1  [expr round([lindex $limits  1])]
964  set t20 [expr round([lindex $limits2 0])]
965  set t21 [expr round([lindex $limits2 1])]
966 
967  set values  [::bayesGraph::GetLimitsValueAxis $this x]
968  set values2 [::bayesGraph::GetLimitsValueAxis $this x2]
969  set minX  [lindex $values  0]
970  set minX2 [lindex $values2 0]
971  set ok  1
972  set ok2 1
973  while { !$data(stopflag) && ($ok || $ok2)} {
974    # comprobamos que hay valores para el eje X
975    if {[string length $limits] && [string length $values]} {
976      ::bayesGraph::GrapOptApplyAxisLimits $this x  $t0 $t1
977      incr t0 -1
978      incr t1 -1
979      set ok [expr $t0 >= $minX]
980    } else  {
981      set ok 0
982    }
983    # comprobamos que hay valores para el eje X2
984    if {[string length $limits2] && [string length $values2]} {
985      ::bayesGraph::GrapOptApplyAxisLimits $this x2 $t20 $t21
986      incr t20 -1
987      incr t21 -1
988      set ok2 [expr $t20 >= $minX2]
989    } else  {
990      set ok2 0
991    }
992    update
993  }
994  EnableView $this $active
995  StatePlay $this normal
996  set zoomInfo($widgets(gr,$gr),stack) {}
997}
998
999#/////////////////////////////////////////////////////////////////////////////
1000  proc ::bayesGraph::StopPlaying { this } {
1001#
1002# PURPOSE:
1003#     
1004# PARAMETERS:
1005#   this -> bayesgraph instance
1006#
1007#/////////////////////////////////////////////////////////////////////////////
1008
1009  upvar \#0 ${this}::data data
1010  set data(stopflag) 1
1011}
1012
1013#/////////////////////////////////////////////////////////////////////////////
1014  proc ::bayesGraph::PlayForward { this } {
1015#
1016# PURPOSE:
1017#
1018# PARAMETERS:
1019#   this -> bayesgraph instance
1020#
1021#/////////////////////////////////////////////////////////////////////////////
1022  upvar \#0 ${this}::widgets widgets
1023  upvar \#0 ${this}::data data
1024  global zoomInfo
1025  set gr $data(gr,active)
1026  set active $data(view,active)
1027  DisableView $this
1028  StatePlay $this disable
1029  set data(stopflag) 0
1030  set limits  [$widgets(gr,$gr) axis limits x]
1031  set limits2 [$widgets(gr,$gr) axis limits x2]
1032  set t0  [expr round([lindex $limits  0])]
1033  set t1  [expr round([lindex $limits  1])]
1034  set t20 [expr round([lindex $limits2 0])]
1035  set t21 [expr round([lindex $limits2 1])]
1036 
1037  set values  [::bayesGraph::GetLimitsValueAxis $this x]
1038  set values2 [::bayesGraph::GetLimitsValueAxis $this x2]
1039  set maxX  [lindex $values 1]
1040  set maxX2 [lindex $values2 1]
1041  set ok  1
1042  set ok2 1
1043 
1044  while { !$data(stopflag) && ($ok || $ok2)} {
1045    # comprobamos valores eje X
1046    if {[string length $limits] && [string length $values]} {
1047      ::bayesGraph::GrapOptApplyAxisLimits $this x $t0 $t1
1048      incr t0
1049      incr t1
1050      set ok [expr $t1 <= $maxX]
1051    } else  {
1052      set ok 0
1053    }
1054    # comprobamos valores eje X
1055    if {[string length $limits2] && [string length $values2]} {
1056      ::bayesGraph::GrapOptApplyAxisLimits $this x2 $t20 $t21
1057      incr t20
1058      incr t21
1059      set ok2 [expr $t21 <= $maxX2]
1060    } else  {
1061      set ok2 0
1062    }
1063    update
1064  }
1065 
1066  EnableView $this $active
1067  StatePlay $this normal
1068  set zoomInfo($widgets(gr,$gr),stack) {}
1069}
1070
1071#/////////////////////////////////////////////////////////////////////////////
1072  proc ::bayesGraph::SeeEnd { this } {
1073#
1074# PURPOSE:
1075#
1076# PARAMETERS:
1077#   this -> bayesgraph instance
1078#
1079#/////////////////////////////////////////////////////////////////////////////
1080  upvar \#0 ${this}::widgets widgets
1081  upvar \#0 ${this}::data data
1082  global zoomInfo
1083  set gr $data(gr,active)
1084  set active $data(view,active)
1085  DisableView $this
1086  set limits  [$widgets(gr,$gr) axis limits x]
1087  set limits2 [$widgets(gr,$gr) axis limits x2]
1088
1089  set delta  [expr [lindex $limits  1] - [lindex $limits  0]]
1090  set delta2 [expr [lindex $limits2 1] - [lindex $limits2 0]]
1091
1092  set values  [::bayesGraph::GetLimitsValueAxis $this x]
1093  set values2 [::bayesGraph::GetLimitsValueAxis $this x2]
1094
1095  if {[string length $limits]  && [string length $values]} {
1096    ::bayesGraph::GrapOptApplyAxisLimits $this x \
1097      [expr [lindex $values  1] - $delta]  [lindex $values  1]
1098  }
1099  if {[string length $limits2] && [string length $values2]} {
1100    ::bayesGraph::GrapOptApplyAxisLimits $this x2 \
1101      [expr [lindex $values2 1] - $delta2] [lindex $values2 1]
1102  }
1103     
1104  EnableView $this $active
1105  set zoomInfo($widgets(gr,$gr),stack) {}
1106}
1107
1108
1109#/////////////////////////////////////////////////////////////////////////////
1110proc ::bayesGraph::NewLimits { this fr_first fr_last } {
1111#
1112#///////////////////////////////////////////////////////////////////////////// 
1113  upvar \#0 ${this}::widgets widgets
1114  upvar \#0 ${this}::data data
1115  set gr $data(gr,active)
1116  $widgets(sb,path) set $fr_first $fr_last
1117  ::bayesGraph::GrapOptApplyAxisLimits $this x $data(gr,$gr,xj) $data(gr,$gr,xk)
1118}
1119
1120
1121#/////////////////////////////////////////////////////////////////////////////
1122proc ::bayesGraph::OnChangeLimits { this } {
1123#
1124#///////////////////////////////////////////////////////////////////////////// 
1125  upvar \#0 ${this}::widgets widgets
1126  upvar \#0 ${this}::data data
1127  set gr $data(gr,active)
1128  set data(gr,$gr,xj) [$widgets(gr,$gr) axis cget x -min]
1129  set data(gr,$gr,xk) [$widgets(gr,$gr) axis cget x -max]
1130  set $data(gr,$gr,delta_t)] [expr $data(gr,$gr,xk) - $data(gr,$gr,xj)]
1131 
1132  set values [::bayesGraph::GetLimitsValueAxis $this x]
1133  set fr_j [expr 1.0 * $data(gr,$gr,xj) / [lindex $values 1]]
1134  set fr_k [expr 1.0 * $data(gr,$gr,xk) / [lindex $values 1]]
1135  if { $data(gr,$gr,xj) == 0 && $data(gr,$gr,xk) == [lindex $values 1] } {
1136    grid remove $widgets(sb,path)
1137  } else {
1138    grid $widgets(sb,path)
1139    $widgets(sb,path) set $fr_j $fr_k
1140  }
1141}
1142
1143
1144#/////////////////////////////////////////////////////////////////////////////
1145proc ::bayesGraph::TakePhoto {this {fileDest ""}} {
1146#
1147# PURPOSE: Takes a photo of the active graph and asks the user for a file to
1148#          save it.
1149#     
1150# PARAMETERS:
1151#   this -> bayesgraph instance
1152#   fileDest -> File destiny of photo, default ""
1153#
1154#/////////////////////////////////////////////////////////////////////////////
1155  upvar \#0 ${this}::widgets widgets
1156  upvar \#0 ${this}::data data
1157  upvar \#0 ${this}::options opt
1158  set gr $data(gr,active)
1159  set grpath $widgets(gr,$gr)
1160 
1161  # move focus a other widget
1162  set wdFoc [focus]
1163  focus $widgets(tb,btg,scale)
1164 
1165  if {$fileDest eq ""} {
1166    set typelist {{"Gif Files" {".gif"}}}
1167    set fileDest [tk_getSaveFile -title [mc "Choose a file to save the image"]\
1168                      -initialdir $opt(PhotoLastDir)\
1169                      -parent $widgets(this) \
1170                      -defaultextension .gif -filetypes $typelist]
1171    if {$fileDest eq ""} {
1172      tk_messageBox -type ok -message [mc "File hasn't been saved"]\
1173          -icon warning -parent $widgets(this) -title [mc Warning]
1174      return
1175    }
1176  }
1177  set img [image create photo]
1178  $grpath snap $img
1179  $img write -format gif $fileDest
1180  set opt(PhotoLastDir) [file dirname $fileDest]
1181  # restore focus
1182  if {[string length $wdFoc]} {
1183    focus $wdFoc
1184  } 
1185  destroy $img
1186}
1187
1188
1189#/////////////////////////////////////////////////////////////////////////////
1190  proc ::bayesGraph::Copy {this} {
1191#
1192# PURPOSE: Makes a copy of active graph image to clipboard. Only works for
1193#          windows platform.
1194#     
1195# PARAMETERS:
1196#   this -> bayesgraph instance
1197#
1198#/////////////////////////////////////////////////////////////////////////////
1199  upvar \#0 ${this}::widgets widgets
1200  upvar \#0 ${this}::data data
1201
1202  set gr $data(gr,active)
1203  set grpath $widgets(gr,$gr)
1204
1205  focus $widgets(this)
1206  update
1207  if { [string equal $::tcl_platform(platform) "windows"] } {
1208    $grpath snap -format emf CLIPBOARD
1209  } else {
1210    # codigo para otra plataforma
1211  }
1212  focus $grpath
1213}
1214
1215
1216#/////////////////////////////////////////////////////////////////////////////
1217  proc ::bayesGraph::ToEvalWindow {this} {
1218#
1219# PURPOSE: Inserts in eval window the names of the items drawn in the graphs.
1220#          It is really implemented in bayesGraph childs.
1221#     
1222# PARAMETERS:
1223#   this -> bayesgraph instance
1224#
1225#/////////////////////////////////////////////////////////////////////////////
1226  upvar \#0 ${this}::data data
1227 
1228  set txt ""
1229  if [info exists ${this}::data(proc,OnEvalWindow)] {
1230    set txt [$data(proc,OnEvalWindow) $this]
1231  }
1232  ::TolConsole::ToEvalWindow $txt
1233}
1234
1235
1236#/////////////////////////////////////////////////////////////////////////////
1237  proc ::bayesGraph::ToTable {this} {
1238#
1239# PURPOSE: Makes a table with data of the items grawn in the graphs. It is
1240#          really implemented in bayesGraph childs.
1241#     
1242# PARAMETERS:
1243#   this -> bayesgraph instance
1244#
1245#/////////////////////////////////////////////////////////////////////////////
1246  upvar \#0 ${this}::data data
1247 
1248  if [info exists ${this}::data(proc,OnToTable)] {
1249    $data(proc,OnToTable) $this
1250  }
1251}
1252
1253
1254#/////////////////////////////////////////////////////////////////////////////
1255  proc ::bayesGraph::ChangeType {this} {
1256#
1257# PURPOSE:
1258#
1259# PARAMETERS:
1260#   this -> bayesgraph instance
1261#
1262#/////////////////////////////////////////////////////////////////////////////
1263  upvar \#0 ${this}::data data
1264
1265  set gr $data(gr,active)
1266  foreach git $data(gr,$gr,elements) {
1267    ElemOptChangeType $this [lindex $git 0] $git
1268  }
1269}
1270
1271
1272
1273#/////////////////////////////////////////////////////////////////////////////
1274proc ::bayesGraph::GetDataGraph { this gr key } {
1275#
1276#///////////////////////////////////////////////////////////////////////////// 
1277  upvar \#0 ::${this}::data data
1278  return $data(gr,$gr,$key)
1279}
1280
1281
1282#/////////////////////////////////////////////////////////////////////////////
1283proc ::bayesGraph::SetDataGraph { this gr key value } {
1284#
1285#///////////////////////////////////////////////////////////////////////////// 
1286  upvar \#0 ::${this}::data data
1287  set gr $data(gr,active)
1288  set data(gr,$gr,$key) $value
1289}
1290
1291
1292#/////////////////////////////////////////////////////////////////////////////
1293proc ::bayesGraph::changeCursor { this gr cursor} {
1294#
1295#///////////////////////////////////////////////////////////////////////////// 
1296  upvar \#0 ${this}::data data
1297  if { [string equal $cursor last] } {
1298    $gr configure -cursor $data(cursor,last)
1299  } else  {
1300    set data(cursor,last) [$gr cget -cursor]
1301    $gr configure -cursor $cursor
1302  }
1303}
1304
1305
1306#/////////////////////////////////////////////////////////////////////////////
1307proc ::bayesGraph::getActiveGraph {this} {
1308#
1309#///////////////////////////////////////////////////////////////////////////// 
1310  upvar \#0 ${this}::widgets widgets
1311  upvar \#0 ${this}::data data
1312
1313  set gr $data(gr,active)
1314  set g $widgets(gr,$gr)
1315  return $g
1316}
1317
1318
Note: See TracBrowser for help on using the repository browser.