source: trunk/kitgen/8.x/blt/library/graph.tcl

Last change on this file was 175, checked in by demin, 12 years ago

initial commit

File size: 13.8 KB
Line 
1
2proc Blt_ActiveLegend { graph } {
3 $graph legend bind all <Enter> [list blt::ActivateLegend $graph ]
4 $graph legend bind all <Leave> [list blt::DeactivateLegend $graph]
5 $graph legend bind all <ButtonPress-1> [list blt::HighlightLegend $graph]
6}
7
8proc Blt_Crosshairs { graph } {
9 blt::Crosshairs $graph
10}
11
12proc Blt_ResetCrosshairs { graph state } {
13 blt::Crosshairs $graph "Any-Motion" $state
14}
15
16proc Blt_ZoomStack { graph } {
17 blt::ZoomStack $graph
18}
19
20proc Blt_PrintKey { graph } {
21 blt::PrintKey $graph
22}
23
24proc Blt_ClosestPoint { graph } {
25 blt::ClosestPoint $graph
26}
27
28#
29# The following procedures that reside in the "blt" namespace are
30# supposed to be private.
31#
32
33proc blt::ActivateLegend { graph } {
34 set elem [$graph legend get current]
35 $graph legend activate $elem
36}
37proc blt::DeactivateLegend { graph } {
38 set elem [$graph legend get current]
39 $graph legend deactivate $elem
40}
41
42proc blt::HighlightLegend { graph } {
43 set elem [$graph legend get current]
44 set relief [$graph element cget $elem -labelrelief]
45 if { $relief == "flat" } {
46 $graph element configure $elem -labelrelief raised
47 $graph element activate $elem
48 } else {
49 $graph element configure $elem -labelrelief flat
50 $graph element deactivate $elem
51 }
52}
53
54proc blt::Crosshairs { graph {event "Any-Motion"} {state "on"}} {
55 $graph crosshairs $state
56 bind crosshairs-$graph <$event> {
57 %W crosshairs configure -position @%x,%y
58 }
59 bind crosshairs-$graph <Leave> {
60 %W crosshairs off
61 }
62 bind crosshairs-$graph <Enter> {
63 %W crosshairs on
64 }
65 $graph crosshairs configure -color red
66 if { $state == "on" } {
67 blt::AddBindTag $graph crosshairs-$graph
68 } elseif { $state == "off" } {
69 blt::RemoveBindTag $graph crosshairs-$graph
70 }
71}
72
73proc blt::InitStack { graph } {
74 global zoomInfo
75 set zoomInfo($graph,interval) 100
76 set zoomInfo($graph,afterId) 0
77 set zoomInfo($graph,A,x) {}
78 set zoomInfo($graph,A,y) {}
79 set zoomInfo($graph,B,x) {}
80 set zoomInfo($graph,B,y) {}
81 set zoomInfo($graph,stack) {}
82 set zoomInfo($graph,corner) A
83}
84
85proc blt::ZoomStack { graph {start "ButtonPress-1"} {reset "ButtonPress-3"} } {
86 global zoomInfo zoomMod
87
88 blt::InitStack $graph
89
90 if { [info exists zoomMod] } {
91 set modifier $zoomMod
92 } else {
93 set modifier ""
94 }
95 bind zoom-$graph <${modifier}${start}> { blt::SetZoomPoint %W %x %y }
96 bind zoom-$graph <${modifier}${reset}> {
97 if { [%W inside %x %y] } {
98 blt::ResetZoom %W
99 }
100 }
101 blt::AddBindTag $graph zoom-$graph
102}
103
104proc blt::PrintKey { graph {event "Shift-ButtonRelease-3"} } {
105 bind print-$graph <$event> { Blt_PostScriptDialog %W }
106 blt::AddBindTag $graph print-$graph
107}
108
109proc blt::ClosestPoint { graph {event "Control-ButtonPress-2"} } {
110 bind closest-point-$graph <$event> {
111 blt::FindElement %W %x %y
112 }
113 blt::AddBindTag $graph closest-point-$graph
114}
115
116proc blt::AddBindTag { widget tag } {
117 set oldTagList [bindtags $widget]
118 if { [lsearch $oldTagList $tag] < 0 } {
119 bindtags $widget [linsert $oldTagList 0 $tag]
120 }
121}
122
123proc blt::RemoveBindTag { widget tag } {
124 set oldTagList [bindtags $widget]
125 set index [lsearch $oldTagList $tag]
126 if { $index >= 0 } {
127 bindtags $widget [lreplace $oldTagList $index $index]
128 }
129}
130
131proc blt::FindElement { graph x y } {
132 if ![$graph element closest $x $y info -interpolate yes] {
133 beep
134 return
135 }
136 # --------------------------------------------------------------
137 # find(name) - element Id
138 # find(index) - index of closest point
139 # find(x) find(y) - coordinates of closest point
140 # or closest point on line segment.
141 # find(dist) - distance from sample coordinate
142 # --------------------------------------------------------------
143 set markerName "bltClosest_$info(name)"
144 catch { $graph marker delete $markerName }
145 $graph marker create text -coords { $info(x) $info(y) } \
146 -name $markerName \
147 -text "$info(name): $info(dist)\nindex $info(index)" \
148 -font *lucida*-r-*-10-* \
149 -anchor center -justify left \
150 -yoffset 0 -bg {}
151
152 set coords [$graph invtransform $x $y]
153 set nx [lindex $coords 0]
154 set ny [lindex $coords 1]
155
156 $graph marker create line -coords "$nx $ny $info(x) $info(y)" \
157 -name line.$markerName
158
159 blt::FlashPoint $graph $info(name) $info(index) 10
160 blt::FlashPoint $graph $info(name) [expr $info(index) + 1] 10
161}
162
163proc blt::FlashPoint { graph name index count } {
164 if { $count & 1 } {
165 $graph element deactivate $name
166 } else {
167 $graph element activate $name $index
168 }
169 incr count -1
170 if { $count > 0 } {
171 after 200 blt::FlashPoint $graph $name $index $count
172 update
173 } else {
174 eval $graph marker delete [$graph marker names "bltClosest_*"]
175 }
176}
177
178proc blt::GetCoords { graph x y index } {
179 global zoomInfo
180 if { [$graph cget -invertxy] } {
181 set zoomInfo($graph,$index,x) $y
182 set zoomInfo($graph,$index,y) $x
183 } else {
184 set zoomInfo($graph,$index,x) $x
185 set zoomInfo($graph,$index,y) $y
186 }
187}
188
189proc blt::MarkPoint { graph index } {
190 global zoomInfo
191 set x [$graph xaxis invtransform $zoomInfo($graph,$index,x)]
192 set y [$graph yaxis invtransform $zoomInfo($graph,$index,y)]
193 set marker "zoomText_$index"
194 set text [format "x=%.4g\ny=%.4g" $x $y]
195
196 if [$graph marker exists $marker] {
197 $graph marker configure $marker -coords { $x $y } -text $text
198 } else {
199 $graph marker create text -coords { $x $y } -name $marker \
200 -font *lucida*-r-*-10-* \
201 -text $text -anchor center -bg {} -justify left
202 }
203}
204
205proc blt::DestroyZoomTitle { graph } {
206 global zoomInfo
207
208 if { $zoomInfo($graph,corner) == "A" } {
209 catch { $graph marker delete "zoomTitle" }
210 }
211}
212
213proc blt::PopZoom { graph } {
214 global zoomInfo
215
216 set zoomStack $zoomInfo($graph,stack)
217 if { [llength $zoomStack] > 0 } {
218 set cmd [lindex $zoomStack 0]
219 set zoomInfo($graph,stack) [lrange $zoomStack 1 end]
220 eval $cmd
221 blt::ZoomTitleLast $graph
222 busy hold $graph
223 update
224 busy release $graph
225 after 2000 "blt::DestroyZoomTitle $graph"
226 } else {
227 catch { $graph marker delete "zoomTitle" }
228 }
229}
230
231# Push the old axis limits on the stack and set the new ones
232
233proc blt::PushZoom { graph } {
234 global zoomInfo
235 eval $graph marker delete [$graph marker names "zoom*"]
236 if { [info exists zoomInfo($graph,afterId)] } {
237 after cancel $zoomInfo($graph,afterId)
238 }
239 set x1 $zoomInfo($graph,A,x)
240 set y1 $zoomInfo($graph,A,y)
241 set x2 $zoomInfo($graph,B,x)
242 set y2 $zoomInfo($graph,B,y)
243
244 if { ($x1 == $x2) || ($y1 == $y2) } {
245 # No delta, revert to start
246 return
247 }
248 set cmd {}
249 foreach margin { xaxis yaxis x2axis y2axis } {
250 foreach axis [$graph $margin use] {
251 set min [$graph axis cget $axis -min]
252 set max [$graph axis cget $axis -max]
253 set c [list $graph axis configure $axis -min $min -max $max]
254 append cmd "$c\n"
255 }
256 }
257 set zoomInfo($graph,stack) [linsert $zoomInfo($graph,stack) 0 $cmd]
258
259
260 foreach margin { xaxis x2axis } {
261 foreach axis [$graph $margin use] {
262 set min [$graph axis invtransform $axis $x1]
263 set max [$graph axis invtransform $axis $x2]
264 if { $min > $max } {
265 $graph axis configure $axis -min $max -max $min
266 } else {
267 $graph axis configure $axis -min $min -max $max
268 }
269 }
270 }
271 foreach margin { yaxis y2axis } {
272 foreach axis [$graph $margin use] {
273 set min [$graph axis invtransform $axis $y1]
274 set max [$graph axis invtransform $axis $y2]
275 if { $min > $max } {
276 $graph axis configure $axis -min $max -max $min
277 } else {
278 $graph axis configure $axis -min $min -max $max
279 }
280 }
281 }
282 busy hold $graph
283 update; # This "update" redraws the graph
284 busy release $graph
285}
286
287#
288# This routine terminates either an existing zoom, or pops back to
289# the previous zoom level (if no zoom is in progress).
290#
291
292proc blt::ResetZoom { graph } {
293 global zoomInfo
294
295 if { ![info exists zoomInfo($graph,corner)] } {
296 blt::InitStack $graph
297 }
298 eval $graph marker delete [$graph marker names "zoom*"]
299
300 if { $zoomInfo($graph,corner) == "A" } {
301 # Reset the whole axis
302 blt::PopZoom $graph
303 } else {
304 global zoomMod
305
306 if { [info exists zoomMod] } {
307 set modifier $zoomMod
308 } else {
309 set modifier "Any-"
310 }
311 set zoomInfo($graph,corner) A
312 blt::RemoveBindTag $graph select-region-$graph
313 }
314}
315
316option add *zoomTitle.font -*-helvetica-medium-R-*-*-18-*-*-*-*-*-*-*
317option add *zoomTitle.shadow yellow4
318option add *zoomTitle.foreground yellow1
319option add *zoomTitle.coords "-Inf Inf"
320
321proc blt::ZoomTitleNext { graph } {
322 global zoomInfo
323 set level [expr [llength $zoomInfo($graph,stack)] + 1]
324 if { [$graph cget -invertxy] } {
325 set coords "-Inf -Inf"
326 } else {
327 set coords "-Inf Inf"
328 }
329 $graph marker create text -name "zoomTitle" -text "Zoom #$level" \
330 -coords $coords -bindtags "" -anchor nw
331}
332
333proc blt::ZoomTitleLast { graph } {
334 global zoomInfo
335
336 set level [llength $zoomInfo($graph,stack)]
337 if { $level > 0 } {
338 $graph marker create text -name "zoomTitle" -anchor nw \
339 -text "Zoom #$level"
340 }
341}
342
343
344proc blt::SetZoomPoint { graph x y } {
345 global zoomInfo zoomMod
346 if { ![info exists zoomInfo($graph,corner)] } {
347 blt::InitStack $graph
348 }
349 blt::GetCoords $graph $x $y $zoomInfo($graph,corner)
350 if { [info exists zoomMod] } {
351 set modifier $zoomMod
352 } else {
353 set modifier "Any-"
354 }
355 bind select-region-$graph <${modifier}Motion> {
356 blt::GetCoords %W %x %y B
357 #blt::MarkPoint $graph B
358 blt::Box %W
359 }
360 if { $zoomInfo($graph,corner) == "A" } {
361 if { ![$graph inside $x $y] } {
362 return
363 }
364 # First corner selected, start watching motion events
365
366 #blt::MarkPoint $graph A
367 blt::ZoomTitleNext $graph
368
369 blt::AddBindTag $graph select-region-$graph
370 set zoomInfo($graph,corner) B
371 } else {
372 # Delete the modal binding
373 blt::RemoveBindTag $graph select-region-$graph
374 blt::PushZoom $graph
375 set zoomInfo($graph,corner) A
376 }
377}
378
379option add *zoomOutline.dashes 4
380option add *zoomTitle.anchor nw
381option add *zoomOutline.lineWidth 2
382option add *zoomOutline.xor yes
383
384proc blt::MarchingAnts { graph offset } {
385 global zoomInfo
386
387 incr offset
388 if { [$graph marker exists zoomOutline] } {
389 $graph marker configure zoomOutline -dashoffset $offset
390 set interval $zoomInfo($graph,interval)
391 set id [after $interval [list blt::MarchingAnts $graph $offset]]
392 set zoomInfo($graph,afterId) $id
393 }
394}
395
396proc blt::Box { graph } {
397 global zoomInfo
398
399 if { $zoomInfo($graph,A,x) > $zoomInfo($graph,B,x) } {
400 set x1 [$graph xaxis invtransform $zoomInfo($graph,B,x)]
401 set y1 [$graph yaxis invtransform $zoomInfo($graph,B,y)]
402 set x2 [$graph xaxis invtransform $zoomInfo($graph,A,x)]
403 set y2 [$graph yaxis invtransform $zoomInfo($graph,A,y)]
404 } else {
405 set x1 [$graph xaxis invtransform $zoomInfo($graph,A,x)]
406 set y1 [$graph yaxis invtransform $zoomInfo($graph,A,y)]
407 set x2 [$graph xaxis invtransform $zoomInfo($graph,B,x)]
408 set y2 [$graph yaxis invtransform $zoomInfo($graph,B,y)]
409 }
410 set coords { $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x1 $y1 }
411 if { [$graph marker exists "zoomOutline"] } {
412 $graph marker configure "zoomOutline" -coords $coords
413 } else {
414 set X [lindex [$graph xaxis use] 0]
415 set Y [lindex [$graph yaxis use] 0]
416 $graph marker create line -coords $coords -name "zoomOutline" \
417 -mapx $X -mapy $Y
418 set interval $zoomInfo($graph,interval)
419 set id [after $interval [list blt::MarchingAnts $graph 0]]
420 set zoomInfo($graph,afterId) $id
421 }
422}
423
424
425proc Blt_PostScriptDialog { graph } {
426 set top $graph.top
427 toplevel $top
428
429 foreach var { center landscape maxpect preview decorations padx
430 pady paperwidth paperheight width height colormode } {
431 global $graph.$var
432 set $graph.$var [$graph postscript cget -$var]
433 }
434 set row 1
435 set col 0
436 label $top.title -text "PostScript Options"
437 table $top $top.title -cspan 7
438 foreach bool { center landscape maxpect preview decorations } {
439 set w $top.$bool-label
440 label $w -text "-$bool" -font *courier*-r-*12*
441 table $top $row,$col $w -anchor e -pady { 2 0 } -padx { 0 4 }
442 set w $top.$bool-yes
443 global $graph.$bool
444 radiobutton $w -text "yes" -variable $graph.$bool -value 1
445 table $top $row,$col+1 $w -anchor w
446 set w $top.$bool-no
447 radiobutton $w -text "no" -variable $graph.$bool -value 0
448 table $top $row,$col+2 $w -anchor w
449 incr row
450 }
451 label $top.modes -text "-colormode" -font *courier*-r-*12*
452 table $top $row,0 $top.modes -anchor e -pady { 2 0 } -padx { 0 4 }
453 set col 1
454 foreach m { color greyscale } {
455 set w $top.$m
456 radiobutton $w -text $m -variable $graph.colormode -value $m
457 table $top $row,$col $w -anchor w
458 incr col
459 }
460 set row 1
461 frame $top.sep -width 2 -bd 1 -relief sunken
462 table $top $row,3 $top.sep -fill y -rspan 6
463 set col 4
464 foreach value { padx pady paperwidth paperheight width height } {
465 set w $top.$value-label
466 label $w -text "-$value" -font *courier*-r-*12*
467 table $top $row,$col $w -anchor e -pady { 2 0 } -padx { 0 4 }
468 set w $top.$value-entry
469 global $graph.$value
470 entry $w -textvariable $graph.$value -width 8
471 table $top $row,$col+1 $w -cspan 2 -anchor w -padx 8
472 incr row
473 }
474 table configure $top c3 -width .125i
475 button $top.cancel -text "Cancel" -command "destroy $top"
476 table $top $row,0 $top.cancel -width 1i -pady 2 -cspan 3
477 button $top.reset -text "Reset" -command "destroy $top"
478 #table $top $row,1 $top.reset -width 1i
479 button $top.print -text "Print" -command "blt::ResetPostScript $graph"
480 table $top $row,4 $top.print -width 1i -pady 2 -cspan 2
481}
482
483proc blt::ResetPostScript { graph } {
484 foreach var { center landscape maxpect preview decorations padx
485 pady paperwidth paperheight width height colormode } {
486 global $graph.$var
487 set old [$graph postscript cget -$var]
488 if { [catch {$graph postscript configure -$var [set $graph.$var]}] != 0 } {
489 $graph postscript configure -$var $old
490 set $graph.$var $old
491 }
492 }
493 $graph postscript output "out.ps"
494 puts stdout "wrote file \"out.ps\"."
495 flush stdout
496}
Note: See TracBrowser for help on using the repository browser.