source: tol/tolbase/lib/toltk/graph.tcl @ 6d7779d

1941-docker-image-to-testdevel
Last change on this file since 6d7779d 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: 21.2 KB
Line 
1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : graph.tcl
3# PURPOSE : This file is part of BLT Toolkit
4#/////////////////////////////////////////////////////////////////////////////
5
6proc Blt_ActiveLegend { graph } {
7    $graph legend bind all <Enter> [list blt::ActivateLegend $graph ]
8    $graph legend bind all <Leave> [list blt::DeactivateLegend $graph]
9    $graph legend bind all <ButtonPress-1> [list blt::HighlightLegend $graph]
10}
11
12proc Blt_Crosshairs { graph } {
13    blt::Crosshairs $graph
14}
15
16proc Blt_ZoomStack { graph } {
17    blt::ZoomStack $graph
18}
19
20# Cambia el ViewMode
21# modos posibles:
22#   zoom-frame
23#   zoom-in
24#   zoom-out
25#   scroll
26
27proc Blt_ViewMode { graph mode } {
28  global zoomInfo
29
30  if { ![blt::ClearMode $graph $mode] } return
31
32  set zoomInfo($graph,mode) $mode
33
34  if { [string equal $mode "scroll"] } {
35    # limpio el stack
36    blt::InitStack $graph $mode
37    bind scroll-$graph <ButtonPress-1> { blt::SetScrollPoint %W %x %y }
38    bind scroll-$graph <ButtonRelease-1> { blt::SetScrollPoint %W %x %y }
39    # este evento posiblemente ya no hara falta
40    bind scroll-$graph <ButtonPress-3> {
41      if { [%W inside %x %y] } {
42        blt::ResetScroll %W
43      }
44    }
45    blt::AddBindTag $graph scroll-$graph
46  } elseif { [regexp "zoom-*" $mode] } {
47    puts "mode = $mode"
48    bind zoom-$graph <ButtonPress-1> { blt::SetZoomPoint %W %x %y }
49    if { [string equal $mode zoom-frame] } {
50      bind zoom-$graph <ButtonRelease-1> { blt::SetZoomPoint %W %x %y }
51    } else {
52      bind zoom-$graph <ButtonRelease-1> ""
53    }
54    bind zoom-$graph <ButtonPress-3> {
55      if { [%W inside %x %y] } {
56        blt::ResetZoom %W
57      }
58    }
59    blt::AddBindTag $graph zoom-$graph
60  }
61}
62
63proc blt::SetZoomScale { graph scale } {
64  global zoomInfo
65
66  set zoomInfo($graph,scale) $scale
67}
68
69proc blt::ClearMode { graph newmode } {
70  global zoomInfo
71
72  if { [info exists zoomInfo($graph,mode)] } {
73    if { [string equal $newmode $zoomInfo($graph,mode)] } {
74      return 0
75    }
76    set zoomInfo($graph,corner) A
77    if { [string equal $zoomInfo($graph,mode) "scroll"] } {
78      eval $graph marker delete [$graph marker names "scroll*"]
79      blt::RemoveBindTag $graph "scroll-region-$graph" "scroll-$graph"
80    } else {
81      eval $graph marker delete [$graph marker names "zoom*"]
82      blt::RemoveBindTag $graph "select-region-$graph" "zoom-$graph"
83    }
84  } else {
85    blt::InitStack $graph ""
86  }
87  return 1
88}
89
90proc Blt_PrintKey { graph } {
91    blt::PrintKey $graph
92}
93
94proc Blt_ClosestPoint { graph } {
95    blt::ClosestPoint $graph
96}
97
98#
99# The following procedures that reside in the "blt" namespace are
100# supposed to be private.
101#
102
103proc blt::ActivateLegend { graph } {
104    set elem [$graph legend get current]
105    $graph legend activate $elem
106}
107proc blt::DeactivateLegend { graph } {
108    set elem [$graph legend get current]
109    $graph legend deactivate $elem
110}
111
112proc blt::HighlightLegend { graph } {
113    set elem [$graph legend get current]
114    set relief [$graph element cget $elem -labelrelief]
115    if { $relief == "flat" } {
116        $graph element configure $elem -labelrelief raised
117        $graph element activate $elem
118    } else {
119        $graph element configure $elem -labelrelief flat
120        $graph element deactivate $elem
121    }
122}
123
124proc blt::Crosshairs { graph { event "Any-Motion" } } {
125    $graph crosshairs on
126    bind crosshairs-$graph <$event>   {
127        %W crosshairs configure -position @%x,%y
128    }
129    bind crosshairs-$graph <Leave>   {
130        %W crosshairs off
131    }
132    bind crosshairs-$graph <Enter>   {
133        %W crosshairs on
134    }
135    $graph crosshairs configure -color red
136    blt::AddBindTag $graph crosshairs-$graph
137}
138
139proc blt::ClearCrosshairs { graph } {
140  blt::RemoveBindTag $graph crosshairs-$graph
141  $graph crosshairs off
142}
143
144proc blt::InitStack { graph {mode zoom-frame} } {
145    global zoomInfo
146    set zoomInfo($graph,interval) 100
147    set zoomInfo($graph,afterId) 0
148  set zoomInfo($graph,afterId1) 0
149    set zoomInfo($graph,A,x) {}
150    set zoomInfo($graph,A,y) {}
151    set zoomInfo($graph,B,x) {}
152    set zoomInfo($graph,B,y) {}
153    set zoomInfo($graph,stack) {}
154    set zoomInfo($graph,corner) A
155 
156  # this is to allow zoom in, out scroll
157 
158  set zoomInfo($graph,mode) $mode
159}
160
161proc blt::DeleteStack { graph } {
162  global zoomInfo
163
164  foreach it [array names zoomInfo $graph,*] {
165    unset zoomInfo($it)
166  }
167}
168
169proc blt::ZoomStack { graph {start "ButtonPress-1"} {reset "ButtonPress-3"} } {
170  global zoomInfo zoomMod
171   
172  blt::InitStack $graph
173   
174  if { [info exists zoomMod] } {
175    set modifier $zoomMod
176  } else {
177    set modifier ""
178  }
179  bind zoom-$graph <${modifier}${start}> { blt::SetZoomPoint %W %x %y }
180  bind zoom-$graph <${modifier}${reset}> {
181    if { [%W inside %x %y] } {
182      blt::ResetZoom %W
183    }
184  }
185  blt::AddBindTag $graph zoom-$graph
186}
187
188proc blt::PrintKey { graph {event "Shift-ButtonRelease-3"} } {
189    bind print-$graph <$event>  { Blt_PostScriptDialog %W }
190    blt::AddBindTag $graph print-$graph
191}
192
193proc blt::ClosestPoint { graph {event "Control-ButtonPress-2"} } {
194    bind closest-point-$graph <$event>  {
195        blt::FindElement %W %x %y
196    }
197    blt::AddBindTag $graph closest-point-$graph
198}
199
200proc blt::AddBindTag { widget tag } {
201    set oldTagList [bindtags $widget]
202    if { [lsearch $oldTagList $tag] < 0 } {
203        bindtags $widget [linsert $oldTagList 0  $tag]
204    }
205}
206
207proc blt::RemoveBindTag { widget args } {
208    set oldTagList [bindtags $widget]
209  foreach tag $args {
210    set index [lsearch $oldTagList $tag]
211    if { $index >= 0 } {
212        bindtags $widget [lreplace $oldTagList $index $index]
213    }
214  }
215}
216
217proc blt::FindElement { graph x y } {
218    if ![$graph element closest $x $y info -interpolate yes] {
219        beep
220        return
221    }
222    # --------------------------------------------------------------
223    # find(name)                - element Id
224    # find(index)               - index of closest point
225    # find(x) find(y)           - coordinates of closest point
226    #                             or closest point on line segment.
227    # find(dist)                - distance from sample coordinate
228    # --------------------------------------------------------------
229    set markerName "bltClosest_$info(name)"
230    catch { $graph marker delete $markerName }
231    $graph marker create text -coords { $info(x) $info(y) } \
232        -name $markerName \
233        -text "$info(name): $info(dist)\nindex $info(index)" \
234        -font *lucida*-r-*-10-* \
235        -anchor center -justify left \
236        -yoffset 0 -bg {}
237
238    set coords [$graph invtransform $x $y]
239    set nx [lindex $coords 0]
240    set ny [lindex $coords 1]
241
242    $graph marker create line -coords "$nx $ny $info(x) $info(y)" \
243        -name line.$markerName
244
245    blt::FlashPoint $graph $info(name) $info(index) 10
246    blt::FlashPoint $graph $info(name) [expr $info(index) + 1] 10
247}
248
249proc blt::FlashPoint { graph name index count } {
250    if { $count & 1 } {
251        $graph element deactivate $name
252    } else {
253        $graph element activate $name $index
254    }
255    incr count -1
256    if { $count > 0 } {
257        after 200 blt::FlashPoint $graph $name $index $count
258        update
259    } else {
260        eval $graph marker delete [$graph marker names "bltClosest_*"]
261    }
262}
263
264proc blt::GetCoords { graph x y index } {
265    global zoomInfo
266    if { [$graph cget -invertxy] } {
267        set zoomInfo($graph,$index,x) $y
268        set zoomInfo($graph,$index,y) $x
269    } else {
270        set zoomInfo($graph,$index,x) $x
271        set zoomInfo($graph,$index,y) $y
272    }
273}
274
275proc blt::MarkPoint { graph index } {
276    global zoomInfo
277    set x [$graph xaxis invtransform $zoomInfo($graph,$index,x)]
278    set y [$graph yaxis invtransform $zoomInfo($graph,$index,y)]
279    set marker "zoomText_$index"
280    set text [format "x=%.4g\ny=%.4g" $x $y]
281
282    if [$graph marker exists $marker] {
283        $graph marker configure $marker -coords { $x $y } -text $text
284    } else {
285        $graph marker create text -coords { $x $y } -name $marker \
286            -font *lucida*-r-*-10-* \
287            -text $text -anchor center -bg {} -justify left
288    }
289}
290
291proc blt::DestroyZoomTitle { graph } {
292    global zoomInfo
293
294    if { $zoomInfo($graph,corner) == "A" } {
295        catch { $graph marker delete "zoomTitle" }
296    }
297}
298
299proc blt::PopZoom { graph } {
300  global zoomInfo
301
302  set zoomStack $zoomInfo($graph,stack)
303  if { [llength $zoomStack] > 0 } {
304    set cmd [lindex $zoomStack 0]
305    set zoomInfo($graph,stack) [lrange $zoomStack 1 end]
306    eval $cmd
307    blt::ZoomTitleLast $graph
308    busy hold $graph
309  set this [::bayesGraph::getInstance $graph]
310  upvar \#0 ${this}::data data
311  set gr $data(gr,active)
312  #Tolcon_Trace "Aplicando Axis Ticks PopZoom"
313  ::bayesGraph::GrapOptApplyAxisTicks    $this ${this}::options gr,$gr
314    update
315    set id [after 2000 "blt::DestroyZoomTitle $graph"]
316    set zoomInfo($graph,afterId1) $id
317    busy release $graph
318  } else {
319    catch { $graph marker delete "zoomTitle" }
320  }
321}
322
323# Push the old axis limits on the stack and set the new ones
324
325proc blt::PushZoom { graph } {
326  global zoomInfo
327  eval $graph marker delete [$graph marker names "zoom*"]
328  if { [info exists zoomInfo($graph,afterId)] } {
329    after cancel $zoomInfo($graph,afterId)
330  }
331  set x1 $zoomInfo($graph,A,x)
332  set y1 $zoomInfo($graph,A,y)
333  set x2 $zoomInfo($graph,B,x)
334  set y2 $zoomInfo($graph,B,y)
335
336  if { ($x1 == $x2) || ($y1 == $y2) } {
337    # No delta, revert to start
338    return
339  }
340  set cmd {}
341  foreach margin { xaxis yaxis x2axis y2axis } {
342    foreach axis [$graph $margin use] {
343      set min [$graph axis cget $axis -min]
344      set max [$graph axis cget $axis -max]
345      set c [list $graph axis configure $axis -min $min -max $max]
346      append cmd "$c\n"
347    }
348  }
349  set zoomInfo($graph,stack) [linsert $zoomInfo($graph,stack) 0 $cmd]
350
351  busy hold $graph
352  # This update lets the busy cursor take effect.
353  update
354
355  foreach margin { xaxis x2axis } {
356    foreach axis [$graph $margin use] {
357      set min [$graph axis invtransform $axis $x1]
358      set max [$graph axis invtransform $axis $x2]
359      if { $min > $max } {
360        set tmp $min
361        set min $max
362        set max $tmp
363      }
364      # this code is to allow zoom-out operations
365      if { [string equal $zoomInfo($graph,mode) "zoom-out"] } {
366        set limits [$graph axis limits $axis]
367        set lower [lindex $limits 0]
368        set upper [lindex $limits 1]
369        set delta [expr ($upper - $lower)/2.0]
370        set min [expr $min - $delta]
371        set max [expr $max + $delta]
372      }
373      # end zoom-out path
374         
375#      if { $min > $max } {
376#               $graph axis configure $axis -min $max -max $min
377#           } else {
378#               $graph axis configure $axis -min $min -max $max
379#           }
380      $graph axis configure $axis -min $min -max $max
381    }
382  }
383  foreach margin { yaxis y2axis } {
384    foreach axis [$graph $margin use] {
385      set min [$graph axis invtransform $axis $y1]
386      set max [$graph axis invtransform $axis $y2]
387
388      if { $min > $max } {
389        set tmp $min
390        set min $max
391        set max $tmp
392      }
393
394      # this code is to allow zoom-out operations
395      if { [string equal $zoomInfo($graph,mode) "zoom-out"] } {
396        set limits [$graph axis limits $axis]
397        set lower [lindex $limits 0]
398        set upper [lindex $limits 1]
399        set delta [expr ($upper - $lower)/2.0]
400        set min [expr $min - $delta]
401        set max [expr $max + $delta]
402      }
403      #end zoom-out patch
404
405#           if { $min > $max } {
406#               $graph axis configure $axis -min $max -max $min
407#           } else {
408#               $graph axis configure $axis -min $min -max $max
409#           }
410      $graph axis configure $axis -min $min -max $max
411        }
412  }
413  # This "update" forces the graph to be redrawn
414  set this [::bayesGraph::getInstance $graph]
415  upvar \#0 ${this}::data data
416  set gr $data(gr,active)
417  #Tolcon_Trace "Aplicando Axis Ticks PushZoom"
418  ::bayesGraph::GrapOptApplyAxisTicks    $this ${this}::options gr,$gr
419  update
420   
421  busy release $graph
422}
423
424#
425# This routine terminates either an existing zoom, or pops back to
426# the previous zoom level (if no zoom is in progress).
427#
428
429proc blt::ResetZoom { graph } {
430  global zoomInfo
431
432  if { ![info exists zoomInfo($graph,corner)] } {
433    blt::InitStack $graph
434  }
435  eval $graph marker delete [$graph marker names "zoom*"]
436
437  if { $zoomInfo($graph,corner) == "A" } {
438    # Reset the whole axis
439    blt::PopZoom $graph
440  } else {
441    global zoomMod
442    if { [info exists zoomMod] } {
443      set modifier $zoomMod
444    } else {
445      set modifier "Any-"
446    }
447    set zoomInfo($graph,corner) A
448    blt::RemoveBindTag $graph select-region-$graph
449  }
450}
451
452proc blt::ResetScroll { graph } {
453  global zoomInfo
454
455  eval $graph marker delete [$graph marker names "scroll*"]
456  blt::RemoveBindTag $graph scroll-region-$graph
457  set zoomInfo($graph,corner) A 
458}
459
460option add *zoomTitle.font        -*-helvetica-medium-R-*-*-18-*-*-*-*-*-*-*
461option add *zoomTitle.shadow      yellow4
462option add *zoomTitle.foreground  yellow1
463option add *zoomTitle.coords      "-Inf Inf"
464
465option add *scrollTitle.font      -*-helvetica-medium-R-*-*-18-*-*-*-*-*-*-*
466option add *scrollTitle.shadow    yellow4
467option add *scrollTitle.foreground  yellow1
468option add *scrollTitle.coords    "-Inf Inf"
469
470proc blt::ZoomTitleNext { graph } {
471    global zoomInfo
472    set level [expr [llength $zoomInfo($graph,stack)] + 1]
473    if { [$graph cget -invertxy] } {
474        set coords "-Inf -Inf"
475    } else {
476        set coords "-Inf Inf"
477    }
478    $graph marker create text -name "zoomTitle" -text "Zoom #$level" \
479        -coords $coords -bindtags "" -anchor nw
480}
481
482proc blt::ScrollTitle { graph } {
483    if { [$graph cget -invertxy] } {
484        set coords "-Inf -Inf"
485    } else {
486        set coords "-Inf Inf"
487    }
488    $graph marker create text -name "scrollTitle" -text "scrolling ..." \
489        -coords $coords -bindtags "" -anchor nw
490}
491
492proc blt::ZoomTitleLast { graph } {
493    global zoomInfo
494
495    set level [llength $zoomInfo($graph,stack)]
496    if { $level > 0 } {
497        $graph marker create text -name "zoomTitle" -anchor nw \
498            -text "Zoom #$level"
499    }
500}
501
502proc blt::ZoomScale { graph } {
503  global zoomInfo
504
505  set cmd {}
506  foreach axis {x y} {
507    set limits [$graph axis limits $axis]
508    set min [lindex $limits 0]
509    set max [lindex $limits 1]
510    set delta$axis [expr 0.5 * ($max - $min)]
511    set c [list $graph axis configure $axis -min $min -max $max]
512    append cmd "$c\n"
513  }
514  set zoomInfo($graph,stack) [linsert $zoomInfo($graph,stack) 0 $cmd]
515  busy hold $graph
516  # This update lets the busy cursor take effect.
517  update
518
519    Tolcon_Trace "En ZoomScale zoomInfo($graph,scale) vale  $zoomInfo($graph,scale)"
520
521  if { [string equal $zoomInfo($graph,mode) "zoom-in"] } {
522    set deltax [expr $deltax * $zoomInfo($graph,scale)]
523    set deltay [expr $deltay * $zoomInfo($graph,scale)]
524  } else {
525    set deltax [expr $deltax / $zoomInfo($graph,scale)]
526    set deltay [expr $deltay / $zoomInfo($graph,scale)]
527  }
528
529  foreach {axis delta} [list x $deltax y $deltay] {
530    set v [$graph axis invtransform $axis $zoomInfo($graph,A,$axis)]
531    set min [expr $v - $delta]
532    set max [expr $v + $delta]
533    $graph axis configure $axis -min $min -max $max
534  }
535  # This "update" forces the graph to be redrawn
536  set this [::bayesGraph::getInstance $graph]
537  upvar \#0 ${this}::data data
538  set gr $data(gr,active)
539  #Tolcon_Trace "Aplicando Axis Ticks ZoomScale"
540  ::bayesGraph::GrapOptApplyAxisTicks    $this ${this}::options gr,$gr
541  update
542 
543  busy release $graph
544}
545
546proc blt::SetZoomPoint { graph x y } {
547  global zoomInfo zoomMod
548  if { ![info exists zoomInfo($graph,corner)] } {
549    blt::InitStack $graph
550  }
551  blt::GetCoords $graph $x $y $zoomInfo($graph,corner)
552
553  #puts  blt::SetZoomPoint
554
555  if { [string compare $zoomInfo($graph,mode) "zoom-frame"] } {
556    blt::ZoomScale $graph
557    return
558  }
559
560  if { [info exists zoomMod] } {
561    set modifier $zoomMod
562  } else {
563    set modifier "Any-"
564  }
565  bind select-region-$graph <${modifier}Motion> {
566    blt::GetCoords %W %x %y B
567    #blt::MarkPoint $graph B
568    blt::Box %W
569  }
570  if { $zoomInfo($graph,corner) == "A" } {
571        if { ![$graph inside $x $y] } {
572            return
573        }
574        # First corner selected, start watching motion events
575
576        #blt::MarkPoint $graph A
577        blt::ZoomTitleNext $graph
578
579        blt::AddBindTag $graph select-region-$graph
580        set zoomInfo($graph,corner) B
581  } else {
582        # Delete the modal binding
583        blt::RemoveBindTag $graph select-region-$graph
584        blt::PushZoom $graph
585        set zoomInfo($graph,corner) A
586  }
587}
588
589proc blt::SetScrollPoint { graph x y } {
590    global zoomInfo
591
592    blt::GetCoords $graph $x $y A
593    bind scroll-region-$graph <Any-Motion> {
594        blt::GetCoords %W %x %y B
595        #blt::MarkPoint $graph B
596        blt::Scroll %W
597    }
598    if { $zoomInfo($graph,corner) == "A" } {
599        if { ![$graph inside $x $y] } {
600            return
601        }
602        # First corner selected, start watching motion events
603
604        #blt::MarkPoint $graph A
605        blt::ScrollTitle $graph
606
607        blt::AddBindTag $graph scroll-region-$graph
608        set zoomInfo($graph,corner) B
609    } else {
610        # Delete the modal binding
611      ResetScroll $graph
612    }
613}
614
615option add *zoomOutline.dashes          4       
616option add *zoomTitle.anchor            nw
617option add *zoomOutline.lineWidth       2
618option add *zoomOutline.xor             yes
619
620proc blt::MarchingAnts { graph offset } {
621    global zoomInfo
622
623    incr offset
624    if { [$graph marker exists zoomOutline] } {
625        $graph marker configure zoomOutline -dashoffset $offset
626        set interval $zoomInfo($graph,interval)
627        set id [after $interval [list blt::MarchingAnts $graph $offset]]
628        set zoomInfo($graph,afterId) $id
629    }
630}
631
632proc blt::Box { graph } {
633    global zoomInfo
634
635    if { $zoomInfo($graph,A,x) > $zoomInfo($graph,B,x) } {
636        set x1 [$graph xaxis invtransform $zoomInfo($graph,B,x)]
637        set y1 [$graph yaxis invtransform $zoomInfo($graph,B,y)]
638        set x2 [$graph xaxis invtransform $zoomInfo($graph,A,x)]
639        set y2 [$graph yaxis invtransform $zoomInfo($graph,A,y)]
640    } else {
641        set x1 [$graph xaxis invtransform $zoomInfo($graph,A,x)]
642        set y1 [$graph yaxis invtransform $zoomInfo($graph,A,y)]
643        set x2 [$graph xaxis invtransform $zoomInfo($graph,B,x)]
644        set y2 [$graph yaxis invtransform $zoomInfo($graph,B,y)]
645    }
646    set coords { $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x1 $y1 }
647    if { [$graph marker exists "zoomOutline"] } {
648        $graph marker configure "zoomOutline" -coords $coords
649    } else {
650        set X [lindex [$graph xaxis use] 0]
651        set Y [lindex [$graph yaxis use] 0]
652        $graph marker create line -coords $coords -name "zoomOutline" \
653            -mapx $X -mapy $Y
654        set interval $zoomInfo($graph,interval)
655        set id [after $interval [list blt::MarchingAnts $graph 0]]
656        set zoomInfo($graph,afterId) $id
657    }
658}
659
660proc blt::Scroll { graph } {
661  global zoomInfo
662
663  set x1 [$graph xaxis invtransform $zoomInfo($graph,A,x)]
664  set x2 [$graph xaxis invtransform $zoomInfo($graph,B,x)]
665  set y1 [$graph yaxis invtransform $zoomInfo($graph,A,y)]
666  set y2 [$graph yaxis invtransform $zoomInfo($graph,B,y)]
667  #set deltax [expr $x2 - $x1]
668  #set deltay [expr $y2 - $y1]
669  # Cambiado para efecto 'agarrar el gráfico'
670  set deltax [expr $x1 - $x2]
671  set deltay [expr $y1 - $y2]
672  foreach {delta axis} [list $deltax x $deltay y] {
673    set limits [$graph axis limits $axis]
674    set lower [expr [lindex $limits 0] + $delta]
675    set upper [expr [lindex $limits 1] + $delta]
676    $graph axis configure $axis -min $lower -max $upper
677  }
678  set zoomInfo($graph,A,x) $zoomInfo($graph,B,x)
679  set zoomInfo($graph,A,y) $zoomInfo($graph,B,y)
680}
681
682proc Blt_PostScriptDialog { graph } {
683    set top $graph.top
684    toplevel $top
685
686    foreach var { center landscape maxpect preview decorations padx
687        pady paperwidth paperheight width height colormode } {
688        global $graph.$var
689        set $graph.$var [$graph postscript cget -$var]
690    }
691    set row 1
692    set col 0
693    label $top.title -text "PostScript Options"
694    table $top $top.title -cspan 7
695    foreach bool { center landscape maxpect preview decorations } {
696        set w $top.$bool-label
697        label $w -text "-$bool" -font *courier*-r-*12*
698        table $top $row,$col $w -anchor e -pady { 2 0 } -padx { 0 4 }
699        set w $top.$bool-yes
700        global $graph.$bool
701        radiobutton $w -text "yes" -variable $graph.$bool -value 1
702        table $top $row,$col+1 $w -anchor w
703        set w $top.$bool-no
704        radiobutton $w -text "no" -variable $graph.$bool -value 0
705        table $top $row,$col+2 $w -anchor w
706        incr row
707    }
708    label $top.modes -text "-colormode" -font *courier*-r-*12*
709    table $top $row,0 $top.modes -anchor e  -pady { 2 0 } -padx { 0 4 }
710    set col 1
711    foreach m { color greyscale } {
712        set w $top.$m
713        radiobutton $w -text $m -variable $graph.colormode -value $m
714        table $top $row,$col $w -anchor w
715        incr col
716    }
717    set row 1
718    frame $top.sep -width 2 -bd 1 -relief sunken
719    table $top $row,3 $top.sep -fill y -rspan 6
720    set col 4
721    foreach value { padx pady paperwidth paperheight width height } {
722        set w $top.$value-label
723        label $w -text "-$value" -font *courier*-r-*12*
724        table $top $row,$col $w -anchor e  -pady { 2 0 } -padx { 0 4 }
725        set w $top.$value-entry
726        global $graph.$value
727        entry $w -textvariable $graph.$value -width 8
728        table $top $row,$col+1 $w -cspan 2 -anchor w -padx 8
729        incr row
730    }
731    table configure $top c3 -width .125i
732    button $top.cancel -text "Cancel" -command "destroy $top"
733    table $top $row,0 $top.cancel  -width 1i -pady 2 -cspan 3
734    button $top.reset -text "Reset" -command "destroy $top"
735    #table $top $row,1 $top.reset  -width 1i
736    button $top.print -text "Print" -command "blt::ResetPostScript $graph"
737    table $top $row,4 $top.print  -width 1i -pady 2 -cspan 2
738}
739
740proc blt::ResetPostScript { graph } {
741    foreach var { center landscape maxpect preview decorations padx
742        pady paperwidth paperheight width height colormode } {
743        global $graph.$var
744        set old [$graph postscript cget -$var]
745        if { [catch {$graph postscript configure -$var [set $graph.$var]}] != 0 } {
746            $graph postscript configure -$var $old
747            set $graph.$var $old
748        }
749    }
750    $graph postscript output "out.ps"
751    puts stdout "wrote file \"out.ps\"."
752    flush stdout
753}
Note: See TracBrowser for help on using the repository browser.