| Bsoft 2.0.5 Bernard's software package

bshow_misc.tcl
Go to the documentation of this file.
1 ##
2 # @file bshow_misc.tcl
3 #
4 # @brief Miscellaneous procedures for Bshow and other scripts.
5 #
6 # @author Bernard Heymann
7 # @date Created: 20010516
8 # @date Modified: 20190711
9
10
11 set PI 3.141592654
12 set HPI [expr $PI/2]
13
14 set px 1
15 set py 1
16 set mx 1
17 set my 1
18 set sx1 0
19 set sx2 0
20 set sy1 0
21 set sy2 0
22 set sz1 0
23 set sz2 0
24
25 set textfile ""
26 set cursorName "crosshair"
27
28 set rem_scale 1
29 set ori_color "blue"
30 set box_color "yellow"
31 set box_select_color "green"
32 set bad_color "red"
33 set bad_select_color "purple"
34 set filament_color "yellow"
35 set filament_first_color "blue"
36 set filament_select_color "green"
37 set spot_color "yellow"
38 set spot_select_color "green"
39 set ll_color "yellow"
40 set ll_select_color "green"
41 set marker_color "yellow"
42 set marker2_color "red"
43 set marker_select_color "green"
44 set error_color "orange"
45 set error_select_color "blue"
46
47 proc getControlWindow { theimg } {
48 set wc ".wcontrol"
49 if [string equal "theimg" $theimg] {
50 set wc ""
51 }
52 return $wc
53 }
54
55 proc getImageCanvas { theimg } {
56 set c ""
57 if { [string length $theimg] < 1 } {
58 puts "Error: image not selected!"
59 return $c
60 }
61 set c ".w$theimg"
62 if [string equal "theimg" $theimg] {
63 set c ""
64 }
65 append c ".frame.c"
66 return $c
67 }
68
69 ## @brief Creates the right-side controls for image display
70 #
71 # @param w Control window.
72
73 proc setupControls { w } {
74 global theimg helv12
75
76 frame $w.img
77 label $w.img.tag -text "Image type"
78 tk_optionMenu $w.img.menu imgtype "" "mg" "frame" "part" "fil" "rec" "ft" "ps" "mod"
79 $w.img.menu configure -width 10
80 # trace add variable imgbigtype write imageType
81
82 frame $w.mode
83 checkbutton $w.mode.avg -text "Averaging mode" -variable mode \
84 -command { Update 1 }
85 button $w.mode.invert -text "Invert" -command { invertContrast }
86
87 frame $w.pixel
88 label $w.pixel.xtag -font $helv12 -text "x"
89 label $w.pixel.x -text "0" -relief sunken -bd 1 -width 6 \
90 -font $helv12 -anchor w
91 label $w.pixel.ytag -font $helv12 -text "y"
92 label $w.pixel.y -text "0" -relief sunken -bd 1 -width 6 \
93 -font $helv12 -anchor w
94 label $w.pixel.vtag -font $helv12 -text "value"
95 label $w.pixel.value -text "0" -relief sunken -bd 1 -width 20 \
96 -font $helv12 -anchor w
97
98 frame $w.pixel_size
99 label $w.pixel_size.tag -font $helv12 -text "Pixel size"
100 entry $w.pixel_size.entry -width 16 -validate key -vcmd { string is double %P }
101 $w.pixel_size.entry insert 0 1
102 label $w.pixel_size.unit -text "A/pixel" -width 10 -font $helv12 -anchor w
103 bind $w.pixel_size.entry <Return> { setPixelsize $theimg }
104
105 frame $w.origin
106 label $w.origin.tag -font $helv12 -text "Origin"
107 label $w.origin.x -text "0" -relief sunken -bd 1 -width 6 \
108 -font $helv12 -anchor w
109 label $w.origin.y -text "0" -relief sunken -bd 1 -width 6 \
110 -font $helv12 -anchor w
111 label $w.origin.z -text "0" -relief sunken -bd 1 -width 6 \
112 -font $helv12 -anchor w
113 checkbutton $w.origin.show -text "Show" -variable show_origin -command { drawOrigin }
114 $w.origin.show toggle
115
116 frame $w.distance
117 label $w.distance.tag -font $helv12 -text "Distance" -width 10
118 label $w.distance.value -text "" -relief sunken -bd 1 -width 16 \
119 -font $helv12 -anchor w
120 label $w.distance.unit -text "A" -width 3 -font $helv12 -anchor w
121
122 setupScales $w
123
124 pack $w.img $w.mode -side top -pady 2
125 pack $w.img.tag $w.img.menu -side left -pady 2 -anchor w
126 pack $w.mode.avg $w.mode.invert -side left -pady 2 -anchor w
127
128 pack $w.pixel.xtag $w.pixel.x $w.pixel.ytag $w.pixel.y $w.pixel.vtag \
129 $w.pixel.value -side left -pady 10 -padx 2
130
131 pack $w.pixel_size.tag $w.pixel_size.entry $w.pixel_size.unit -side left -pady 10
132 pack $w.origin.tag $w.origin.x $w.origin.y $w.origin.z $w.origin.show -side left -pady 10 -padx 2
133 pack $w.distance.tag $w.distance.value $w.distance.unit -side left -pady 10
134
135 pack $w.pixel $w.pixel_size $w.origin $w.distance $w.image $w.slice $w.scale \
136 $w.min $w.max $w.step $w.as $w.ani -side top -fill x -pady 2
137 }
138
139 ## @brief Flips the display y axis.
140 #
141 # @param y Canvas y value.
142
143 proc yFlip { y } {
144 global theimg
145 set h [Bimage get $theimg height]
146 return [expr $h - $y - 1]
147 }
148
149 ## @brief Returns the image coordinates given canvas coordinates.
150 #
151 # @param x
152 # @param y Canvas coordinates.
153
154 proc imageCoordinatesFromCanvas { x y } {
155 global theimg
156 global px py
157 set c [getImageCanvas $theimg]
158 set wc [getControlWindow $theimg]
159 set scale [$wc.scale.scale get]
160 set z [$wc.slice.scale get]
161 set px [expr floor( [$c canvasx $x] / $scale )]
162 set py [expr floor( [$c canvasy $y] / $scale )]
163 set pyi [yFlip $py]
164 return "$px $pyi $z"
165 }
166
167 ## @brief Selects a color.
168 #
169 # @param w parent window
170
171 proc selectColor { w } {
172 global selected_color
173 set initialColor $selected_color
174 set color [tk_chooseColor -title "Choose a color" -parent $w \
175 -initialcolor $selected_color]
176 if { [string compare $color ""] } {
177 set selected_color $color
178 $w configure -background $color
179 }
180 Update 0
181 return $selected_color
182 }
183
184 if {[tk windowingsystem] eq "aqua"} {
185 proc ::tk::mac::ShowPreferences { } { setPreferences}
186 }
187
188 proc setPreferences { } {
189 global helv12 rem_scale avg_check kernel
190 global ori_color
191 global box_color box_select_color bad_color bad_select_color
192 global filament_color filament_first_color filament_select_color
193 global ll_color ll_select_color
194 global spot_color spot_select_color
195 global marker_color marker_select_color error_color error_select_color
196
197 set w .wprf
198
199 if ![winfo exists .wprf] {
200 toplevel $w
201
202 checkbutton $w.rem_scale -text "Remember scale" -variable rem_scale
203
204 setupCheckEntry $w.avg "Kernel" list kernel avg_check "The size of the filter kernel"
205
206 labelframe $w.col -text "Colors"
207 label $w.col.lbl -text "Draw Select First" -anchor e
208
209 frame $w.col.origins
210 label $w.col.origins.label -text "Origins" -width 15 -anchor e
211 canvas $w.col.origins.well -width 30 -height 30 -relief sunken \
212 -borderwidth 2 -background $ori_color
213
214 frame $w.col.box
215 label $w.col.box.label -text "Boxes" -width 15 -anchor e
216 canvas $w.col.box.well -width 30 -height 30 -relief sunken \
217 -borderwidth 2 -background $box_color
218 canvas $w.col.box.well2 -width 30 -height 30 -relief sunken \
219 -borderwidth 2 -background $box_select_color
220
221 frame $w.col.bad
222 label $w.col.bad.label -text "Bad areas" -width 15 -anchor e
223 canvas $w.col.bad.well -width 30 -height 30 -relief sunken \
224 -borderwidth 2 -background $bad_color
225 canvas $w.col.bad.well2 -width 30 -height 30 -relief sunken \
226 -borderwidth 2 -background $bad_select_color
227
228 frame $w.col.filament
229 label $w.col.filament.label -text "Filaments" -width 15 -anchor e
230 canvas $w.col.filament.well -width 30 -height 30 -relief sunken \
231 -borderwidth 2 -background $filament_color
232 canvas $w.col.filament.well2 -width 30 -height 30 -relief sunken \
233 -borderwidth 2 -background $filament_select_color
234 canvas $w.col.filament.well3 -width 30 -height 30 -relief sunken \
235 -borderwidth 2 -background $filament_first_color
236
237 frame $w.col.spot
238 label $w.col.spot.label -text "Diffraction spots" -width 15 -anchor e
239 canvas $w.col.spot.well -width 30 -height 30 -relief sunken \
240 -borderwidth 2 -background $spot_color
241 canvas $w.col.spot.well2 -width 30 -height 30 -relief sunken \
242 -borderwidth 2 -background $spot_select_color
243
244 frame $w.col.ll
245 label $w.col.ll.label -text "Layer lines" -width 15 -anchor e
246 canvas $w.col.ll.well -width 30 -height 30 -relief sunken \
247 -borderwidth 2 -background $ll_color
248 canvas $w.col.ll.well2 -width 30 -height 30 -relief sunken \
249 -borderwidth 2 -background $ll_select_color
250
251 frame $w.col.marker
252 label $w.col.marker.label -text "Markers" -width 15 -anchor e
253 canvas $w.col.marker.well -width 30 -height 30 -relief sunken \
254 -borderwidth 2 -background $marker_color
255 canvas $w.col.marker.well2 -width 30 -height 30 -relief sunken \
256 -borderwidth 2 -background $marker_select_color
257
258 frame $w.col.error
259 label $w.col.error.label -text "Marker errors" -width 15 -anchor e
260 canvas $w.col.error.well -width 30 -height 30 -relief sunken \
261 -borderwidth 2 -background $error_color
262 canvas $w.col.error.well2 -width 30 -height 30 -relief sunken \
263 -borderwidth 2 -background $error_select_color
264
265 button $w.update -text "Update" -relief raised -command { Update 0 }
266
267 pack $w.col.origins.label $w.col.origins.well -side left
268 pack $w.col.box.label $w.col.box.well $w.col.box.well2 -side left
269 pack $w.col.bad.label $w.col.bad.well $w.col.bad.well2 -side left
270 pack $w.col.filament.label $w.col.filament.well $w.col.filament.well2 \
271 $w.col.filament.well3 -side left
272 pack $w.col.spot.label $w.col.spot.well $w.col.spot.well2 -side left
273 pack $w.col.ll.label $w.col.ll.well $w.col.ll.well2 -side left
274 pack $w.col.marker.label $w.col.marker.well $w.col.marker.well2 -side left
275 pack $w.col.error.label $w.col.error.well $w.col.error.well2 -side left
276 pack $w.col.lbl $w.col.origins $w.col.box $w.col.bad $w.col.filament \
277 $w.col.spot $w.col.ll $w.col.marker $w.col.error -side top -fill x -padx 5
278 pack $w.rem_scale $w.avg $w.col $w.update -side top -pady 5 -padx 5
279 } else {
280 wm deiconify $w
281 raise $w
282 }
283 wm title $w "Preferences"
284 wm iconname $w "Preferences"
285 bind $w.col.origins.well <1> { set ori_color [selectColor .wprf.col.origins.well] }
286 bind $w.col.box.well <1> { set box_color [selectColor .wprf.col.box.well] }
287 bind $w.col.box.well2 <1> { set box_select_color [selectColor .wprf.col.box.well2] }
288 bind $w.col.bad.well <1> { set bad_color [selectColor .wprf.col.bad.well] }
289 bind $w.col.bad.well2 <1> { set bad_select_color [selectColor .wprf.col.bad.well2] }
290 bind $w.col.filament.well <1> { set filament_color [selectColor .wprf.col.filament.well] }
291 bind $w.col.filament.well2 <1> { set filament_select_color \
292 [selectColor .wprf.col.filament.well2] }
293 bind $w.col.filament.well3 <1> { set filament_first_color \
294 [selectColor .wprf.col.filament.well3] }
295 bind $w.col.spot.well <1> { set spot_color [selectColor .wprf.col.spot.well] }
296 bind $w.col.spot.well2 <1> { set spot_select_color [selectColor .wprf.col.spot.well2] }
297 bind $w.col.ll.well <1> { set ll_color [selectColor .wprf.col.ll.well] }
298 bind $w.col.ll.well2 <1> { set ll_select_color [selectColor .wprf.col.ll.well2] }
299 bind $w.col.marker.well <1> { set marker_color [selectColor .wprf.col.marker.well] }
300 bind $w.col.marker.well2 <1> { set marker_select_color [selectColor .wprf.col.marker.well2] }
301 bind $w.col.error.well <1> { set error_color [selectColor .wprf.col.error.well] }
302 bind $w.col.error.well2 <1> { set error_select_color [selectColor .wprf.col.error.well2] }
303 }
304
305 ## @brief Saves the settings file .bshow
306 #
307
308 proc writeSettingsFile { } {
309 global theimg
310 global window_width window_height window_scale
311 global autoscale std_scale imageonly
312 global rem_scale filter
313 global lg avgtileps avgframeps tiled
314 global tilex tiley tilez defocus
315 global tilt_axis tilt_angle tilt_offset show_tilt_axis
316 global volt Cs amp_fac
317 global ctf_win_x ctf_win_y
318 global ctf_scale_x ctf_scale_y
319 global ctf_hires ctf_lores
320 global cont_update show_rings base_type env_type sub_base
321 global box_size bad_radius
322 global filament_width filament_node_radius boxing_interval helix_rise helix_angle
323 global marker_radius
324 global shift_limit thickness
325 global spot_radius spot_resolution
326 global ll_length ll_width ll_resolution
327 global comp_radius link_radius selected_color line_width
328 global width height orix oriy color
329 global magnification magsize
330 global ori_color
331 global box_color box_select_color bad_color bad_select_color
332 global filament_color filament_first_color filament_select_color
333 global ll_color ll_select_color
334 global spot_color spot_select_color
335 global marker_color marker_select_color error_color error_select_color
336
337 set c [getImageCanvas $theimg]
338 set window_width [expr [winfo width $c] - 10]
339 set window_height [expr [winfo height $c] - 10]
340 # puts "Settings: $window_width $window_height $window_scale $autoscale"
341
342 if { [catch {open .bshow w} fset] } { return}
343
344 puts $fset "# .bshow: Bshow parameter file"
345 puts $fset "# ----------------------------"
346 puts $fset "# [clock format [clock seconds] -format {%Y-%m-%d %H:%M:%S}]"
347 puts $fset "# This must be valid Tcl/Tk code."
348 puts $fset ""
349 puts $fset "# File access:"
350 puts $fset "set filter $filter"
351 puts $fset ""
352 puts $fset "# Image window parameters:"
353 puts $fset "set window_width $window_width"
354 puts $fset "set window_height $window_height"
355 puts $fset "set window_scale $window_scale"
356 puts $fset "set rem_scale $rem_scale"
357 puts $fset "set autoscale $autoscale"
358 puts $fset "set std_scale $std_scale"
359 puts $fset "set imageonly $imageonly"
360 puts $fset "set ori_color $ori_color"
361 puts $fset ""
362 puts $fset "# Micrograph parameters:"
363 puts $fset "set tilt_axis $tilt_axis"
364 puts $fset "set tilt_angle $tilt_angle"
365 puts $fset "set tilt_offset $tilt_offset"
366 puts $fset "set show_tilt_axis $show_tilt_axis"
367 puts $fset ""
368 puts $fset "# Powerspectrum parameters:"
369 puts $fset "set lg $lg"
370 puts $fset "set avgtileps $avgtileps"
371 puts $fset "set avgframeps $avgframeps"
372 puts $fset "set tiled $tiled"
373 puts $fset "set tilex $tilex"
374 puts $fset "set tiley $tiley"
375 puts $fset "set tilez $tilez"
376 puts $fset "set defocus $defocus"
377 puts $fset ""
378 puts $fset "# CTF parameters:"
379 puts $fset "set volt $volt"
380 puts $fset "set Cs $Cs"
381 puts $fset "set amp_fac $amp_fac"
382 puts $fset "set ctf_hires $ctf_hires"
383 puts $fset "set ctf_lores $ctf_lores"
384 puts $fset "set ctf_win_x $ctf_win_x"
385 puts $fset "set ctf_win_y $ctf_win_y"
386 puts $fset "set ctf_scale_x $ctf_scale_x"
387 puts $fset "set ctf_scale_y $ctf_scale_y"
388 puts $fset "set cont_update $cont_update"
389 puts $fset "set show_rings $show_rings"
390 puts $fset "set base_type $base_type"
391 puts $fset "set env_type $env_type"
392 puts $fset "set sub_base $sub_base"
393 puts $fset ""
394 puts $fset "# Boxing parameters:"
395 puts $fset "set box_size \"$box_size\""
396 puts $fset "set bad_radius $bad_radius"
397 puts $fset "set box_color $box_color"
398 puts $fset "set box_select_color $box_select_color"
399 puts $fset "set bad_color $bad_color"
400 puts $fset "set bad_select_color $bad_select_color"
401 puts $fset ""
402 puts $fset "# Filament parameters:"
403 puts $fset "set filament_width $filament_width"
404 puts $fset "set filament_node_radius $filament_node_radius"
405 puts $fset "set boxing_interval $boxing_interval"
406 puts $fset "set helix_rise $helix_rise"
407 puts $fset "set helix_angle $helix_angle"
408 puts $fset "set filament_color $filament_color"
409 puts $fset "set filament_first_color $filament_first_color"
410 puts $fset "set filament_select_color $filament_select_color"
411 puts $fset ""
412 puts $fset "# Tomography parameters:"
413 puts $fset "set marker_radius $marker_radius"
414 puts $fset "set marker_color $marker_color"
415 puts $fset "set marker_select_color $marker_select_color"
416 puts $fset "set error_color $error_color"
417 puts $fset "set error_select_color $error_select_color"
418 puts $fset "set shift_limit $shift_limit"
419 puts $fset "set thickness $thickness"
420 puts $fset ""
421 puts $fset "# Crystallography parameters:"
422 puts $fset "set spot_radius $spot_radius"
423 puts $fset "set spot_resolution $spot_resolution"
424 puts $fset "set spot_color $spot_color"
425 puts $fset "set spot_select_color $spot_select_color"
426 puts $fset ""
427 puts $fset "# Helix parameters:"
428 puts $fset "set ll_length $ll_length"
429 puts $fset "set ll_width $ll_width"
430 puts $fset "set ll_resolution $ll_resolution"
431 puts $fset "set ll_color $ll_color"
432 puts $fset "set ll_select_color $ll_select_color"
433 puts $fset ""
434 puts $fset "# Model parameters:"
435 puts $fset "set comp_radius $comp_radius"
436 puts $fset "set link_radius $link_radius"
437 puts $fset "set selected_color $selected_color"
438 puts $fset "set line_width $line_width"
439 puts $fset ""
440 puts $fset "# Graph parameters:"
441 puts $fset "set width $width"
442 puts $fset "set height $height"
443 puts $fset "set orix $orix"
444 puts $fset "set oriy $oriy"
445 puts $fset "set color { blue green red yellow black SkyBlue2 }"
446 puts $fset ""
447 puts $fset "# Magnification parameters:"
448 puts $fset "set magnification $magnification"
449 puts $fset "set magsize $magsize"
450 puts $fset ""
451 close $fset
452 }
453
454 ## @brief getFileName
455 # Edits a file name entry
456 #
457 # @param w the entry window
458
459 proc getFileName { w } {
460 global imgdir
461 set name [tk_getOpenFile -initialdir $imgdir]
462 if { $name > " " } {
463 $w.e delete 0 end
464 $w.e insert 0 $name
465 }
466 }
467
468 proc checkType {type val} {
469 if { [expr {[string match {[.-+]} $val] || [string is $type $val]}] } {
470 return true
471 } else {
472 return false
473 }
474 }
475
476 proc setupEntry { w name type var desc } {
477 frame $w
478 label $w.l -text $name -width 20 -anchor w
479 entry $w.e -validate key -invcmd bell -width 10 \
480 -vcmd [list checkType $type %P]
481 $w.e insert 0 $var
482 button $w.b -text "?" -command "tk_messageBox -message \"$desc\" -type ok"
483 pack $w.l $w.e $w.b -side left -padx 1m
484 }
485
486 proc setupCheckEntry { w name type var cvar desc } {
487 frame $w
488 checkbutton $w.c -text $name -variable $cvar
489 entry $w.e -validate key -invcmd bell -width 10 \
490 -vcmd [list checkType $type %P] -textvariable $var
491 # $w.e insert 0 $var
492 button $w.b -text "?" -command "tk_messageBox -message \"$desc\" -type ok"
493 pack $w.c $w.e $w.b -side left -padx 1m
494 }
495
496 proc setupScrollEntry { w name var desc } {
497 frame $w
498 label $w.l -text $name -width 20 -anchor w
499 entry $w.e -validate key -invcmd bell -width 20 \
500 -xscrollcommand "$w.s set"
501 $w.e insert 0 $var
502 scrollbar $w.s -relief sunken -orient horiz -command "$w.e xview"
503 button $w.b -text "Browse ..." -command "getFileName $w" -width 10
504 button $w.i -text "?" -command "tk_messageBox -message \"$desc\" -type ok"
505 pack $w.s $w.e -side bottom -fill x -expand 1 -padx 1m
506 pack $w.l $w.b $w.i -side left -fill x -padx 1m
507 }
508
509 proc setupSizeEntry { w name type var desc } {
510 frame $w
511 label $w.l -text $name -width 10 -anchor w
512 entry $w.x -width 6 -validate key -vcmd [list checkType $type %P]
513 entry $w.y -width 6 -validate key -vcmd [list checkType $type %P]
514 entry $w.z -width 6 -validate key -vcmd [list checkType $type %P]
515 $w.x insert 0 [lindex $var 0]
516 $w.y insert 0 [lindex $var 1]
517 $w.z insert 0 [lindex $var 2]
518 button $w.b -text "?" -command "tk_messageBox -message \"$desc\" -type ok"
519 pack $w.l $w.x $w.y $w.z $w.b -side left -padx 1m
520 }
521
522 proc setupCheckSizeEntry { w name type var cvar desc } {
523 frame $w
524 checkbutton $w.c -text $name -variable $cvar -command [list updateCheckSizeEntry $w $var]
525 entry $w.x -width 6 -validate key -vcmd [list checkType $type %P]
526 entry $w.y -width 6 -validate key -vcmd [list checkType $type %P]
527 entry $w.z -width 6 -validate key -vcmd [list checkType $type %P]
528 $w.x insert 0 [lindex $var 0]
529 $w.y insert 0 [lindex $var 1]
530 $w.z insert 0 [lindex $var 2]
531 button $w.b -text "?" -command "tk_messageBox -message \"$desc\" -type ok"
532 pack $w.c $w.x $w.y $w.z $w.b -side left -padx 1m
533 }
534
535 proc updateCheckSizeEntry { w var } {
536 set ax [$w.x get]
537 set ay [$w.y get]
538 set az [$w.z get]
539 set kernel [list $ax $ay $az]
540 return $kernel
541 }
542
543 proc setupNewFileEntry { w name newfile desc } {
544 frame $w
545 label $w.l -text $name -width 20 -anchor w
546 entry $w.e -width 40
547 $w.e insert 0 $newfile
548 button $w.b -text "Load" \
549 -relief raised -command " loadParam \[$w.e get] "
550 button $w.i -text "?" -command "tk_messageBox -message \"$desc\" -type ok"
551 pack $w.l $w.e $w.b $w.i -side left -pady 5
552 }
553
554 ## @brief Opens a text documentation file
555 #
556 # @param helpfile File name.
557
558 proc showHelp { helpfile } {
559 global bshow_script
560 if ![winfo exists .help] {
561 toplevel .help
562 frame .help.frame
563 pack .help.frame -expand yes -fill both -padx 1 -pady 1
564 text .help.text -height 40 -wrap word -background white\
565 -xscrollcommand ".help.xscroll set" \
566 -yscrollcommand ".help.yscroll set" \
567 -setgrid 1 -highlightthickness 0 -pady 2 -padx 3
568 scrollbar .help.xscroll -command ".help.text xview" \
569 -highlightthickness 0 -orient horizontal
570 scrollbar .help.yscroll -command ".help.text yview" \
571 -highlightthickness 0 -orient vertical
572
573 grid .help.text -in .help.frame -padx 1 -pady 1 \
574 -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
575 grid .help.yscroll -in .help.frame -padx 1 -pady 1 \
576 -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
577 grid rowconfig .help.frame 0 -weight 1 -minsize 0
578 grid columnconfig .help.frame 0 -weight 1 -minsize 0
579 } else {
580 wm deiconify .help
581 raise .help
582 }
583 wm title .help $helpfile
584 wm iconname .help $helpfile
585 readTextFile .help "$bshow_script/$helpfile"
586 }
587
588 ## @brief Opens a URL in a web browser.
589 #
590 # @param url URL.
591
592 proc showURL { url } {
593 global tcl_platform
594 if [catch {
595 switch $tcl_platform(os) {
596 Darwin {
597 exec open $url
598 }
599 Linux -
600 FreeBSD -
601 OpenBSD -
602 HP-UX -
603 IRIX -
604 AIX -
605 SunOS {
606 foreach pot_exe {firefox mozilla netscape iexplorer opera lynx
607 w3m links epiphany galeon konqueror mosaic amaya
608 browsex elinks} {
609 set executable [auto_execok $pot_exe]
610 break
611 }
612 if [string length $executable] {
613 exec $executable $url &
614 }
615 }
616 {Windows 95} -
617 {Windows 98} -
618 {Windows NT} {
619 exec [auto_execok start] $url
620 }
621 }
622 } err] {
623 tk_messageBox -icon error -message "Error: '$err' displaying '$url'"
624 }
625 }
626
627 proc toolTip { w t } {
628 # bind $w <Any-Enter> "after 1000 showTip %X %Y $t; after 3000 hideTip"
629 # bind $w <Any-Leave> "hideTip"
630 # bind $w <ButtonPress-3> "set btn3 1; showTip %X %Y $t"
631 # bind $w <ButtonRelease-3> "set btn3 0; hideTip"
632 bind $w <ButtonPress-3> "showTip %X %Y $t"
633 bind $w <ButtonRelease-3> "hideTip"
634 }
635
636 proc showTip { x y args } {
637 wm geometry .tooltip +$x+$y
638 .tooltip.message configure -text $args
639 raise .tooltip
640 }
641
642 proc hideTip { } {
643 lower .tooltip
644 wm geometry .tooltip +0+0
645 .tooltip.message configure -text ""
646 }
647
648 toplevel .tooltip
649 wm geometry .tooltip 1x1+0+0
650 wm overrideredirect .tooltip 1
651 label .tooltip.message -bd 1 -fg black -bg lightyellow -font fixed -text ""
652 pack .tooltip.message
653 hideTip
654
655 ## @brief Updates the pixel size
656 #
657
658 proc updatePixelsize { } {
659 global project_item theimg imgtype
660 if [Bmg exists] {
661 # puts "Project item: $project_item $imgtype"
662 set pixel_size [Bmg get $project_item pixel_size $imgtype]
663 } else {
664 set pixel_size [Bimage get $theimg pixel_size]
665 }
666 # puts "Pixel size: $pixel_size"
667 set wc [getControlWindow $theimg]
668 if $pixel_size {
669 Bimage set $theimg pixel_size $pixel_size
670 $wc.pixel_size.entry delete 0 end
671 $wc.pixel_size.entry insert 0 $pixel_size
672 }
673 # puts "Pixel size = $pixel_size"
674 }
675
676 ## @brief Sets the pixel size
677 #
678 # theimg Image identifier.
679
680 proc setPixelsize { theimg } {
681 global project_item
682 set wc [getControlWindow $theimg]
683 set ps [$wc.pixel_size.entry get]
684 Bimage set $theimg pixel_size $ps
685 if [Bmg exists] {
686 Bmg set $project_item pixel_size $ps
687 if [winfo exists .wctf] { updateCTF}
688 }
689 set ps [Bimage get $theimg pixel_size]
690 puts "Image pixel size: $ps"
691 }
692
693 ## @brief Updates the image origins from parameters
694 #
695
696 proc updateOrigins { } {
697 global theimg filename
698 global imgtype project_item
699 if [Bmg exists] {
700 set n 1
701 # puts "in updateOrigins: Item: $project_item"
702 if [regexp "Field" $project_item] {
703 set n [Bmg get $project_item number_of_mg]
704 if { $imgtype == "mg" || $imgtype == "frame" } {
705 set origin [Bmg get $project_item origin]
706 } else {
707 set origin [Bimage get $theimg origin]
708 }
709 } elseif [regexp "Micrograph" $project_item] {
710 if { $imgtype == "mg" || $imgtype == "frame" } {
711 set origin [Bmg get $project_item origin]
712 } elseif { $imgtype == "part" } {
713 # set n [Bmg get $project_item number_of_part]
714 set origin [Bmg get $project_item part_origin $filename]
715 } else {
716 set origin [Bimage get $theimg origin]
717 }
718 } elseif [regexp "Reconstruction" $project_item] {
719 if { $imgtype == "rec" } {
720 set origin [Bmg get $project_item origin]
721 } elseif { $imgtype == "part" } {
722 # set n [Bmg get $project_item number_of_part]
723 set origin [Bmg get $project_item part_origin $filename]
724 } else {
725 set origin [Bimage get $theimg origin]
726 }
727 } elseif [regexp "Class" $project_item] {
728 if { $imgtype == "part" } {
729 set origin [Bmg get $project_item part_origin $filename]
730 }
731 }
732 # puts "Origin: $origin"
733 set i 0
734 foreach {x y z} $origin {
735 Bimage set $theimg origin $x $y $z $i
736 incr i
737 }
738 }
739 drawOrigin
740 }
741
742 ## @brief Draws the current image origin
743 #
744
745 proc drawOrigin { } {
746 global theimg
747 global show_origin ori_color
748 set c [getImageCanvas $theimg]
749 set wc [getControlWindow $theimg]
750 $c delete origin
751 set img_num [$wc.image.scale get]
752 set slice_num [$wc.slice.scale get]
753 set scale [$wc.scale.scale get]
754 set origin [Bimage get $theimg origin $img_num]
755 set ox [lindex $origin 0]
756 set oy [lindex $origin 1]
757 set oz [lindex $origin 2]
758 if { $show_origin } {
759 if { [expr abs($oz - $slice_num)] < 1 } {
760 set h [lindex [$c cget -scrollregion] 3]
761 $c create oval [expr int(($ox - 4.5)*$scale)] \
762 [expr int($h - ($oy - 4.5)*$scale)] \
763 [expr int(($ox + 5.5)*$scale)] \
764 [expr int($h - ($oy + 5.5)*$scale)] \
765 -tags origin -outline $ori_color
766 }
767 }
768 $wc.origin.x config -text $ox
769 $wc.origin.y config -text $oy
770 $wc.origin.z config -text $oz
771 }
772
773 ## @brief Update or grabs items closeby whenever the mouse is pressed
774 #
775 # @param c Canvas object.
776 # @param x
777 # @param y Coordinates on the canvas.
778
779 proc mousePressed { c x y } {
780 global tool theimg
781 global mx my
782 # if { $tool != "measure" } { return }
783 set wc [getControlWindow $theimg]
784 set scale [$wc.scale.scale get]
785 set rx [expr [$c canvasx $x] / $scale]
786 set ry [expr ([lindex [$c cget -scrollregion] 3] - [$c canvasy $y]) / $scale]
787 # puts "Mouse pressed"
788 if { $tool == "measure" } {
789 set ps [$wc.pixel_size.entry get]
790 set dx [expr $rx - $mx]
791 set dy [expr $ry - $my]
792 set d [expr $ps*sqrt($dx*$dx + $dy*$dy)]
793 # puts "Distance = $d angstrom"
794 puts [expr 57.296 * atan2($dy, $dx)]
795 $wc.distance.value config -text "$d"
796 } elseif { $tool == "voxels" } {
797 if ![winfo exists .wvox] { Voxels}
798 set n [$wc.image.scale get]
799 set z [$wc.slice.scale get]
800 set value [Bimage get $theimg pixel $rx $ry $z $n]
801 # puts "$rx $ry $value"
802 .wvox.text insert end "$n $rx $ry $z $value\n"
803 }
804 set mx [expr int($rx)]
805 set my [expr int($ry)]
806 }
807
808 ## @brief Updates or moves grabbed items whenever the mouse is moved.
809 #
810 # @param c Canvas object.
811 # @param x
812 # @param y Coordinates on the canvas.
813 # @param b button pressed.
814
815 proc mouseMoved { c x y b } {
816 global filename theimg
817 global tool
818 global px py
819 global mx my
820 global selectiontype
821 if { [string length $filename] < 1 } { return}
822 set wc [getControlWindow $theimg]
823 set scale [$wc.scale.scale get]
824 set h [lindex [$c cget -scrollregion] 3]
825 set cx [$c canvasx $x]
826 set cy [$c canvasy $y]
827 set cmx [expr int($mx * $scale)]
828 set cmy [expr int($h - $my * $scale)]
829 set px [expr int($cx / $scale)]
830 set py [expr int(($h - $cy) / $scale)]
831 $c delete measure
832 if { [winfo exists .wsel] && $b == 1 && $tool == "select" } {
833 $c delete selection
834 set xsize [expr abs($mx - $px) + 1]
835 set ysize [expr abs($my - $py) + 1]
836 set zsize 1
837 if { $selectiontype == "Square" || $selectiontype == "Cube" \
838 || $selectiontype == "Circle" || $selectiontype == "Sphere" } {
839 if { $cy > $cmy } {
840 set cy [expr $cmy + abs($cx - $cmx)]
841 } else {
842 set cy [expr $cmy - abs($cx - $cmx)]
843 }
844 set ysize $xsize
845 if { $selectiontype == "Cube" || $selectiontype == "Sphere" } {
846 set zsize $xsize
847 }
848 }
849 if { $selectiontype == "Square" || $selectiontype == "Rectangle" || $selectiontype == "Cube" } {
850 $c create rectangle $cmx $cmy $cx $cy -tags selection -outline red
851 }
852 if { $selectiontype == "Circle" || $selectiontype == "Ellipse" || $selectiontype == "Sphere" } {
853 $c create oval $cmx $cmy $cx $cy -tags selection -outline red
854 }
855 .wsel.size.x config -text $xsize
856 .wsel.size.y config -text $ysize
857 .wsel.size.z config -text $zsize
858 }
859 if { $tool == "measure" } {
860 $c create line $cmx $cmy $cx $cy -fill yellow -width 1 -tags measure
861 }
862 showCoords
863 updateMagnify $px $py default mouse
864 }
865
866 ## @brief Updates grabbed or nearby items whenever the mouse is released.
867 #
868 # @param c Canvas object.
869
870 proc mouseReleased { c } {
871 global tool theimg
872 global px py
873 global mx my
874 global selectiontype calc_stats
875 global sx1 sx2 sy1 sy2 sz1 sz2
876 if { [winfo exists .wsel] && $tool == "select" } {
877 set wc [getControlWindow $theimg]
878 set slice_num [$wc.slice.scale get]
879 # puts "Statistics for $mx $my $px $py"
880 set sx1 $mx
881 set sx2 $px
882 set sy1 $my
883 set sy2 $py
884 set sz1 $slice_num
885 set sz2 $slice_num
886 if { $selectiontype == "Square" || $selectiontype == "Cube" \
887 || $selectiontype == "Circle" || $selectiontype == "Sphere" } {
888 if { $sy2 > $sy1 } {
889 set sy2 [expr $sy1 + abs($sx2 - $sx1)]
890 } else {
891 set sy2 [expr $sy1 - abs($sx2 - $sx1)]
892 }
893 if { $selectiontype == "Cube" || $selectiontype == "Sphere" } {
894 set dz [expr abs($sx1 - $sx2)]
895 set zrad [expr $dz/2]
896 set sz1 [expr $slice_num - $zrad]
897 set sz2 [expr $slice_num + $zrad]
898 if { [expr 2*$zrad] != $dz } { set sz1 [expr $sz1 - 1]}
899 # puts "$sx1 $sx2 $zrad $sz1 $sz2"
900 }
901 }
902 if { $calc_stats } { updateSelectionStats}
903 }
904 }
905
906 ## @brief Displays updated coordinates whenever the mouse is moved.
907 #
908
909 proc showCoords { } {
910 global filename
911 global theimg imgtype
912 global tool
913 global px py
914 if { [string length $filename] < 1 } { return}
915 if ![Bimage exists $theimg] { return}
916 # puts "px = $px py = $py"
917 set wc [getControlWindow $theimg]
918 set img_num [$wc.image.scale get]
919 set slice_num [$wc.slice.scale get]
920 set value [Bimage get $theimg pixel $px $py $slice_num $img_num]
921 if { $value eq " " } { return}
922 $wc.pixel.x config -text "$px"
923 $wc.pixel.y config -text "$py"
924 $wc.pixel.value config -text "$value"
925 if { $tool != "measure" } {
926 set ps [$wc.pixel_size.entry get]
927 if { $imgtype == "ft" || $imgtype == "ps" } {
928 set width [Bimage get $theimg width]
929 set height [Bimage get $theimg height]
930 set depth [Bimage get $theimg nslices]
931 set dx [expr 0.5 - $px * 1.0 / $width]
932 set dy [expr 0.5 - $py * 1.0 / $height]
933 if { $slice_num > 1 } {
934 set dz [expr 0.5 - $slice_num * 1.0 / $depth]
935 } else {
936 set dz 0
937 }
938 set d [expr sqrt($dx*$dx + $dy*$dy + $dz*$dz)]
939 if { $d < 0.0001 } { set d 0.0001}
940 set d [expr $ps/$d]
941 set u "1/A"
942 } else {
943 set origin [Bimage get $theimg origin]
944 set dx [expr $ps*($px - [lindex $origin 0])]
945 set dy [expr $ps*($py - [lindex $origin 1])]
946 set dz [expr $ps*($slice_num - [lindex $origin 2])]
947 set d [expr sqrt($dx*$dx + $dy*$dy + $dz*$dz)]
948 set u "A"
949 }
950 $wc.distance.value config -text "$d"
951 $wc.distance.unit config -text "$u"
952 }
953 }
954
955 ## @brief Sets and updates the cutoff FOM.
956 #
957 # @param cutoff FOM cutoff value.
958
959 proc setFOMcutoff { cutoff } {
960 global fom_cutoff
961 set fom_cutoff $cutoff
962 Update 0
963 }
964
965
966 ## @brief Selects a cursor for the canvas window.
967 #
968
969 proc selectCursor { } {
970 global theimg
971 global tcl_platform
972 global cursorName
973
974 set c [getImageCanvas $theimg]
975
976 set pad 4; # extra space around buttons
977 set cols 6; # number of button columns
978
979 set cursor_list {
980 X_cursor arrow based_arrow_down based_arrow_up bottom_left_corner
981 bottom_right_corner bottom_side bottom_tee box_spiral center_ptr circle
982 cross cross_reverse crosshair diamond_cross dot dotbox double_arrow
983 draft_large draft_small draped_box exchange fleur hand1 hand2
984 icon iron_cross left_ptr left_side left_tee ll_angle lr_angle
985 plus right_ptr right_side
986 right_tee sb_down_arrow sb_h_double_arrow sb_left_arrow
987 sb_right_arrow sb_up_arrow sb_v_double_arrow sizing
988 target tcross top_left_arrow top_left_corner top_right_corner top_side
989 top_tee ul_angle ur_angle
990 }
991
992 if { $tcl_platform(platform) == "windows" } {
993 lappend cursor_list no starting size_ne_sw size_ns size_nw_se size_we uparrow wait
994 }
995
996 if { $tcl_platform(platform) == "macintosh" } {
997 lappend cursor_list text cross-hair
998 }
999
1000 set w .wcurs
1001 toplevel $w
1002 wm title $w "Select a cursor"
1003 wm iconname $w "Cursors"
1004
1005 foreach cursor $cursor_list {
1006 set cb [button $w.b_$cursor -text $cursor -cursor $cursor -command "configCursor_destroyWindow $c $w $cursor"]
1007 lappend cblist $cb
1008 if { [llength $cblist] >= $cols } {
1009 # place whole row of buttons
1010 eval grid $cblist -ipadx $pad -ipady $pad -sticky nswe
1011 set cblist {}
1012 }
1013 }
1014 if { [llength $cblist] > 0 } {
1015 # place rest of buttons
1016 eval grid $cblist -ipadx $pad -ipady $pad -sticky nswe
1017 }
1018
1019 eval grid [button $w.cancel -text Cancel -relief flat -overrelief raised -command "destroy $w"] \
1020 -ipadx $pad -ipady $pad -sticky nswe
1021
1022 }
1023
1024 proc configCursor_destroyWindow { c w name } {
1025 configCursor $c $name
1026 destroy $w
1027 }
1028
1029 proc configCursor { c name } {
1030 global cursorName tcl_platform
1031 set cursorName $name
1032 # $c config -cursor $cursorName
1033 switch -- $tcl_platform(platform) {
1034 unix {
1035 # $c config -cursor "$cursorName #ffffff #ffff00"
1036 $c config -cursor $cursorName
1037 }
1038 windows {
1039 $c config -cursor $cursorName
1040 }
1041 }
1042 }
1043
1044 if {[tk windowingsystem] eq "aqua"} {
1045 proc ::tk::mac::ShowHelp { } {
1046 global Bsoft
1047 showURL "file://$Bsoft/doc/bshow/bshow.html"
1048 }
1049 }
1050
1051 proc canvas2Photo { canvId } {
1052 # The following line grabs the contents of the canvas canvId into photo image ph.
1053 set retVal [catch {image create photo -format window -data $canvId} ph]
1054 if { $retVal != 0 } {
1055 puts "\n\tFATAL ERROR: Cannot create photo from canvas window"
1056 exit 1
1057 }
1058 return $ph
1059 }
1060
1061 proc capture {W format file} {
1062 if {[catch {package require Img}]} {
1063 # Error thrown - package not found.
1064 # Set up a dummy interface to work around the absence
1065 puts "package Img not found!"
1066 return
1067 }
1068 # raise $W
1069 # update idletasks
1070 set image [image create photo -format window -data $W]
1071 $image write -format $format $file
1072 puts "capture -> '$file' ([file size $file] bytes)"
1073 image delete $image
1074 }
1075