source: tol/tolbase/lib/toltk/bysgraph.tcl @ 16f893d

1941-docker-image-to-testdevel
Last change on this file since 16f893d was 6d7779d, checked in by Jorge Pérez <josp.jorge@…>, 18 years ago

initial import

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