source: tol/tolbase/lib/toltk/bysgraph.tcl @ 820bb4e

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

Refs #1933
Se redibuja el gráfico tras actualizar los ejes ($graph configure axis ...) ya que según parece con rbc esto no se hace automáticamente.
Se añade el método ClearCrosshairs.
Se soluciona un bug decompilando archivos desde la ventana derecha del inspector.
Se corrige la actualización del inspector según el item seleccionado en el árbol.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7359 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 42.9 KB
Line 
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 RBC 
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 rbc 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) [rbc::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    set tmpOpt(var,yAxisMin) [lindex $values_y 0]
656    set tmpOpt(var,yAxisMax) [lindex $values_y 1]
657    ::bayesGraph::GrapOptApplyAxisLimits $this y \
658      [expr $tmpOpt(var,yAxisMin) - abs($tmpOpt(var,yAxisMin) / 100)] \
659      [expr $tmpOpt(var,yAxisMax) + abs($tmpOpt(var,yAxisMax) / 100)]
660  }
661  if {([info exists values_y2]) && ([llength $values_y2])} {
662    set tmpOpt(var,y2AxisMin) [lindex $values_y2 0]
663    set tmpOpt(var,y2AxisMax) [lindex $values_y2 1]
664    ::bayesGraph::GrapOptApplyAxisLimits $this y2 \
665      [expr $tmpOpt(var,y2AxisMin) - abs($tmpOpt(var,y2AxisMin) / 100)] \
666      [expr $tmpOpt(var,y2AxisMax) + abs($tmpOpt(var,y2AxisMax) / 100)]
667  }
668  if {([info exists values_x]) && ([llength $values_x])} {
669    set tmpOpt(var,xAxisMin) [lindex $values_x 0]
670    set tmpOpt(var,xAxisMax) [lindex $values_x 1]
671    ::bayesGraph::GrapOptApplyAxisLimits $this x \
672      $tmpOpt(var,xAxisMin) $tmpOpt(var,xAxisMax)
673  }
674  if {([info exists values_x2]) && ([llength $values_x2])} {
675    set tmpOpt(var,x2AxisMin) [lindex $values_x2 0]
676    set tmpOpt(var,x2AxisMax) [lindex $values_x2 1]
677    ::bayesGraph::GrapOptApplyAxisLimits $this x2 \
678      $tmpOpt(var,x2AxisMin) $tmpOpt(var,x2AxisMax)
679  }
680  #Aplicamos valores a los ejes
681  GrapOptApplyAxisTicks $this ${this}::options gr,$gr
682}
683
684#/////////////////////////////////////////////////////////////////////////////
685  proc ::bayesGraph::ZoomFrame { this } {
686#
687# PURPOSE: Sets zoom-frame mode for the rbc graph
688#     
689# PARAMETERS:
690#   this -> bayesgraph instance
691#
692#/////////////////////////////////////////////////////////////////////////////
693  SetViewMode $this zoom-frame
694}
695
696
697#/////////////////////////////////////////////////////////////////////////////
698  proc ::bayesGraph::ZoomIn { this } {
699#
700# PURPOSE: Sets zoom-in mode for the rbc graph
701#     
702# PARAMETERS:
703#   this -> bayesgraph instance
704#
705#/////////////////////////////////////////////////////////////////////////////
706
707  SetViewMode $this zoom-in
708}
709
710
711#/////////////////////////////////////////////////////////////////////////////
712  proc ::bayesGraph::ZoomOut { this } {
713#
714# PURPOSE: Sets zoom-out mode for the rbc graph
715#     
716# PARAMETERS:
717#   this -> bayesgraph instance
718#
719#/////////////////////////////////////////////////////////////////////////////
720
721  SetViewMode $this zoom-out
722}
723
724
725#/////////////////////////////////////////////////////////////////////////////
726  proc ::bayesGraph::ScrollView { this } {
727#
728# PURPOSE: Sets scroll mode for the rbc graph
729#     
730# PARAMETERS:
731#   this -> bayesgraph instance
732#
733#/////////////////////////////////////////////////////////////////////////////
734
735  SetViewMode $this scroll
736}
737
738
739#/////////////////////////////////////////////////////////////////////////////
740  proc ::bayesGraph::SetViewMode { this mode } {
741#
742# PURPOSE: Sets zoom (or scroll) mode for the rbc graph. It also enables and
743#          disables toolbar buttons and sets cursors types acording to the
744#          mode choosen.
745#     
746# PARAMETERS:
747#   this -> bayesgraph instance
748#   mode -> mode for the rbc graph
749#
750#/////////////////////////////////////////////////////////////////////////////
751
752  upvar \#0 ${this}::data data
753  upvar \#0 ${this}::widgets widgets
754  set active $data(zoom,active)
755  if { $active != "" } {
756    $widgets(tb,btg,$active) configure -relief link
757  }
758  if { [string compare $active $mode] } {
759    set active [set data(zoom,active) $mode]
760    $widgets(tb,btg,$mode) configure -relief sunken   
761  } else {
762    set active [set data(zoom,active) ""]     
763  }
764  for  {set gr 0} {$gr<$data(gr,numGraph)} {incr gr 1} {
765    set item $widgets(gr,$gr)
766    $item configure -cursor $widgets(cursor,$active)
767    Rbc_ViewMode $item $active
768  }
769
770}
771
772
773#/////////////////////////////////////////////////////////////////////////////
774  proc ::bayesGraph::ToggleButton { this button } {
775#
776# PURPOSE: Changes state of a button between on (relief sunken) and off
777#          (relief link)
778#     
779# PARAMETERS:
780#   this   -> bayesgraph instance
781#   button -> button to toggle
782#
783#/////////////////////////////////////////////////////////////////////////////
784
785  upvar \#0 ${this}::widgets widgets
786  upvar \#0 ${this}::data data
787  if { [string equal [$widgets(tb,btg,$button) cget -relief] "link"] } {
788    set relief "sunken"
789    set state 1
790  } else {
791    set relief "link"
792    set state 0
793  }
794  $widgets(tb,btg,$button) configure -relief $relief
795  return $state
796}
797
798
799#/////////////////////////////////////////////////////////////////////////////
800  proc ::bayesGraph::ToggleGrid { this } {
801#
802# PURPOSE: Changes grid option between enabled and disabled for all graphs in
803#          the instance.
804#     
805# PARAMETERS:
806#   this -> bayesgraph instance
807#
808#/////////////////////////////////////////////////////////////////////////////
809
810  upvar \#0 ${this}::widgets widgets
811  upvar \#0 ${this}::data data
812  upvar \#0 ${this}::options opt
813
814  set opt(grid) [ToggleButton $this "grid"]
815  for  {set i 0} {$i<$data(gr,numGraph)} {incr i 1} {
816    set item $widgets(gr,$i)
817    $item grid toggle
818  }
819}
820
821
822#/////////////////////////////////////////////////////////////////////////////
823  proc ::bayesGraph::ToggleCrosshair { this } {
824#
825# PURPOSE: Changes crosshair option between enabled and disabled for all
826#          graphs in the instance.
827#     
828# PARAMETERS:
829#   this -> bayesgraph instance
830#
831#/////////////////////////////////////////////////////////////////////////////
832
833  upvar \#0 ${this}::widgets widgets
834  upvar \#0 ${this}::data data
835  if { [ToggleButton $this "crosshair"] } {
836    for  {set i 0} {$i<$data(gr,numGraph)} {incr i 1} {
837      set item $widgets(gr,$i)
838      rbc::Crosshairs $item
839    }   
840  } else {
841    for  {set i 0} {$i<$data(gr,numGraph)} {incr i 1} {
842      set item $widgets(gr,$i)
843      rbc::ClearCrosshairs $item
844    }
845  }
846}
847
848
849#/////////////////////////////////////////////////////////////////////////////
850  proc ::bayesGraph::DisableView { this } {
851#
852# PURPOSE:
853#     
854# PARAMETERS:
855#   this -> bayesgraph instance
856#
857#/////////////////////////////////////////////////////////////////////////////
858
859  upvar \#0 ${this}::widgets widgets
860  upvar \#0 ${this}::data data
861  set active $data(view,active)
862  if { [string length $active] } {
863    # this disable (toggle) the current view mode
864    SetViewMode $this $active
865  }
866  foreach but $data(tb,zoomPack) {
867    $widgets(tb,btg,$but) configure -state disable
868  }
869}
870
871
872#/////////////////////////////////////////////////////////////////////////////
873  proc ::bayesGraph::EnableView { this mode } {
874#
875# PURPOSE:
876#     
877# PARAMETERS:
878#   this -> bayesgraph instance
879#   mode ->
880#
881#/////////////////////////////////////////////////////////////////////////////
882
883  upvar \#0 ${this}::widgets widgets
884  upvar \#0 ${this}::data data
885  if { [string length $mode] } {
886    SetViewMode $this $mode
887  }
888  foreach but $data(tb,zoomPack) {
889    $widgets(tb,btg,$but) configure -state normal
890  }
891}
892
893
894#/////////////////////////////////////////////////////////////////////////////
895  proc ::bayesGraph::StatePlay { this state} {
896#
897# PURPOSE:
898#     
899# PARAMETERS:
900#   this -> bayesgraph instance
901#
902#/////////////////////////////////////////////////////////////////////////////
903
904  upvar \#0 ${this}::widgets widgets
905  upvar \#0 ${this}::data data
906  foreach but [list gobegin playback playfor goend] {
907    $widgets(tb,btg,$but) configure -state $state
908  }
909}
910 
911
912#/////////////////////////////////////////////////////////////////////////////
913  proc ::bayesGraph::SeeBegin { this } {
914#
915# PURPOSE:
916#     
917# PARAMETERS:
918#   this -> bayesgraph instance
919#
920#/////////////////////////////////////////////////////////////////////////////
921  upvar \#0 ${this}::widgets widgets
922  upvar \#0 ${this}::data data
923  global zoomInfo
924  set gr $data(gr,active)
925  set active $data(view,active)
926  DisableView $this
927  set limits  [$widgets(gr,$gr) axis limits x]
928  set limits2 [$widgets(gr,$gr) axis limits x2]
929 
930  set delta  [expr [lindex $limits  1] - [lindex $limits  0]]
931  set delta2 [expr [lindex $limits2 1] - [lindex $limits2 0]]
932  if {[string length $limits] } {
933    ::bayesGraph::GrapOptApplyAxisLimits $this x  0 $delta
934  }
935  if {[string length $limits2]} {
936    ::bayesGraph::GrapOptApplyAxisLimits $this x2 0 $delta2
937  }
938  EnableView $this $active
939  set zoomInfo($widgets(gr,$gr),stack) {}
940}
941
942#/////////////////////////////////////////////////////////////////////////////
943  proc ::bayesGraph::PlayBackward { this } {
944#
945# PURPOSE:
946#
947# PARAMETERS:
948#   this -> bayesgraph instance
949#
950#/////////////////////////////////////////////////////////////////////////////
951  upvar \#0 ${this}::widgets widgets
952  upvar \#0 ${this}::data data
953  global zoomInfo
954  set gr $data(gr,active)
955  set active $data(view,active)
956  DisableView $this
957  StatePlay $this disable
958  set data(stopflag) 0
959  set limits  [$widgets(gr,$gr) axis limits x]
960  set limits2 [$widgets(gr,$gr) axis limits x2]
961  set t0  [expr round([lindex $limits  0])]
962  set t1  [expr round([lindex $limits  1])]
963  set t20 [expr round([lindex $limits2 0])]
964  set t21 [expr round([lindex $limits2 1])]
965 
966  set values  [::bayesGraph::GetLimitsValueAxis $this x]
967  set values2 [::bayesGraph::GetLimitsValueAxis $this x2]
968  set minX  [lindex $values  0]
969  set minX2 [lindex $values2 0]
970  set ok  1
971  set ok2 1
972  while { !$data(stopflag) && ($ok || $ok2)} {
973    # comprobamos que hay valores para el eje X
974    if {[string length $limits] && [string length $values]} {
975      ::bayesGraph::GrapOptApplyAxisLimits $this x  $t0 $t1
976      incr t0 -1
977      incr t1 -1
978      set ok [expr $t0 >= $minX]
979    } else  {
980      set ok 0
981    }
982    # comprobamos que hay valores para el eje X2
983    if {[string length $limits2] && [string length $values2]} {
984      ::bayesGraph::GrapOptApplyAxisLimits $this x2 $t20 $t21
985      incr t20 -1
986      incr t21 -1
987      set ok2 [expr $t20 >= $minX2]
988    } else  {
989      set ok2 0
990    }
991    update
992  }
993  EnableView $this $active
994  StatePlay $this normal
995  set zoomInfo($widgets(gr,$gr),stack) {}
996}
997
998#/////////////////////////////////////////////////////////////////////////////
999  proc ::bayesGraph::StopPlaying { this } {
1000#
1001# PURPOSE:
1002#     
1003# PARAMETERS:
1004#   this -> bayesgraph instance
1005#
1006#/////////////////////////////////////////////////////////////////////////////
1007
1008  upvar \#0 ${this}::data data
1009  set data(stopflag) 1
1010}
1011
1012#/////////////////////////////////////////////////////////////////////////////
1013  proc ::bayesGraph::PlayForward { this } {
1014#
1015# PURPOSE:
1016#
1017# PARAMETERS:
1018#   this -> bayesgraph instance
1019#
1020#/////////////////////////////////////////////////////////////////////////////
1021  upvar \#0 ${this}::widgets widgets
1022  upvar \#0 ${this}::data data
1023  global zoomInfo
1024  set gr $data(gr,active)
1025  set active $data(view,active)
1026  DisableView $this
1027  StatePlay $this disable
1028  set data(stopflag) 0
1029  set limits  [$widgets(gr,$gr) axis limits x]
1030  set limits2 [$widgets(gr,$gr) axis limits x2]
1031  set t0  [expr round([lindex $limits  0])]
1032  set t1  [expr round([lindex $limits  1])]
1033  set t20 [expr round([lindex $limits2 0])]
1034  set t21 [expr round([lindex $limits2 1])]
1035 
1036  set values  [::bayesGraph::GetLimitsValueAxis $this x]
1037  set values2 [::bayesGraph::GetLimitsValueAxis $this x2]
1038  set maxX  [lindex $values 1]
1039  set maxX2 [lindex $values2 1]
1040  set ok  1
1041  set ok2 1
1042 
1043  while { !$data(stopflag) && ($ok || $ok2)} {
1044    # comprobamos valores eje X
1045    if {[string length $limits] && [string length $values]} {
1046      ::bayesGraph::GrapOptApplyAxisLimits $this x $t0 $t1
1047      incr t0
1048      incr t1
1049      set ok [expr $t1 <= $maxX]
1050    } else  {
1051      set ok 0
1052    }
1053    # comprobamos valores eje X
1054    if {[string length $limits2] && [string length $values2]} {
1055      ::bayesGraph::GrapOptApplyAxisLimits $this x2 $t20 $t21
1056      incr t20
1057      incr t21
1058      set ok2 [expr $t21 <= $maxX2]
1059    } else  {
1060      set ok2 0
1061    }
1062    update
1063  }
1064 
1065  EnableView $this $active
1066  StatePlay $this normal
1067  set zoomInfo($widgets(gr,$gr),stack) {}
1068}
1069
1070#/////////////////////////////////////////////////////////////////////////////
1071  proc ::bayesGraph::SeeEnd { this } {
1072#
1073# PURPOSE:
1074#
1075# PARAMETERS:
1076#   this -> bayesgraph instance
1077#
1078#/////////////////////////////////////////////////////////////////////////////
1079  upvar \#0 ${this}::widgets widgets
1080  upvar \#0 ${this}::data data
1081  global zoomInfo
1082  set gr $data(gr,active)
1083  set active $data(view,active)
1084  DisableView $this
1085  set limits  [$widgets(gr,$gr) axis limits x]
1086  set limits2 [$widgets(gr,$gr) axis limits x2]
1087
1088  set delta  [expr [lindex $limits  1] - [lindex $limits  0]]
1089  set delta2 [expr [lindex $limits2 1] - [lindex $limits2 0]]
1090
1091  set values  [::bayesGraph::GetLimitsValueAxis $this x]
1092  set values2 [::bayesGraph::GetLimitsValueAxis $this x2]
1093
1094  if {[string length $limits]  && [string length $values]} {
1095    ::bayesGraph::GrapOptApplyAxisLimits $this x \
1096      [expr [lindex $values  1] - $delta]  [lindex $values  1]
1097  }
1098  if {[string length $limits2] && [string length $values2]} {
1099    ::bayesGraph::GrapOptApplyAxisLimits $this x2 \
1100      [expr [lindex $values2 1] - $delta2] [lindex $values2 1]
1101  }
1102     
1103  EnableView $this $active
1104  set zoomInfo($widgets(gr,$gr),stack) {}
1105}
1106
1107
1108#/////////////////////////////////////////////////////////////////////////////
1109proc ::bayesGraph::NewLimits { this fr_first fr_last } {
1110#
1111#///////////////////////////////////////////////////////////////////////////// 
1112  upvar \#0 ${this}::widgets widgets
1113  upvar \#0 ${this}::data data
1114  set gr $data(gr,active)
1115  $widgets(sb,path) set $fr_first $fr_last
1116  ::bayesGraph::GrapOptApplyAxisLimits $this x $data(gr,$gr,xj) $data(gr,$gr,xk)
1117}
1118
1119
1120#/////////////////////////////////////////////////////////////////////////////
1121proc ::bayesGraph::OnChangeLimits { this } {
1122#
1123#///////////////////////////////////////////////////////////////////////////// 
1124  upvar \#0 ${this}::widgets widgets
1125  upvar \#0 ${this}::data data
1126  set gr $data(gr,active)
1127  set data(gr,$gr,xj) [$widgets(gr,$gr) axis cget x -min]
1128  set data(gr,$gr,xk) [$widgets(gr,$gr) axis cget x -max]
1129  set $data(gr,$gr,delta_t)] [expr $data(gr,$gr,xk) - $data(gr,$gr,xj)]
1130 
1131  set values [::bayesGraph::GetLimitsValueAxis $this x]
1132  set fr_j [expr 1.0 * $data(gr,$gr,xj) / [lindex $values 1]]
1133  set fr_k [expr 1.0 * $data(gr,$gr,xk) / [lindex $values 1]]
1134  if { $data(gr,$gr,xj) == 0 && $data(gr,$gr,xk) == [lindex $values 1] } {
1135    grid remove $widgets(sb,path)
1136  } else {
1137    grid $widgets(sb,path)
1138    $widgets(sb,path) set $fr_j $fr_k
1139  }
1140}
1141
1142
1143#/////////////////////////////////////////////////////////////////////////////
1144proc ::bayesGraph::TakePhoto {this {fileDest ""}} {
1145#
1146# PURPOSE: Takes a photo of the active graph and asks the user for a file to
1147#          save it.
1148#     
1149# PARAMETERS:
1150#   this -> bayesgraph instance
1151#   fileDest -> File destiny of photo, default ""
1152#
1153#/////////////////////////////////////////////////////////////////////////////
1154  upvar \#0 ${this}::widgets widgets
1155  upvar \#0 ${this}::data data
1156  upvar \#0 ${this}::options opt
1157  set gr $data(gr,active)
1158  set grpath $widgets(gr,$gr)
1159 
1160  # move focus a other widget
1161  set wdFoc [focus]
1162  focus $widgets(tb,btg,scale)
1163 
1164  if {$fileDest eq ""} {
1165    set typelist {{"Gif Files" {".gif"}}}
1166    set fileDest [tk_getSaveFile -title [mc "Choose a file to save the image"]\
1167                      -initialdir $opt(PhotoLastDir)\
1168                      -parent $widgets(this) \
1169                      -defaultextension .gif -filetypes $typelist]
1170    if {$fileDest eq ""} {
1171      tk_messageBox -type ok -message [mc "File hasn't been saved"]\
1172          -icon warning -parent $widgets(this) -title [mc Warning]
1173      return
1174    }
1175  }
1176  set img [image create photo]
1177  $grpath snap $img
1178  $img write -format gif $fileDest
1179  set opt(PhotoLastDir) [file dirname $fileDest]
1180  # restore focus
1181  if {[string length $wdFoc]} {
1182    focus $wdFoc
1183  } 
1184  destroy $img
1185}
1186
1187
1188#/////////////////////////////////////////////////////////////////////////////
1189  proc ::bayesGraph::Copy {this} {
1190#
1191# PURPOSE: Makes a copy of active graph image to clipboard. Only works for
1192#          windows platform.
1193#     
1194# PARAMETERS:
1195#   this -> bayesgraph instance
1196#
1197#/////////////////////////////////////////////////////////////////////////////
1198  upvar \#0 ${this}::widgets widgets
1199  upvar \#0 ${this}::data data
1200
1201  set gr $data(gr,active)
1202  set grpath $widgets(gr,$gr)
1203
1204  focus $widgets(this)
1205  update
1206  if { [string equal $::tcl_platform(platform) "windows"] } {
1207    $grpath snap -format emf CLIPBOARD
1208  } else {
1209    # codigo para otra plataforma
1210  }
1211  focus $grpath
1212}
1213
1214
1215#/////////////////////////////////////////////////////////////////////////////
1216  proc ::bayesGraph::ToEvalWindow {this} {
1217#
1218# PURPOSE: Inserts in eval window the names of the items drawn in the graphs.
1219#          It is really implemented in bayesGraph childs.
1220#     
1221# PARAMETERS:
1222#   this -> bayesgraph instance
1223#
1224#/////////////////////////////////////////////////////////////////////////////
1225  upvar \#0 ${this}::data data
1226 
1227  set txt ""
1228  if [info exists ${this}::data(proc,OnEvalWindow)] {
1229    set txt [$data(proc,OnEvalWindow) $this]
1230  }
1231  ::TolConsole::ToEvalWindow $txt
1232}
1233
1234
1235#/////////////////////////////////////////////////////////////////////////////
1236  proc ::bayesGraph::ToTable {this} {
1237#
1238# PURPOSE: Makes a table with data of the items grawn in the graphs. It is
1239#          really implemented in bayesGraph childs.
1240#     
1241# PARAMETERS:
1242#   this -> bayesgraph instance
1243#
1244#/////////////////////////////////////////////////////////////////////////////
1245  upvar \#0 ${this}::data data
1246 
1247  if [info exists ${this}::data(proc,OnToTable)] {
1248    $data(proc,OnToTable) $this
1249  }
1250}
1251
1252
1253#/////////////////////////////////////////////////////////////////////////////
1254  proc ::bayesGraph::ChangeType {this} {
1255#
1256# PURPOSE:
1257#
1258# PARAMETERS:
1259#   this -> bayesgraph instance
1260#
1261#/////////////////////////////////////////////////////////////////////////////
1262  upvar \#0 ${this}::data data
1263
1264  set gr $data(gr,active)
1265  foreach git $data(gr,$gr,elements) {
1266    ElemOptChangeType $this [lindex $git 0] $git
1267  }
1268}
1269
1270
1271
1272#/////////////////////////////////////////////////////////////////////////////
1273proc ::bayesGraph::GetDataGraph { this gr key } {
1274#
1275#///////////////////////////////////////////////////////////////////////////// 
1276  upvar \#0 ::${this}::data data
1277  return $data(gr,$gr,$key)
1278}
1279
1280
1281#/////////////////////////////////////////////////////////////////////////////
1282proc ::bayesGraph::SetDataGraph { this gr key value } {
1283#
1284#///////////////////////////////////////////////////////////////////////////// 
1285  upvar \#0 ::${this}::data data
1286  set gr $data(gr,active)
1287  set data(gr,$gr,$key) $value
1288}
1289
1290
1291#/////////////////////////////////////////////////////////////////////////////
1292proc ::bayesGraph::changeCursor { this gr cursor} {
1293#
1294#///////////////////////////////////////////////////////////////////////////// 
1295  upvar \#0 ${this}::data data
1296  if { [string equal $cursor last] } {
1297    $gr configure -cursor $data(cursor,last)
1298  } else  {
1299    set data(cursor,last) [$gr cget -cursor]
1300    $gr configure -cursor $cursor
1301  }
1302}
1303
1304
1305#/////////////////////////////////////////////////////////////////////////////
1306proc ::bayesGraph::getActiveGraph {this} {
1307#
1308#///////////////////////////////////////////////////////////////////////////// 
1309  upvar \#0 ${this}::widgets widgets
1310  upvar \#0 ${this}::data data
1311
1312  set gr $data(gr,active)
1313  set g $widgets(gr,$gr)
1314  return $g
1315}
1316
1317
Note: See TracBrowser for help on using the repository browser.