| Bsoft 2.0.5 Bernard's software package

bshow_scales.tcl
Go to the documentation of this file.
1 ##
2 # @file bshow_scales.tcl
3 #
4 # @brief Procedures to manage scales for image display
5 #
6 # @author Bernard Heymann
7 # @date Created: 20010516
8 # @date Modified: 20130820
9
10 set window_scale 1.0
11 set std_scale 5.0
12
13 ## @brief Configures scales for the image window
14 #
15 # These scales are used as stores for the slice and image numbers
16 # as well as the scaling of the image itself
17 #
18 # @param w Control window to put scales in.
19
20 proc setupScales { w } {
21 global helv12 window_scale std_scale aniproc
22
23 frame $w.image
24 label $w.image.label -font $helv12 -text "Image" -width 6 -anchor w
25 scale $w.image.scale -orient horizontal -from 0 -to 0 \
26 -command { setImage }
27 pack $w.image.label -side left
28 pack $w.image.scale -side bottom -fill x
29 $w.image.scale set 0
30
31 frame $w.slice
32 label $w.slice.label -font $helv12 -text "Slice" -width 6 -anchor w
33 scale $w.slice.scale -orient horizontal -from 0 -to 0 \
34 -command { setSlice }
35 pack $w.slice.label -side left
36 pack $w.slice.scale -side bottom -fill x
37 $w.slice.scale set 0
38
39 frame $w.scale
40 label $w.scale.label -font $helv12 -text "Scale" -width 6 -anchor w
41 pack $w.scale.label -side left -pady 2
42 scale $w.scale.scale -orient horizontal -from 0.1 -to 10 \
43 -command { setScale } -resolution 0.1
44 pack $w.scale.label -side left
45 pack $w.scale.scale -side bottom -fill x
46 $w.scale.scale set $window_scale
47
48 frame $w.min
49 label $w.min.label -font $helv12 -text "Min" -width 6 -anchor w
50 scale $w.min.scale -orient horizontal -from 0 -to 0 \
51 -command { setMin }
52 pack $w.min.label -side left
53 pack $w.min.scale -side bottom -fill x
54
55 frame $w.max
56 label $w.max.label -font $helv12 -text "Max" -width 6 -anchor w
57 scale $w.max.scale -orient horizontal -from 0 -to 0 \
58 -command { setMax }
59 pack $w.max.label -side left
60 pack $w.max.scale -side bottom -fill x
61
62 setupEntry $w.step "Range step" double 0.01 "Step size for minimum and maximum scales"
63 bind $w.step.e <Return> reconfigureScales
64
65 frame $w.as
66 checkbutton $w.as.autoscale -text "Autoscale" -command { autoScale }
67 checkbutton $w.as.imageonly -text "Image only" -command { autoScale }
68 entry $w.as.scale -width 6 -validate key -vcmd { string is double %P }
69 $w.as.scale insert 0 $std_scale
70 pack $w.as.autoscale $w.as.scale $w.as.imageonly -side left -pady 2 -padx 2 -anchor w
71
72 frame $w.ani
73 button $w.ani.animate_button -text Animate \
74 -relief raised -command do_animate_slices
75 label $w.ani.animate_tag -font $helv12 -text "Speed"
76 entry $w.ani.animate -width 6 -validate key -vcmd { string is int %P }
77 $w.ani.animate insert 0 15
78 bind $w.ani.animate <Return> do_animate_slices
79 pack $w.ani.animate_button $w.ani.animate_tag $w.ani.animate -side left -pady 2 -padx 2 -anchor w
80 set aniproc 0
81
82 bind . <Left> { .slice.scale set [expr [.slice.scale get] - 1] }
83 bind . <Right> { .slice.scale set [expr [.slice.scale get] + 1] }
84 bind . <Up> { .image.scale set [expr [.image.scale get] + 1] }
85 bind . <Down> { .image.scale set [expr [.image.scale get] - 1] }
86 bind $w.as.scale <Return> { autoScale }
87 }
88
89 ## @brief Resets the scales when the image changes
90
91 proc reconfigureScales { } {
92 global theimg
93 global window_scale montover
94 if ![Bimage exists $theimg] { return}
95 set c [getImageCanvas $theimg]
96 set wc [getControlWindow $theimg]
97 if { [info exists montover(active)] && $montover(active) } {
98 set width [expr $montover(ncol) * ($montover(nx) + 2*$montover(pad))]
99 set height [expr $montover(nrow) * ($montover(ny) + 2*$montover(pad))]
100 set nimages 1
101 set nslices 1
102 } else {
103 set width [Bimage get $theimg width]
104 set height [Bimage get $theimg height]
105 set nimages [Bimage get $theimg nimages]
106 set nslices [Bimage get $theimg nslices]
107 }
108 set width [expr $width * $window_scale]
109 set height [expr $height * $window_scale]
110 $wc.image.scale config -to [expr $nimages - 1] -tickinterval [expr $nimages - 1]
111 $wc.slice.scale config -to [expr $nslices - 1] -tickinterval [expr $nslices - 1]
112 reconfigureMinMax
113 set size "0 0 $width $height"
114 $c configure -scrollregion $size
115 }
116
117 ## @brief Resets the min and max scales when the range step size changes
118
119 proc reconfigureMinMax { } {
120 global theimg autoscale
121 set wc [getControlWindow $theimg]
122 set range_step [$wc.step.e get]
123 set min [Bimage get $theimg min]
124 set max [Bimage get $theimg max]
125 Bimage set $theimg show_min $min
126 Bimage set $theimg show_max $max
127 $wc.min.scale config -from $min -to $max -resolution $range_step
128 $wc.max.scale config -from $min -to $max -resolution $range_step
129 if $autoscale {
130 autoScale
131 } else {
132 $wc.min.scale set $min
133 $wc.max.scale set $max
134 }
135 }
136
137 ## @brief Resets the range step size to the default value
138
139 proc reconfigureRangeStep { } {
140 global theimg imgtype
141 if ![Bimage exists $theimg] { return}
142 set wc [getControlWindow $theimg]
143 set min [Bimage get $theimg min]
144 set max [Bimage get $theimg max]
145 set step 1000
146 if { $imgtype == "ps" || $imgtype == "ft" } {
147 set step 10000
148 }
149 set range_step [expr ($max - $min) / $step]
150 $wc.step.e delete 0 end
151 $wc.step.e insert 0 $range_step
152 }
153
154 ## @brief A dialog to type in a scale factor and new min and max values.
155 #
156
157 proc setScaleDialog { } {
158 global helv12
159 set wd .scaleDialog
160 catch {destroy $wd}
161 toplevel $wd
162 wm title $wd "Set display parameters"
163 wm iconname $wd "Set display"
164
165 frame $wd.panel
166 pack $wd.panel -side top -fill both
167
168 frame $wd.panel.image
169 label $wd.panel.image.tag -text "Image" -width 6
170 entry $wd.panel.image.entry -width 10 -validate key -vcmd { string is integer %P }
171 $wd.panel.image.entry insert 0 [.image.scale get]
172 pack $wd.panel.image.tag $wd.panel.image.entry \
173 -side left -fill both -expand true
174
175 frame $wd.panel.slice
176 label $wd.panel.slice.tag -text "Slice" -width 6
177 entry $wd.panel.slice.entry -width 10 -validate key -vcmd { string is integer %P }
178 $wd.panel.slice.entry insert 0 [.slice.scale get]
179 pack $wd.panel.slice.tag $wd.panel.slice.entry \
180 -side left -fill both -expand true
181
182 frame $wd.panel.scale
183 label $wd.panel.scale.tag -text "Scale" -width 6
184 entry $wd.panel.scale.entry -width 10 -validate key -vcmd { string is double %P }
185 $wd.panel.scale.entry insert 0 [.scale.scale get]
186 pack $wd.panel.scale.tag $wd.panel.scale.entry \
187 -side left -fill both -expand true
188
189 frame $wd.panel.min
190 label $wd.panel.min.tag -text "Min" -width 6
191 entry $wd.panel.min.entry -width 10 -validate key -vcmd { string is double %P }
192 $wd.panel.min.entry insert 0 [.min.scale get]
193 pack $wd.panel.min.tag $wd.panel.min.entry \
194 -side left -fill both -expand true
195
196 frame $wd.panel.max
197 label $wd.panel.max.tag -text "Max" -width 6
198 entry $wd.panel.max.entry -width 10 -validate key -vcmd { string is double %P }
199 $wd.panel.max.entry insert 0 [.max.scale get]
200 pack $wd.panel.max.tag $wd.panel.max.entry \
201 -side left -fill both -expand true
202
203 pack $wd.panel.image $wd.panel.slice $wd.panel.scale $wd.panel.min $wd.panel.max -side top -padx 5 -pady 5
204
205 frame $wd.buttons
206 pack $wd.buttons -side bottom -fill x -pady 2m
207 button $wd.buttons.ok -text OK -command "setScaleOK $wd"
208 button $wd.buttons.cancel -text Cancel -command "destroy $wd"
209 pack $wd.buttons.ok $wd.buttons.cancel -side left -expand 1
210
211 bind $wd <Return> "setScaleOK $wd"
212 }
213
214 ## @brief Sets the scales given in the dialog.
215 #
216 # @param wd Dialog window.
217
218 proc setScaleOK { wd } {
219 global theimg
220 set wc [getControlWindow $theimg]
221 set n [$wd.panel.image.entry get]
222 set z [$wd.panel.slice.entry get]
223 set scale [$wd.panel.scale.entry get]
224 set min [$wd.panel.min.entry get]
225 set max [$wd.panel.max.entry get]
226 destroy $wd
227 $wc.image.scale set $n
228 $wc.slice.scale set $z
229 $wc.scale.scale set $scale
230 $wc.min.scale set $min
231 $wc.max.scale set $max
232 }
233
234 ## @brief Sets the scale for display.
235 #
236 # @param scale Display scale stored in the scale scale
237
238 proc setScale { scale } {
239 global theimg
240 global window_width window_height window_scale
241 global img_load_phase montover
242 # if { $window_scale == $scale } { return }
243 set window_scale $scale
244 if ![Bimage exists theimg] { return}
245 set c [getImageCanvas $theimg]
246 if { [info exists montover(active)] && $montover(active) } {
247 set width [expr $montover(ncol) * ($montover(nx) + 2*$montover(pad))]
248 set height [expr $montover(nrow) * ($montover(ny) + 2*$montover(pad))]
249 } else {
250 set width [Bimage get $theimg width]
251 set height [Bimage get $theimg height]
252 }
253 set width [expr $width * $window_scale]
254 set height [expr $height * $window_scale]
255 set size "0 0 $width $height"
256 # $c configure -scrollregion $size
257 $c configure -width $window_width -height $window_height -scrollregion $size
258 # puts "set scale to $scale"
259 if { !$img_load_phase } { Update 1}
260 }
261
262 ## @brief Loads the requested slice in the current file into a photo image for display.
263 #
264 # @param slice_num Current slice number stored in the slice scale
265
266 proc setSlice { slice_num } {
267 global theimg img_load_phase
268 if ![Bimage exists $theimg] { return}
269 set wc [getControlWindow $theimg]
270 set nslices [Bimage get $theimg nslices]
271 # set img_num [$wc.image.scale get]
272 if { $nslices < 1 } { return}
273 # if { $img_num < 0 } { set img_num 0 }
274 if { $slice_num >= $nslices } { set slice_num 0}
275 if { [winfo exists .wmag] } {
276 .wmag.q.slice set [$wc.slice.scale get]
277 }
278 # puts "set slice to $slice_num"
279 if { !$img_load_phase } { Update 1}
280 }
281
282 ## @brief Loads the requested image in the current file into a photo image for display.
283 #
284 # @param img_num Current image number stored in the image scale
285
286 proc setImage { img_num } {
287 global theimg img_load_phase imageonly
288 if ![Bimage exists theimg] { return}
289 set nimages [Bimage get $theimg nimages]
290 if { $nimages < 1 } { return}
291 if { $img_num < 0 } { set img_num 0}
292 if { $img_num >= $nimages } { set img_num 0}
293 # if $imageonly { reconfigureMinMax }
294 if $imageonly { autoScale}
295 # puts "set image to $img_num"
296 if { !$img_load_phase } { Update 1}
297 }
298
299 ## @brief Sets the minimum display value.
300 #
301 # @param smin New display minimum.
302
303 proc setMin { smin } {
304 global theimg mode
305 global img_load_phase autoscale
306 if ![Bimage exists $theimg] { return}
307 set wc [getControlWindow $theimg]
308 set step [$wc.step.e get]
309 if { [expr 2*abs([Bimage get $theimg show_min] - $smin)] < $step } { return}
310 if { [$wc.min.scale cget -from] || [$wc.min.scale cget -to] } {
311 set autoscale 0
312 set scale [$wc.scale.scale get]
313 set slice_num [$wc.slice.scale get]
314 set img_num [$wc.image.scale get]
315 # puts "set show_min to $smin"
316 Bimage set $theimg show_min $smin
317 if { !$img_load_phase } {
318 Bimage show $theimg $img_num $slice_num $scale $mode
319 }
320 }
321 }
322
323 ## @brief Sets the maximum display value.
324 #
325 # @param smax New display maximum.
326
327 proc setMax { smax } {
328 global theimg mode
329 global img_load_phase autoscale
330 if ![Bimage exists $theimg] { return}
331 set wc [getControlWindow $theimg]
332 set step [$wc.step.e get]
333 if { [expr 2*abs([Bimage get $theimg show_max] - $smax)] < $step } { return}
334 if { [$wc.max.scale cget -from] || [$wc.max.scale cget -to] } {
335 set autoscale 0
336 set scale [$wc.scale.scale get]
337 set slice_num [$wc.slice.scale get]
338 set img_num [$wc.image.scale get]
339 # puts "set show_max to $smax"
340 Bimage set $theimg show_max $smax
341 if { !$img_load_phase } {
342 Bimage show $theimg $img_num $slice_num $scale $mode
343 }
344 }
345 }
346
347 ## @brief Sets reasonable minimum and maximum display values.
348 #
349
350 proc autoScale {} {
351 global theimg autoscale std_scale imageonly
352 if ![Bimage exists $theimg] { return}
353 set wc [getControlWindow $theimg]
354
355 # set autoscale [expr 1 - $autoscale]
356
357 if $imageonly {
358 set img_num [$wc.image.scale get]
359 set min [Bimage get $theimg min $img_num]
360 set max [Bimage get $theimg max $img_num]
361 set avg [Bimage get $theimg average $img_num]
362 set std [Bimage get $theimg standard_deviation $img_num]
363 } else {
364 set min [Bimage get $theimg min]
365 set max [Bimage get $theimg max]
366 set avg [Bimage get $theimg average]
367 set std [Bimage get $theimg standard_deviation]
368 }
369
370 set std_scale [$wc.as.scale get]
371
372 set smin [expr $avg - $std_scale*$std]
373 set smax [expr $avg + $std_scale*$std]
374 if { $smin >= $smax } {
375 set smin [expr $avg - 1]
376 set smax [expr $avg + 1]
377 }
378 if { $smin < $min } {
379 set smin $min
380 }
381 if { $smax > $max } {
382 set smax $max
383 }
384
385 $wc.min.scale set $smin
386 $wc.max.scale set $smax
387
388 update
389
390 set autoscale 1
391
392 # puts "autoscale = $autoscale"
393 }
394
395 ## @brief Switches the minimum and maximum display values.
396 #
397
398 proc invertContrast {} {
399 global theimg
400 if ![Bimage exists $theimg] { return}
401 set wc [getControlWindow $theimg]
402 set smin [Bimage get $theimg show_min]
403 set smax [Bimage get $theimg show_max]
404 $wc.min.scale set $smax
405 $wc.max.scale set $smin
406 }
407
408 ## @brief Pages through slices.
409 #
410
411 proc do_animate_slices {} {
412 global theimg aniproc
413 set wc [getControlWindow $theimg]
414 if { [Bimage get $theimg nimages] > [Bimage get $theimg nslices] } {
415 set scale_to_move images
416 } else {
417 set scale_to_move slices
418 }
419 if { [$wc.ani.animate get] == "" || [$wc.ani.animate get] == "0" } {
420 $wc.ani.animate delete 0 end
421 $wc.ani.animate insert 0 15
422 }
423 if { [$wc.ani.animate get] > 200 } {
424 $wc.ani.animate delete 0 end
425 $wc.ani.animate insert 0 200
426 }
427 if { $aniproc == 0} {
428 $wc.ani.animate_button configure -text "Stop"
429 set aniproc 1
430 $wc.ani.animate configure -state disabled
431 } else {
432 $wc.ani.animate_button configure -text "Animate"
433 set aniproc 0
434 $wc.ani.animate configure -state normal
435 }
436 if { $scale_to_move == "slices" } {
437 set nslices1 [expr [Bimage get $theimg nslices] - 1]
438 set slice [$wc.slice.scale get]
439 set dir 1
440 while { $aniproc } {
441 after [expr 1000 / [$wc.ani.animate get]]
442 if { $slice <= 0 } { set dir 1}
443 if { $slice >= $nslices1 } { set dir -1}
444 set slice [expr $slice + $dir]
445 $wc.slice.scale set $slice
446 update
447 }
448 } elseif { $scale_to_move == "images" } {
449 set nimages1 [expr [Bimage get $theimg nimages] - 1]
450 set currimage [$wc.image.scale get]
451 set dir 1
452 while { $aniproc } {
453 after [expr 1000 / [$wc.ani.animate get]]
454 if { $currimage <= 0 } { set dir 1}
455 if { $currimage >= $nimages1 } { set dir -1}
456 set currimage [expr $currimage + $dir]
457 $wc.image.scale set $currimage
458 update
459 }
460 }
461 }
462