| Bsoft 2.0.5 Bernard's software package

bshow_graph.tcl
Go to the documentation of this file.
1 ##
2 # @file bshow_graph.tcl
3 #
4 # @brief Procedures to draw graphs in Bshow.
5 #
6 # @author Bernard Heymann
7 # @date Created: 20010516
8 # @date Modified: 20141226
9
10 set width 500
11 set height 350
12 set orix 100
13 set oriy 400
14 set color { blue green red yellow black SkyBlue2 }
15
16 ## @brief Draws a histogram of the image data.
17 #
18
19 proc Histogram { } {
20 global helv12 theimg
21 global orix oriy width height
22 global histplot
23 global color
24 if { [info exists histplot] } { unset histplot}
25 set w .whis
26 if ![winfo exists $w] {
27 toplevel $w
28
29 set xmin [Bimage get $theimg min]
30 set xmax [Bimage get $theimg max]
31 set datatype [Bimage get $theimg datatype]
32 set bins [expr int($xmax - $xmin + 1)]
33 if { $bins < 10 } { set bins 10}
34 if { $bins > 500 } { set bins 500}
35 if { [string first "float" $datatype] > -1 } { set bins 250}
36 # set hist [Bimage histogram $theimg $bins]
37
38 # set xscale [expr ($xmax - $xmin)/$bins]
39 # for { set i 0 } { $i < $bins } { incr i } {
40 # set histplot(x,$i) [expr $i*$xscale + $xmin]
41 # set histplot(y,$i) [lindex $hist $i]
42 # }
43
44 menu $w.menuBar -tearoff 0
45 $w.menuBar add cascade -menu $w.menuBar.his -label "Histogram" -underline 0
46 menu $w.menuBar.his -tearoff 0
47 $w configure -menu $w.menuBar
48 $w.menuBar.his add command -label "Help" \
49 -command { showHelp bshow_graph.hlp } -underline 0
50 $w.menuBar.his add command -label "Reset plot" -underline 0 \
51 -command { drawGraph $w histplot "bar" } -accelerator "Ctrl-r"
52 $w.menuBar.his add command -label "Write data" \
53 -command { writePlotData histplot } -underline 0
54 $w.menuBar.his add command -label "Close" -underline 0 \
55 -command {
56 if { [info exists histplot] } { unset histplot }
57 destroy $w
58 }
59
60 set h $w.plot
61 canvas $h -relief raised -width [expr $orix + $width + 50] \
62 -height [expr $oriy + 100] -bg white
63 pack $h -side top -fill x
64
65 frame $w.bins -bg SkyBlue2
66 label $w.bins.tag -font $helv12 -text "Bins" -bg SkyBlue2
67 entry $w.bins.entry -width 10 -validate key -vcmd { string is double %P }
68 $w.bins.entry insert 0 $bins
69 button $w.bins.update -text "Update" -relief raised \
70 -command {
71 calcHistogram
72 drawGraph .whis histplot "bar" "Bin" "Count"
73 }
74 pack $w.bins.tag $w.bins.entry $w.bins.update -side left -pady 10 -padx 10
75 pack $w.bins -side bottom
76
77 setupGraphVariables $w
78
79 calcHistogram
80
81 drawGraph $w histplot "bar" "Bin" "Count"
82 } else {
83 wm deiconify $w
84 raise $w
85 }
86 wm title $w "Histogram"
87 wm iconname $w "Histogram"
88 # puts "Plotting histogram (bshow_graph)"
89 $h bind point <Any-Enter> { showPoint .whis histplot %x %y }
90 $h bind point <Any-Leave> { showPoint .whis histplot %x %y }
91 bind $h <Button-1> {
92 set x1 [.whis.plot canvasx %x]
93 set y1 [.whis.plot canvasy %y]
94 }
95 bind $h <B1-Motion> { drawRectangle .whis.plot $x1 $y1 [.whis.plot canvasx %x] [.whis.plot canvasy %y] }
96 bind $h <B1-ButtonRelease> { drawSubGraph .whis histplot $x1 $y1 \
97 [.whis.plot canvasx %x] [.whis.plot canvasy %y] "bar" "Bin" "Count" }
98 bind $w <Control-r> { drawGraph .whis histplot "bar" "Bin" "Count" }
99 bind $w <Return> { plotGraph .whis histplot "bar" "Bin" "Count" }
100 bind $w <Control-w> {
101 if { [info exists histplot] } { unset histplot }
102 destroy .whis
103 }
104 }
105
106 ## @brief Calculates the histogram
107 #
108
109 proc calcHistogram { } {
110 global histplot theimg
111 global color
112 if { [info exists histplot] } { unset histplot}
113 set xmin [Bimage get $theimg min]
114 set xmax [Bimage get $theimg max]
115 set bins [.whis.bins.entry get]
116 if { $bins < 2 } {
117 set bins 250
118 .whis.bins.entry delete 0 end
119 .whis.bins.entry insert 0 $bins
120 }
121 set hist [Bimage histogram $theimg $bins]
122 set n [expr [llength $hist] / $bins]
123 set color { LightBlue }
124 if { $n == 3 } {
125 set color { red green blue }
126 }
127 # puts "Number of channels = $n"
128 set xscale [expr ($xmax - $xmin)/$bins]
129 for { set i 0} { $i < $bins } { incr i} {
130 set histplot(x,$i) [expr $i*$xscale + $xmin]
131 set histplot(y,$i) [lindex $hist $i]
132 }
133 for { set j 1} { $j < $n } { incr j} {
134 for { set i 0} { $i < $bins } { incr i} {
135 append histplot(y,$i) " " [lindex $hist [expr $j*$bins + $i]]
136 }
137 }
138 }
139
140 ## @brief Dialog box to analyze diffraction patterns
141 #
142
143 proc Diffraction { } {
144 global theimg
145 global helv12
146 global orix oriy width height
147 global diffplot
148 set c [getImageCanvas $theimg]
149 if { [info exists diffplot] } { unset diffplot}
150
151 set w .wdif
152 if ![winfo exists $w] {
153 toplevel $w
154
155 menu $w.menuBar -tearoff 0
156 $w.menuBar add cascade -menu $w.menuBar.dif -label "Diffraction" -underline 0
157 menu $w.menuBar.dif -tearoff 0
158 $w configure -menu $w.menuBar
159 $w.menuBar.dif add command -label "Help" \
160 -command { showHelp bshow_diffraction.hlp } -underline 0
161 $w.menuBar.dif add command -label "Reset plot" -underline 0 \
162 -command { drawGraph $w diffplot "line" "Frequency" "Intensity" } -accelerator "Ctrl-r"
163 $w.menuBar.dif add command -label "Write data" \
164 -command { writePlotData diffplot } -underline 0
165 $w.menuBar.dif add command -label "Close" \
166 -command { destroy $w } -underline 0
167
168 set g $w.plot
169 canvas $g -relief raised -width [expr $orix + $width + 50] \
170 -height [expr $oriy + 100]
171 pack $g -side top -fill x
172
173 frame $w.origin
174 label $w.origin.xtag -font $helv12 -text "ox"
175 entry $w.origin.x -width 10 -validate key -vcmd { string is double %P }
176 label $w.origin.ytag -font $helv12 -text "oy"
177 entry $w.origin.y -width 10 -validate key -vcmd { string is double %P }
178 label $w.origin.ztag -font $helv12 -text "oz"
179 entry $w.origin.z -width 10 -validate key -vcmd { string is double %P }
180 label $w.origin.angletag -font $helv12 -text "angle"
181 entry $w.origin.angle -width 10 -validate key -vcmd { string is double %P }
182 button $w.origin.find -text "Find origin" -relief raised \
183 -command { calcRadialAverage .wdif diffplot 1 }
184 pack $w.origin $w.origin.xtag $w.origin.x $w.origin.ytag \
185 $w.origin.y $w.origin.ztag $w.origin.z \
186 $w.origin.angletag $w.origin.angle \
187 $w.origin.find -side left -pady 4 -padx 4
188
189 frame $w.upd_mask
190 button $w.upd_mask.update -text "Update" -relief raised \
191 -command { calcRadialAverage .wdif diffplot 0 }
192 # label $w.upd_mask.mask_label -text "Mask"
193 checkbutton $w.upd_mask.mask_check -text "Mask" -variable use_mask
194 entry $w.upd_mask.mask_entry -width 50
195 button $w.upd_mask.mask_button -text "Browse ..." -relief raised \
196 -command {
197 set maskfile [tk_getOpenFile -filetypes $filetypes -parent $w]
198 $w.upd_mask.mask_entry delete 0 end
199 $w.upd_mask.mask_entry insert 0 $maskfile
200 }
201 pack $w.upd_mask.update $w.upd_mask.mask_check \
202 $w.upd_mask.mask_entry $w.upd_mask.mask_button -side left -pady 4 -padx 4
203
204 pack $w.origin $w.upd_mask -side bottom -fill x
205
206 set ori [Bimage get $theimg origin]
207 $w.origin.x insert 0 [lindex $ori 0]
208 $w.origin.y insert 0 [lindex $ori 1]
209 $w.origin.z insert 0 [lindex $ori 2]
210 $w.origin.angle insert 0 0
211
212 setupGraphVariables $w
213
214 calcRadialAverage $w diffplot 0
215 } else {
216 wm deiconify $w
217 raise $w
218 set g $w.plot
219 }
220 wm title $w "Diffraction"
221 wm iconname $w "Diffraction"
222 bind $c <1> "setDiffOrigin .wdif %x %y"
223 $g bind point <Any-Enter> { showPoint .wdif diffplot %x %y }
224 $g bind point <Any-Leave> { showPoint .wdif diffplot %x %y }
225 bind $g <Button-1> {
226 set x1 [.wdif.plot canvasx %x]
227 set y1 [.wdif.plot canvasy %y]
228 }
229 bind $g <B1-Motion> { drawRectangle .wdif.plot $x1 $y1 [.wdif.plot canvasx %x] [.wdif.plot canvasy %y] }
230 bind $g <B1-ButtonRelease> { drawSubGraph .wdif diffplot $x1 $y1 \
231 [.wdif.plot canvasx %x] [.wdif.plot canvasy %y] "line" "Frequency" "Intensity" }
232 bind $w <Control-r> { drawGraph .wdif diffplot "line" "Frequency" "Intensity" }
233 bind $w <Return> { plotGraph .wdif diffplot "line" "Frequency" "Intensity" }
234 bind $w <Control-w> {
235 if { [info exists diffplot] } { unset diffplot }
236 destroy .wdif
237 }
238 }
239
240 ## @brief Sets the origin from canvas coordinates
241 #
242 # @param w Plot window object.
243 # @param x
244 # @param y Position in canvas coordinates.
245
246 proc setDiffOrigin { w x y } {
247 global theimg
248 set c [getImageCanvas $theimg]
249 set wc [getControlWindow $theimg]
250 if ![winfo exists $w] {
251 $c delete center
252 return
253 }
254 set scale [$wc.scale.scale get]
255 set slice_num [$wc.slice.scale get]
256 set xr [expr [$c canvasx $x] / $scale]
257 set yr [yFlip [expr [$c canvasy $y] / $scale]]
258 updateOrigin $w $xr $yr $slice_num
259 }
260
261 ## @brief Updates the origin
262 #
263 # @param w Plot window object.
264 # @param x
265 # @param y
266 # @param z Origin.
267
268 proc updateOrigin { w x y z } {
269 global PI theimg
270 if ![winfo exists $w] {
271 $c delete center
272 return
273 }
274 set c [getImageCanvas $theimg]
275 set wc [getControlWindow $theimg]
276 $w.origin.x delete 0 end
277 $w.origin.x insert 0 $x
278 $w.origin.y delete 0 end
279 $w.origin.y insert 0 $y
280 $w.origin.z delete 0 end
281 $w.origin.z insert 0 $z
282 set a [expr [$w.origin.angle get] * $PI/180.0]
283 set scale [$wc.scale.scale get]
284 set height [Bimage get $theimg height]
285 set rad [expr 10*$scale]
286 set len [expr $height*$scale/4]
287 set cx [expr $x*$scale]
288 set cy [expr ($height - $y - 1)*$scale]
289 set cxmin [expr $cx - $rad]
290 set cxmax [expr $cx + $rad]
291 set cymin [expr $cy - $rad]
292 set cymax [expr $cy + $rad]
293 set ca [expr $len * cos($a)]
294 set sa [expr $len * sin($a)]
295 $c delete center
296 $c create oval $cxmin $cymin $cxmax $cymax -outline yellow -width 1 -tags center
297 $c create line $cx $cy [expr $cx + $ca] [expr $cy - $sa] -width 1 -fill red -tags center
298 $c create line $cx $cy [expr $cx - $sa] [expr $cy - $ca] -width 1 -fill blue -tags center
299 }
300
301 ## @brief Calculates the radial average of the first image
302 #
303 # @param w Plot window object.
304 # @param plotdata Array of data.
305 # @param findori Flag to find diffraction origin
306
307 proc calcRadialAverage { w plotdata findori } {
308 global PI theimg
309 global color
310 global use_mask
311 set c [getImageCanvas $theimg]
312 upvar $plotdata diffplot
313 set ox [$w.origin.x get]
314 set oy [$w.origin.y get]
315 set oz [$w.origin.z get]
316 set a [expr [$w.origin.angle get] * $PI/180.0]
317 set maskname [$w.upd_mask.mask_entry get]
318 if { $findori > 0 } {
319 if { $use_mask } {
320 Bimage diffori $theimg $ox $oy $oz $maskname
321 } else {
322 Bimage diffori $theimg $ox $oy $oz
323 }
324 set ori [Bimage get $theimg origin]
325 set ox [lindex $ori 0]
326 set oy [lindex $ori 1]
327 set oz [lindex $ori 2]
328 }
329 if { $use_mask } {
330 set raddiff [Bimage radial $theimg $ox $oy $oz $a $maskname]
331 } else {
332 set raddiff [Bimage radial $theimg $ox $oy $oz $a]
333 }
334 set n [expr [llength $raddiff] / 3]
335 set color { black red blue }
336 # puts $raddiff
337 # puts "Radial plot length = $n"
338 set ori [Bimage get $theimg origin]
339 updateOrigin $w [lindex $ori 0] [lindex $ori 1] [lindex $ori 2]
340 # set xscale 1.0
341 for { set i 0} { $i < $n } { incr i} {
342 # set diffplot(x,$i) [expr $i*$xscale + $xmin]
343 set diffplot(x,$i) $i
344 set diffplot(y,$i) [lindex $raddiff $i]
345 }
346 for { set j 1} { $j < 3 } { incr j} {
347 for { set i 0} { $i < $n } { incr i} {
348 append diffplot(y,$i) " " [lindex $raddiff [expr $j*$n + $i]]
349 }
350 }
351 # for { set i 0 } { $i < $n } { incr i } {
352 # puts "$i [lindex $raddiff $i] [lindex $raddiff [expr $n + $i]] [lindex $raddiff [expr 2*$n + $i]]"
353 # }
354 drawGraph $w diffplot "line" "Frequency" "Intensity"
355 }
356
357 ## @brief Sets up the point position and limits variables in the window
358 #
359 # @param w Window object.
360
361 proc setupGraphVariables { w } {
362 global helv12
363 frame $w.point -bg green
364 label $w.point.xtag -font $helv12 -text "x" -bg green
365 label $w.point.x -text "0" -relief sunken -bd 1 -width 10 \
366 -font $helv12 -anchor w
367 label $w.point.ytag -font $helv12 -text "y" -bg green
368 label $w.point.y -text "0" -relief sunken -bd 1 -width 10 \
369 -font $helv12 -anchor w
370 pack $w.point.xtag $w.point.x $w.point.ytag $w.point.y \
371 -side left -pady 10 -padx 6
372
373 frame $w.lim -bg cyan
374 label $w.lim.x_tag -font $helv12 -text "X limits" -bg cyan
375 entry $w.lim.x_min -width 8 -validate key -vcmd { string is double %P }
376 entry $w.lim.x_max -width 8 -validate key -vcmd { string is double %P }
377 label $w.lim.y_tag -font $helv12 -text "Y limits" -bg cyan
378 entry $w.lim.y_min -width 8 -validate key -vcmd { string is double %P }
379 entry $w.lim.y_max -width 8 -validate key -vcmd { string is double %P }
380 pack $w.lim.x_tag $w.lim.x_min $w.lim.x_max $w.lim.y_tag \
381 $w.lim.y_min $w.lim.y_max -side left -pady 6 -padx 6 -fill x
382
383 pack $w.point $w.lim -side left -fill x
384 }
385
386 ## @brief Plots the graph given specific limits.
387 #
388 # @param w Window object.
389 # @param plotdata Array of data.
390 # @param type type of graph (oval, bar, line)
391 # @param xlab
392 # @param ylab axis labels
393
394 proc plotGraph { w plotdata type xlab ylab } {
395 upvar $plotdata plot
396 global orix oriy width height
397 global helv12 helv14
398 global color
399 set gc $w.plot
400 # set color { blue green red yellow black SkyBlue2 }
401 # set color { red green blue yellow black SkyBlue2 }
402 $gc delete all
403 # Default type is oval
404 set typenum 0
405 if { [string first "bar" $type] > -1 } { set typenum 1}
406 if { [string first "line" $type] > -1 } { set typenum 2}
407 set number [expr int( [array size plot] / 2 )]
408 if { $number < 2 } { return}
409 set nsets [llength $plot(y,0)]
410 set xmin [$w.lim.x_min get]
411 set xmax [$w.lim.x_max get]
412 set ymin [$w.lim.y_min get]
413 set ymax [$w.lim.y_max get]
414 set xrange [expr $xmax - $xmin]
415 set yrange [expr $ymax - $ymin]
416 set xscale [expr $width * 1.0 / $xrange]
417 set yscale [expr $height * 1.0 / $yrange]
418 set bar_width [expr ($plot(x,1) - $plot(x,0))*$xscale/$nsets]
419 set bwh [expr $bar_width /2.0]
420 # puts "$orix $oriy $width $height"
421 # puts "$xmin $xmax $ymin $ymax $xrange $yrange $xscale $yscale"
422 # Plot the data
423 for { set j 0} { $j < $nsets } { incr j} {
424 set theline ""
425 set offset [expr $bar_width * ($j - ($nsets - 1)/2.0)]
426 for { set i 0} { $i < $number } { incr i} {
427 set vx $plot(x,$i)
428 if { $vx >= $xmin && $vx <= $xmax } {
429 set x [expr $orix + ($vx - $xmin)*$xscale]
430 set vy [lindex $plot(y,$i) $j]
431 if { $typenum == 1 } {
432 if { $vy > $ymax } { set vy $ymax}
433 }
434 set y [expr $oriy - ($vy - $ymin)*$yscale]
435 if { $typenum == 2 } {
436 append theline " " $x " " $y
437 } else { if { $vy >= $ymin && $vy <= $ymax } {
438 # puts "$x $y"
439 if { $typenum == 0 } {
440 set item [$gc create oval [expr $x-3] [expr $y-3] \
441 [expr $x+3] [expr $y+3] -width 1 -outline {} \
442 -fill [lindex $color $j]]
443 } else {
444 set x [expr $x + $offset]
445 set item [$gc create rectangle [expr $x-$bwh] $oriy \
446 [expr $x+$bwh] $y -width 1 -outline {} \
447 -fill [lindex $color $j]]
448 }
449 $gc addtag point withtag $item
450 }}
451 }
452 }
453 if { $typenum == 2 } {
454 $gc create line $theline -fill [lindex $color $j] -smooth yes -width 1 -tags point
455 }
456 # puts "Plotting line $j with color [lindex $color $j]"
457 }
458 # Get the axis orders for display
459 set ex 0
460 set e1 0
461 if { $xmax != 0 } { set ex [expr floor(log10(abs($xmax)))]}
462 if { $xmin != 0 } { set e1 [expr floor(log10(abs($xmin)))]}
463 if { abs($e1) > abs($ex) } { set ex $e1}
464 set xrange [expr $xrange / pow(10,$ex)]
465 set xmin [expr $xmin / pow(10,$ex)]
466 set ey 0
467 set e1 0
468 if { $ymax != 0 } { set ey [expr floor(log10(abs($ymax)))]}
469 if { $ymin != 0 } { set e1 [expr floor(log10(abs($ymin)))]}
470 if { abs($e1) > abs($ey) } { set ey $e1}
471 set yrange [expr $yrange / pow(10,$ey)]
472 set ymin [expr $ymin / pow(10,$ey)]
473 # Draw the axes and labels
474 $gc create line $orix $oriy [expr $orix + $width] $oriy -width 2
475 $gc create line $orix $oriy $orix [expr $oriy - $height] -width 2
476 for { set i 0} { $i <= 10 } { incr i} {
477 set x [expr $orix + $i*$width/10]
478 $gc create line $x $oriy $x [expr $oriy - 5] -width 1
479 set t [format "%6.3g" [expr $xrange*$i/10.0 + $xmin]]
480 $gc create text $x [expr $oriy + 4] -text $t -anchor n -font $helv12
481 }
482 set ex [expr int($ex)]
483 set ey [expr int($ey)]
484 set x [expr $orix + $width/2]
485 set y [expr $oriy + 40]
486 $gc create text $x $y -text $xlab -anchor e -font $helv14
487 $gc create text $x $y -text " (10 )" -anchor w -font $helv14
488 $gc create text [expr $x + 25] [expr $y - 5] -text "$ex" -anchor w -font $helv12
489 for { set i 0} { $i <= 10 } { incr i} {
490 set y [expr $oriy - $i*$height/10]
491 $gc create line $orix $y [expr $orix + 5] $y -width 1
492 set t [format "%6.3g" [expr $yrange*$i/10.0 + $ymin]]
493 $gc create text [expr $orix - 4] $y -text $t -anchor e -font $helv12
494 }
495 set x [expr $orix - 70]
496 set y [expr $oriy - $height/2]
497 $gc create text $x $y -text $ylab -anchor c -font $helv12
498 $gc create text $x [expr $y + 20] -text "(10 )" -anchor c -font $helv14
499 $gc create text [expr $x + 5] [expr $y + 15] -text "$ey" -anchor w -font $helv12
500 }
501
502 ## @brief Gets the limits from the input data.
503 #
504 # @param w Window object.
505 # @param plotdata Array of data.
506
507 proc getLimits { w plotdata } {
508 upvar $plotdata plot
509 # puts "$plot(x,0) $plot(y,0)"
510 set number [expr int( [array size plot] / 2 )]
511 if { $number < 2 } { return}
512 set xmin $plot(x,0)
513 set xmax $plot(x,0)
514 set ymin [lindex $plot(y,0) 0]
515 set ymax [lindex $plot(y,0) 0]
516 for { set i 0} { $i < $number } { incr i} {
517 if { $xmin > $plot(x,$i) } { set xmin $plot(x,$i)}
518 if { $xmax < $plot(x,$i) } { set xmax $plot(x,$i)}
519 for { set j 0} { $j < [llength $plot(y,$i)] } { incr j} {
520 if { $ymin > [lindex $plot(y,$i) $j] } { set ymin [lindex $plot(y,$i) $j]}
521 if { $ymax < [lindex $plot(y,$i) $j] } { set ymax [lindex $plot(y,$i) $j]}
522 }
523 }
524 if { $xmin == $xmax } { set xmax [expr $xmin + 1]}
525 if { $ymin == $ymax } { set ymax [expr $ymin + 1]}
526 updateLimits $w $xmin $xmax $ymin $ymax
527 }
528
529 ## @brief Updates the entry boxes for the plot limits.
530 #
531 # @param w Window object.
532 # @param xmin
533 # @param xmax x range.
534 # @param ymin
535 # @param ymax y range.
536
537 proc updateLimits { w xmin xmax ymin ymax } {
538 $w.lim.x_min delete 0 end
539 $w.lim.x_min insert 0 $xmin
540 $w.lim.x_max delete 0 end
541 $w.lim.x_max insert 0 $xmax
542 $w.lim.y_min delete 0 end
543 $w.lim.y_min insert 0 $ymin
544 $w.lim.y_max delete 0 end
545 $w.lim.y_max insert 0 $ymax
546 }
547
548 ## @brief Draws the graph when new data is read in.
549 #
550 # @param w Window object.
551 # @param plotdata Array of data.
552 # @param type Plot type.
553 # @param xlab
554 # @param ylab axis labels
555
556 proc drawGraph { w plotdata type xlab ylab } {
557 upvar $plotdata plot
558 getLimits $w plot
559 plotGraph $w plot $type $xlab $ylab
560 }
561
562 ## @brief Draws the graph when new data is read in.
563 #
564 # @param w Window object.
565 # @param plotdata Array of data.
566 # @param x1
567 # @param y1
568 # @param x2
569 # @param y2 Canvas coordinates of selected region
570 # @param type Plot type.
571 # @param xlab
572 # @param ylab axis labels
573
574 proc drawSubGraph { w plotdata x1 y1 x2 y2 type xlab ylab } {
575 upvar $plotdata plot
576 global orix oriy width height
577 if { $x1 == $x2 } { return}
578 if { $y1 == $y2 } { return}
579 if { $x2 < $x1 } {
580 set t $x1
581 set x1 $x2
582 set x2 $t
583 }
584 if { $y2 > $y1 } { # The y-scale is upside down
585 set t $y1
586 set y1 $y2
587 set y2 $t
588 }
589 set xmin [$w.lim.x_min get]
590 set xmax [$w.lim.x_max get]
591 set ymin [$w.lim.y_min get]
592 set ymax [$w.lim.y_max get]
593 # if { $y1 > $oriy } { set y1 $oriy }
594 set xrange [expr ($xmax - $xmin) * 1.0 / $width]
595 set yrange [expr ($ymax - $ymin) * 1.0 / $height]
596 set xmax [expr $xmin + ($x2 - $orix) * $xrange]
597 set xmin [expr $xmin + ($x1 - $orix) * $xrange]
598 set ymax [expr $ymin + ($oriy - $y2) * $yrange]
599 set ymin [expr $ymin + ($oriy - $y1) * $yrange]
600 if { $ymin < 0 } { set ymin 0}
601 updateLimits $w $xmin $xmax $ymin $ymax
602 plotGraph $w plot $type $xlab $ylab
603 }
604
605 ## @brief Gets the limits from the input data.
606 #
607 # @param w Window object.
608 # @param plotdata Array of data.
609 # @param x
610 # @param y Point coordinates in the window.
611
612 proc showPoint { w plotdata x y } {
613 upvar $plotdata plot
614 global orix oriy width height
615 set number [expr int( [array size plot] / 2 )]
616 if { $number < 2 } { return}
617 set xmin [$w.lim.x_min get]
618 set xmax [$w.lim.x_max get]
619 set ymin [$w.lim.y_min get]
620 set ymax [$w.lim.y_max get]
621 set x [expr ($x - $orix)*($xmax - $xmin)/$width + $xmin]
622 set y [expr ($oriy - $y)*($ymax - $ymin)/$height + $ymin]
623 set dxmin 1e30
624 for { set i 0} { $i < $number } { incr i} {
625 set dx [expr abs($plot(x,$i) - $x)]
626 if { $dxmin > $dx } {
627 set dxmin $dx
628 set vx $plot(x,$i)
629 set dymin 1e30
630 for { set j 0} { $j < [llength $plot(y,$i)] } { incr j} {
631 set dy [expr abs([lindex $plot(y,$i) $j] - $y)]
632 if { $dymin > $dy } {
633 set dymin $dy
634 set vy [lindex $plot(y,$i) $j]
635 }
636 }
637 }
638 }
639 # puts "$vx $vy"
640 $w.point.x config -text "$vx"
641 $w.point.y config -text "$vy"
642 }
643
644 ## @brief Draws a rectangle on the canvas.
645 #
646 # @param c Canvas object.
647 # @param x1
648 # @param y1
649 # @param x2
650 # @param y2 Canvas coordinates of rectangle.
651
652 proc drawRectangle { c x1 y1 x2 y2 } {
653 $c delete rect
654 $c create rectangle $x1 $y1 $x2 $y2 -tags rect -outline red
655 }
656
657 ## @brief Writes the plot data to a text file.
658 #
659 # @param plotdata Array of data.
660
661 proc writePlotData { plotdata } {
662 upvar $plotdata plot
663 set datafile [tk_getSaveFile -defaultextension .txt]
664 if { [string length $datafile] < 1 } { return}
665 set fd [open $datafile w]
666 set number [expr int( [array size plot] / 2 )]
667 for { set i 0} { $i < $number } { incr i} {
668 puts $fd "$plot(x,$i) $plot(y,$i)"
669 }
670 }