source: tol/tolbase/lib/toltk/tolinspe__draw.tcl

devel
Last change on this file was 7a3f24e, checked in by Pedro Gea <pgea@…>, 10 years ago

Refs #1933
Se separa el archivo tolinspe.tcl en 5 partes:

+ main: parte principal y algunas funciones generales)
+ wtree1: funciones dependientes de los widgets de árbol (parte 1)
+ wtree2: funciones dependientes de los widgets de árbol (parte 2)
+ draw: funciones para representar objetos TOL (tabular, graficar, etc.)
+ tolgui: otras funciones fuera del namespace ::TolInpector

Se actualizan las nuevas ubicaciones en tclIndex.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7332 be4846ae-f051-483a-831f-b64e7d08527f

  • Property mode set to 100644
File size: 14.7 KB
Line 
1
2#/////////////////////////////////////////////////////////////////////////////
3proc ::TolInspector::DrawSet {setref {type 0}} {
4#
5# PURPOSE: Graph a Set. For it it calls to a form for the selection of
6#          columns to graph
7#
8# PARAMETERS:
9#   setref -> Set to graph
10#   type   -> 0 for custom association of data columns
11#          -> 1 for all data columns to first one
12#          -> 2 for all data columns to generic
13#          -> 3 for even data columns to odd ones
14#
15#/////////////////////////////////////////////////////////////////////////////
16  variable group_id
17  variable w_tabset
18  #puts "::TolInspector::DrawSet. setref: $setref"
19  incr group_id
20  if {[llength $setref] > 1} {
21    set name [lindex [::tol::info variable $setref] 1]
22  } else {
23    set name $setref
24  }
25  set cmd tablecmd$group_id
26  if {![catch {::tol::tableset create $cmd $setref}]} {
27    switch $type {
28      0 {
29        set tl [::project::CreateForm \
30          -width 500 -height 500 -type Graphs \
31          -iniconfig Graph \
32          -title [mc "Set graph: %s" $name] -helpkey "Tb4GraSet"]
33        $tl withdraw
34        set tlf [$tl getframe]
35        if {[set Instance [::SetGraphDialog::Init $tlf.g $cmd $setref]] != 0} {
36          bind $tlf.g <Destroy> +[list ::tol::tableset destroy $cmd]
37          pack $tlf.g -fill both -expand yes
38          $tl restore
39          update
40          # Esta opción se debe aplicar cuando el gráfico esté empacado
41          ::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0
42        } else {
43          destroy $tl
44          return
45        }
46        $tl bind <Control-F4> [list $tl kill]             
47      }
48      1 -
49      2 -
50      3 {
51        # windows
52        set tl [::project::CreateForm \
53          -title [mc "Set graph: %s" $name] -type Graphs -iniconfig SetGraph]
54        $tl withdraw       
55        set tlf [$tl getframe]
56        set Instance [::SetGraphDialog::DrawSet $tlf.g $cmd $setref $type]
57        bind $tlf.g <Destroy> +[list ::tol::tableset destroy $cmd]
58        pack $tlf.g -fill both -expand yes
59        $tl restore
60        update
61        # Esta opción se debe aplicar cuando el gráfico esté empacado       
62        ::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0
63      }
64    }
65  } else {
66    tk_messageBox -type ok -icon warning \
67        -message [mc "Set is not graficable: %s" $::errorInfo] \
68        -parent $w_tabset -title [mc "Warning"]
69  }
70}
71
72#/////////////////////////////////////////////////////////////////////////////
73proc ::TolInspector::DrawMatrix {matref} {
74#
75# PURPOSE: draw the given matrix
76#
77# PARAMETERS:
78#   matref -> reference to the tol matrix
79#
80#/////////////////////////////////////////////////////////////////////////////
81  variable group_id
82  variable w_tabset
83
84  incr group_id
85  if {[llength $matref] > 1} {
86    set name [lindex [::tol::info variable $matref] 1]
87  } else {
88    if { ([info exists obj]) } {
89      set name $obj
90    }
91  }
92  if { ([info exists name]) } {
93    set cmd tablecmd$group_id
94    if {![catch {::tol::tablematrix create $cmd $matref}]} {
95      set tl [::project::CreateForm \
96                  -width 500 -height 500 -type Graphs \
97                  -iniconfig Graph \
98                  -title [mc "Matrix graph: %s" $name] -helpkey "Tb4Gra"]
99      $tl withdraw
100   
101      set tlf [$tl getframe]
102      if {[set Instance [::SetGraphDialog::Init $tlf.g $cmd $matref]] != 0} {
103        bind $tlf.g <Destroy> +[list ::tol::tablematrix destroy $cmd]
104        pack $tlf.g -fill both -expand yes
105            $tl restore
106        update
107        # Esta opción se debe aplicar cuando el gráfico esté empacado
108        ::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0
109      } else {
110        destroy $tl
111        return
112      }
113      $tl bind <Control-F4> [list $tl kill]
114    } else {
115      tk_messageBox -type ok -icon warning \
116        -message [mc "Matrix is not graficable: %s" $::errorInfo] \
117        -parent $w_tabset -title [mc "Warning"]
118    }
119  }
120}
121
122#/////////////////////////////////////////////////////////////////////////////
123proc ::TolInspector::TableSet { set } {
124#///////////////////////////////////////////////////////////////////////////// 
125  variable w_tabset
126  variable group_id
127
128  incr group_id
129  if {[llength $set] > 1} {
130    set nameSet [lindex [::tol::info variable $set] 1]
131  } else {
132    set nameSet $set
133  }
134  set setgrp group$group_id
135  if {![catch {::tol::tableset create $setgrp $set}]} {
136    # create
137    set tl [::project::CreateForm \
138        -title    "[mc "Set table"]: $nameSet" \
139        -iniconfig SetTable \
140        -type Tables -helpkey "Tb4Edt"
141    ]
142    set tlf [$tl getframe]
143    # config
144    btable $tlf.t -parent $tl \
145                  -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
146                  -iniconfig btable
147    $tlf.t fillSet $setgrp
148    pack $tlf.t -fill both -expand yes
149    bind $tlf.t <Destroy> +[list ::tol::tableset destroy $setgrp]
150    $tl bind <Control-F4> [list $tl kill]
151    update
152  } else {
153    tk_messageBox -type ok -icon warning -message [mc "Set not tabulable"]\
154        -parent $w_tabset -title [mc Warning]
155  }
156}
157
158#/////////////////////////////////////////////////////////////////////////////
159proc ::TolInspector::TableMatrix { matrix } {
160#/////////////////////////////////////////////////////////////////////////////
161  set mattb [::tol::matrix $matrix]
162  # create
163  set tl [::project::CreateForm \
164              -title "[mc {Matrix table}]: [lindex $mattb 0]" \
165              -iniconfig MatrixTable \
166              -type Tables -helpkey "Tb4Edt"
167  ]
168  set tlf [$tl getframe]
169  # create matrix
170  btable $tlf.t -parent $tl \
171                -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
172                -iniconfig btable
173  $tlf.t fillMatrix $mattb
174  $tl bind <Control-F4> [list $tl kill] 
175  pack $tlf.t -fill both -expand yes
176
177  #if {$grammar == "VMatrix"} {
178    #::tol::console stack release "zxw._.wxz"
179  #}
180}
181
182#/////////////////////////////////////////////////////////////////////////////
183proc ::TolInspector::ExportBDTMatrix { matrix } {
184#/////////////////////////////////////////////////////////////////////////////
185  variable group_id
186 
187  incr group_id
188  set tl [toplevel .top$group_id]
189  wm title $tl "ExportBDTMatrix"
190 
191  #pack $tl.t -fill both -expand yes
192}
193
194#/////////////////////////////////////////////////////////////////////////////
195proc ::TolInspector::DrawSerie { } {
196#///////////////////////////////////////////////////////////////////////////// 
197  variable options_selected
198  upvar \#0 ::TolInspector::options_selected(Serie) series_selected
199 
200  #puts "DrawSerie: series_selected=$series_selected"
201  set series ""
202  foreach it $series_selected {
203    lappend series [lindex $it 0]
204  }
205  DrawSeries $series
206}
207
208#/////////////////////////////////////////////////////////////////////////////
209proc ::TolInspector::DrawSeries { series {gcf ""}} {
210#///////////////////////////////////////////////////////////////////////////// 
211  variable group_id
212
213  if { [llength $series] } {
214    incr group_id
215    # series     
216    set sergrp group$group_id
217    set t0 [time {
218    eval "::tol::seriegrp create $sergrp $series"
219    }]
220    # name
221    set name [$sergrp serie 0 name]
222    if { [$sergrp serie size] > 1} {
223      set name ${name}...
224    }
225    # create
226    set t1 [time {
227    set tl [::project::CreateForm \
228        -title [mc "Series graph: %s" $name] \
229        -type Graphs \
230        -iniconfig SeriesGraph \
231        -width 900 -height 650 -helpkey "Tb4GraSer"
232           ]}]
233    set tlf [$tl getframe]
234    # configuration
235    set t2 [time {
236    set Instance [::SeriesGraph::Create $tlf.g $sergrp]
237    }]
238    #puts "t0 = $t0"
239    #puts "t1 = $t1"
240    #puts "t2 = $t2"
241    if { $gcf != "" } {
242      ::bayesGraph::LoadGCF $Instance $gcf
243    }
244    bind $tlf.g <Destroy> +[list ::tol::seriegrp destroy $sergrp]
245    pack $tlf.g -fill both -expand yes
246    $tl bind <Control-F4> [list $tl kill]
247    update
248    # Esta opción se debe aplicar cuando el gráfico esté empacado
249    #::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0
250  }
251}
252
253#/////////////////////////////////////////////////////////////////////////////
254proc ::TolInspector::DrawAutocorSerie { serie } {
255#///////////////////////////////////////////////////////////////////////////// 
256  variable group_id
257   
258  incr group_id
259  # title
260 
261  if {[llength $serie] > 1} {
262    set nameSerie [lindex [::tol::info variable $serie] 1]
263  } else {
264    set nameSerie $serie
265  }
266  # create
267  set tl [::project::CreateForm \
268      -title "[mc "Autocorrelation graph"]: $nameSerie" \
269      -iniconfig AutocorGraph \
270      -type Graphs \
271      -width 900 -height 650 -helpkey "Tb4GraAco"
272  ]
273  set tlf [$tl getframe]
274  # configuration
275  ::AutocorGraph::Create $tlf.g $serie
276  $tl bind <Control-F4> "$tl kill; break"
277  pack $tlf.g -fill both -expand yes
278  update
279}
280
281#/////////////////////////////////////////////////////////////////////////////
282proc ::TolInspector::TableSerie { } {
283#///////////////////////////////////////////////////////////////////////////// 
284  variable options_selected
285  variable group_id
286  upvar \#0 ::TolInspector::options_selected(Serie) series_selected
287
288  set series ""
289  foreach it $series_selected {
290    lappend series [lindex $it 0]
291  }
292
293  if { [llength $series] } {
294    incr group_id
295
296    set sergrp group$group_id
297    eval "::tol::seriegrp create $sergrp $series"
298   
299    # create
300    set tl [::project::CreateForm \
301        -title [mc "Time series table"] \
302        -iniconfig SeriesTable \
303        -type Tables -helpkey "Tb4Edt"
304    ]
305        set tlf [$tl getframe]
306    # configuration
307    btable $tlf.t -parent $tl \
308                  -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
309                  -iniconfig btable
310    $tlf.t fillSerie $sergrp
311    bind $tlf.t <Destroy> +[list ::tol::seriegrp destroy $sergrp]
312    pack $tlf.t -fill both -expand yes
313    $tl bind <Control-F4> [list $tl kill]
314    update
315  }
316}
317
318#/////////////////////////////////////////////////////////////////////////////
319proc ::TolInspector::TableAutocorSerie { serie } {
320#///////////////////////////////////////////////////////////////////////////// 
321  variable group_id
322   
323  incr group_id
324  # title
325  if {[llength $serie] > 1} {
326    set nameSerie [lindex [::tol::info variable $serie] 1]
327  } else {
328    set nameSerie $serie
329  }
330  # create
331  set tl [::project::CreateForm \
332      -title "[mc "Autocorrelation table"]: $nameSerie" \
333      -iniconfig AutocorGraphTable \
334      -type Tables -helpkey "Tb4Edt"
335  ]
336  set tlf [$tl getframe]
337  # configuration
338  btable $tlf.t -parent $tl \
339                -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
340                -iniconfig btable
341  $tlf.t fillAutocor $serie ""
342  $tl bind <Control-F4> [list $tl kill]
343  pack $tlf.t -fill both -expand yes
344}
345
346#/////////////////////////////////////////////////////////////////////////////
347proc ::TolInspector::TableStatisticsSerie { } {
348#/////////////////////////////////////////////////////////////////////////////
349  variable options_selected
350  variable group_id
351  upvar \#0 ::TolInspector::options_selected(Serie) series_selected
352
353  set series ""
354  foreach it $series_selected {
355    lappend series [lindex $it 0]
356  }
357
358  if { [llength $series] } {
359    incr group_id
360
361    set sergrp group$group_id
362    eval "::tol::seriegrp create $sergrp $series"
363    # create
364    set tl [::project::CreateForm \
365        -title [mc "Statistics table"] \
366        -iniconfig StatisticsTable \
367        -type Tables -helpkey "Tb4Edt"
368    ]
369    set tlf [$tl getframe]
370    # configuration
371    btable $tlf.t -parent $tl \
372                  -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
373                  -iniconfig btable
374    $tlf.t fillStatistics $sergrp
375    bind $tlf.t <Destroy> +[list ::tol::seriegrp destroy $sergrp]
376    $tl bind <Control-F4> [list $tl kill]
377    pack $tlf.t -fill both -expand yes
378  }
379}
380
381#/////////////////////////////////////////////////////////////////////////////
382proc ::TolInspector::ViewTimeSet { tms args } {
383#/////////////////////////////////////////////////////////////////////////////
384  variable group_id
385 
386  incr group_id
387 
388  #puts "::TolInspector::ViewTimeSet $tms"
389  # args
390  array set opts [list \
391    -title "[mc "TimeSet calendar"]: $tms" \
392    -geometry {}
393  ]
394  array set opts $args 
395 
396  # create
397  set tl [::project::CreateForm \
398      -title $opts(-title) \
399      -iniconfig Calendar \
400      -type TimeSets -width 470 -height 345 -helpkey "Tb4Cal"
401  ]
402  # geometry
403  $tl setgeometry $opts(-geometry)
404 
405  set tlf [$tl getframe]
406  # configuration
407  set tmscmd tms$group_id
408  ::tol::timeset create $tmscmd $tms
409  ::CalendarTms::Create $tlf.t $tmscmd
410  bind $tlf.t <Destroy> +[list ::tol::timeset destroy $tmscmd]
411  bind $tl <Control-F4> [list $tl kill]
412  pack $tlf.t -fill both -expand yes
413 
414  return $tl
415}
416
417#/////////////////////////////////////////////////////////////////////////////
418proc ::TolInspector::ViewDefinition {name path grammar} {
419#/////////////////////////////////////////////////////////////////////////////
420  variable w_tabset
421  if {$path == ""} {
422    tk_messageBox -type ok -icon warning\
423      -message [mc "Object %1\$s is not defined in a tol file" $name]\
424      -parent $w_tabset -title [mc Warning]
425    return
426  }
427  set ext [file extension $path]
428  switch -- $ext {
429    .tol -
430    .TOL {
431      set Instance [::Editor::Open $path]
432      update
433      if {[string equal $grammar "Code"] ||
434          [string equal $grammar "Anything"]} {
435        append txtFind " " $name "( )*\\("
436      } else {
437        #append txtFind $grammar "( )+" $name
438        append txtFind $name
439      }
440      #Me situo al principio del texto
441      set editor [::Editor::GetText $Instance]
442      tk::TextSetCursor $editor 1.0
443      ::BayesText::FindShow $editor 1 $txtFind 1
444      #::Editor::CmdFindNext $Instance $txtFind
445    }
446    .bst -
447    .BST -
448    .bdt -
449    .BDT {
450      # Igual luego se abre como tabla
451      ::Editor::Open $path
452    }
453  }
454}
455
456#/////////////////////////////////////////////////////////////////////////////
457proc ::TolInspector::ViewFile {name} {
458#
459# PURPOSE:
460#
461# PARAMETERS:
462#   name -> cadena con el nombre de un archivo o el de una variable
463#           que hace referencia a un archivo
464#
465#/////////////////////////////////////////////////////////////////////////////
466  #  En name puede venir el nombre de un archivo o el de una variable
467  # que hace referencia a un archivo.
468  #puts "ViewFile. name=$name"
469  if [file isfile $name] {
470    set path $name
471  } else  {
472    set path [::tol::info path $name]
473  }
474  ::Editor::Open $path
475}
Note: See TracBrowser for help on using the repository browser.