| Bsoft 2.0.5 Bernard's software package

bshow_xtal.tcl
Go to the documentation of this file.
1 ##
2 # @file bshow_xtal.tcl
3 #
4 # @brief Procedures to manage crystallographic images
5 #
6 # @author Bernard Heymann
7 # @date Created: 20061104
8 # @date Modified: 20181030
9
10 global unitcell
11 set show_spot 1
12 set show_spot_indices 1
13 set spot_radius 5
14 set spot_resolution 20
15 set spot_selected []
16
17 ## @brief Dialog box to manage crystallographic information
18 #
19
20 proc Crystallography { } {
21 global theimg imgtype project_item
22 global helv12
23 global spot_radius
24
25 if ![Bimage exists $theimg] {
26 tk_dialog .dialog "No image in memory!" \
27 {Please read in an appropriate image first.} \
28 info 0 {OK}
29 return
30 }
31
32 if { [string first "ft" $imgtype] < 0 } {
33 if { [string first "ps" $imgtype] < 0 } {
34 set i [tk_dialog .dialog "No power spectrum!" \
35 {No Fourier transform or power spectrum was found. Please transform the image first.} \
36 info 0 {Cancel} {Proceed anyway}]
37 if { $i < 1 } { return}
38 if { [Bimage get $theimg channels] > 1 } {
39 set imgtype "ft"
40 } else {
41 set imgtype "ps"
42 }
43 }
44 }
45
46 set c [getImageCanvas $theimg]
47
48 if ![Bmg exists] {
49 createMgParam
50 }
51
52 set cen [Bimage get $theimg center]
53 Bmg set $project_item origin [lindex $cen 0] [lindex $cen 1] [lindex $cen 2]
54
55 set w .wxtal
56 if ![winfo exists $w] {
57 toplevel $w
58 menu $w.menuBar -tearoff 0
59 $w.menuBar add cascade -menu $w.menuBar.tomo -label "Crystallography" -underline 0
60 menu $w.menuBar.tomo -tearoff 0
61 $w configure -menu $w.menuBar
62 $w.menuBar.tomo add command -label "Help" -underline 0 \
63 -command { showURL "file://$Bsoft/doc/bshow/bshow_xtal.html" }
64 # -command { showHelp bshow_xtal.hlp }
65 $w.menuBar.tomo add command -label "Set spot indices" \
66 -command { setSpotIndices } -underline 0
67 $w.menuBar.tomo add command -label "Calculate unit cell vectors" \
68 -command { calcUnitCellVectors } -underline 0
69 $w.menuBar.tomo add command -label "Generate spots" \
70 -command { spotGenerate } -underline 0
71 $w.menuBar.tomo add command -label "Mask spots" \
72 -command { spotMask } -underline 0
73 $w.menuBar.tomo add command -label "Delete all spots" \
74 -command { spotsDeleteAll } -underline 0
75 $w.menuBar.tomo add command -label "Close" \
76 -command { destroy $w } -underline 0
77
78 frame $w.spot_radius
79 label $w.spot_radius.tag -font $helv12 -text "Structure factor radius" -width 20 -anchor e
80 entry $w.spot_radius.entry -width 10 -validate key -vcmd { string is double %P }
81 $w.spot_radius.entry insert 0 $spot_radius
82
83 frame $w.number
84 label $w.number.tag -font $helv12 -text "Structure factor count" -width 20 -anchor e
85 label $w.number.num -width 10 -text "0" -relief sunken -bd 1 \
86 -font $helv12 -anchor w
87
88 frame $w.selected
89 label $w.selected.tag -font $helv12 -text "Selected" -width 15 -anchor e
90 label $w.selected.h -width 10 -text "" -relief sunken -bd 1 \
91 -font $helv12 -anchor w
92 label $w.selected.k -width 10 -text "" -relief sunken -bd 1 \
93 -font $helv12 -anchor w
94 label $w.selected.l -width 10 -text "" -relief sunken -bd 1 \
95 -font $helv12 -anchor w
96 label $w.selected.fom -width 10 -text "" -relief sunken -bd 1 \
97 -font $helv12 -anchor w
98
99 frame $w.switches
100 checkbutton $w.switches.spots -text "Show spots" -variable show_spot \
101 -command { spotsDrawAll }
102 checkbutton $w.switches.labels -text "Show indices" -variable show_spot_indices \
103 -command { spotsDrawAll }
104
105 frame $w.unitcell
106 label $w.unitcell.tag -font $helv12 -text "Unit cell" -width 10 -anchor e
107 label $w.unitcell.hx -width 6 -text "" -relief sunken -bd 1 \
108 -font $helv12 -anchor w
109 label $w.unitcell.hy -width 6 -text "" -relief sunken -bd 1 \
110 -font $helv12 -anchor w
111 label $w.unitcell.kx -width 6 -text "" -relief sunken -bd 1 \
112 -font $helv12 -anchor w
113 label $w.unitcell.ky -width 6 -text "" -relief sunken -bd 1 \
114 -font $helv12 -anchor w
115
116 frame $w.frame
117 text $w.table -relief sunken -bd 2 -width 40\
118 -yscrollcommand "$w.yscroll set" \
119 -setgrid 1 -highlightthickness 0 -pady 2 -padx 3
120 scrollbar $w.yscroll -command "$w.table yview" \
121 -highlightthickness 0 -orient vertical
122 grid $w.table -in $w.frame -padx 1 -pady 1 \
123 -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
124 grid $w.yscroll -in $w.frame -padx 1 -pady 1 \
125 -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
126 grid rowconfig $w.frame 0 -weight 1 -minsize 0
127 grid columnconfig $w.frame 0 -weight 1 -minsize 0
128
129 pack $w.spot_radius.tag $w.spot_radius.entry -side left -pady 5 -padx 10
130 pack $w.number.tag $w.number.num -side left -pady 5 -padx 10
131 pack $w.selected.tag $w.selected.h $w.selected.k $w.selected.l \
132 $w.selected.fom -side left -pady 5 -padx 10
133 pack $w.switches.spots $w.switches.labels -side left -ipadx 5 -ipady 5 -pady 5 -padx 5
134 pack $w.unitcell.tag $w.unitcell.hx $w.unitcell.hy \
135 $w.unitcell.kx $w.unitcell.ky -side left -pady 5 -padx 5
136 pack $w.spot_radius $w.number $w.selected $w.switches \
137 $w.unitcell -side top -pady 5 -padx 10
138 # pack $w.frame -expand yes -fill both -padx 5 -pady 5
139
140 # updateSFTable
141 updateSpotParam
142 spotsDrawAll
143 } else {
144 wm deiconify $w
145 raise $w
146 }
147 wm title $w "Crystallography"
148 wm iconname $w "Crystallography"
149 .menuBar.window entryconfigure "Crystallography" -state normal
150 bind $c <1> "spotCreateSelect %x %y"
151 bind $c <2> "spotCreateSelect %x %y"
152 bind $c <Shift-1> "spotDelete %x %y"
153 bind $c <Shift-2> "spotDelete %x %y"
154 bind $c <B1-Motion> "spotMove %x %y"
155 bind $c <B2-Motion> "spotMove %x %y"
156 bind $w <Return> "Update 0"
157 bind $w <Control-w> { destroy $w }
158 bind $w <Command-w> { destroy $w }
159 # updateSFTable
160 }
161
162 ## @brief Dialog box to set Miller indices for the selected structure factor
163
164 proc setSpotIndices { } {
165 global helv12
166 global spot_selected
167 set h 0
168 set k 0
169 set l 0
170 if { [llength $spot_selected] > 0 } {
171 set h [lindex $spot_selected 0]
172 set k [lindex $spot_selected 1]
173 set l [lindex $spot_selected 2]
174 }
175 set w .wind
176 if ![winfo exists $w] {
177 toplevel $w
178
179 frame $w.index
180 label $w.index.tag -font $helv12 -text "Indices" -width 14
181 entry $w.index.hentry -width 6 -validate key \
182 -vcmd { expr {[string match {[-+]} %P] || [string is int %P]} }
183 entry $w.index.kentry -width 6 -validate key \
184 -vcmd { expr {[string match {[-+]} %P] || [string is int %P]} }
185 entry $w.index.lentry -width 6 -validate key \
186 -vcmd { expr {[string match {[-+]} %P] || [string is int %P]} }
187 $w.index.hentry insert 0 $h
188 $w.index.kentry insert 0 $k
189 $w.index.lentry insert 0 $l
190
191 pack $w.index.tag $w.index.hentry $w.index.kentry $w.index.lentry -side left -padx 5 -pady 5
192 pack $w.index -side top -fill x -pady 2 -padx 15
193
194 frame $w.buttons
195 button $w.buttons.ok -text OK -command "setSpotIndices_and_DestroyWindow $w"
196 button $w.buttons.cancel -text Cancel -command "destroy $w"
197 pack $w.buttons -side bottom -fill x -pady 2m
198 pack $w.buttons.ok $w.buttons.cancel -side left -expand 1
199
200 bind $w <Return> "setSpotIndices_and_DestroyWindow $w"
201 } else {
202 wm deiconify $w
203 raise $w
204 }
205 wm title $w "Indices"
206 wm iconname $w "Indices"
207 tkwait window $w
208 }
209
210 ## @brief Sets the indices for a structure factor.
211 #
212 # @param w the window to destroy.
213
214 proc setSpotIndices_and_DestroyWindow { w } {
215 global theimg
216 global spot_selected
217 set wc [getControlWindow $theimg]
218 set h [$w.index.hentry get]
219 set k [$w.index.kentry get]
220 set l [$w.index.lentry get]
221 set n [$wc.image.scale get]
222 set mg_item [micrographItem $n]
223 if { [llength $spot_selected] > 0 } {
224 set spot_selected [Bmg spot $mg_item reindex [lindex $spot_selected 0] \
225 [lindex $spot_selected 1] [lindex $spot_selected 2] $h $k $l]
226 } else {
227 set spot_selected "$h $k $l"
228 }
229 .wxtal.selected.h config -text [lindex $spot_selected 0]
230 .wxtal.selected.k config -text [lindex $spot_selected 1]
231 .wxtal.selected.l config -text [lindex $spot_selected 2]
232 destroy $w
233 spotsDrawAll
234 }
235
236 ## @brief Calculates the unit cell vectors from the current structure factors.
237 #
238
239 proc calcUnitCellVectors { } {
240 global project_item
241 setMgParam
242 Bmg spot $project_item unitcell
243 set unitcell [Bmg get $project_item unitcell]
244 .wxtal.unitcell.hx config -text [lindex $unitcell 0]
245 .wxtal.unitcell.hy config -text [lindex $unitcell 1]
246 .wxtal.unitcell.kx config -text [lindex $unitcell 2]
247 .wxtal.unitcell.ky config -text [lindex $unitcell 3]
248 }
249
250 ## @brief Select a structure factor.
251 #
252 # @param x
253 # @param y Structure factor position in canvas coordinates.
254
255 proc spotSelect { x y } {
256 if ![winfo exists .wxtal] { return}
257 global theimg
258 global spot_selected
259 global tool
260 global px py
261 set c [getImageCanvas $theimg]
262 set wc [getControlWindow $theimg]
263 set scale [$wc.scale.scale get]
264 set n [$wc.image.scale get]
265 set z [$wc.slice.scale get]
266 set px [expr floor( [$c canvasx $x] / $scale )]
267 set py [expr floor( [$c canvasy $y] / $scale )]
268 set pyi [yFlip $py]
269 set mg_item [micrographItem $n]
270 set id [Bmg spot $mg_item select $px $pyi $z]
271 # puts "selected ID = $id"
272 if { [llength $id] > 0 } {
273 spotDraw [lindex $id 0] [lindex $id 1] [lindex $id 2]
274 set fom [Bmg spot $mg_item fom [lindex $id 0] [lindex $id 1] [lindex $id 2]]
275 .wxtal.selected.h config -text [lindex $id 0]
276 .wxtal.selected.k config -text [lindex $id 1]
277 .wxtal.selected.l config -text [lindex $id 2]
278 .wxtal.selected.fom config -text $fom
279 }
280 set spot_selected $id
281 return $id
282 }
283
284 ## @brief Creates or selects a structure factor.
285 #
286 # @param x
287 # @param y Structure factor position in canvas coordinates.
288
289 proc spotCreateSelect { x y } {
290 if ![winfo exists .wxtal] { return}
291 global theimg
292 global spot_selected
293 global tool
294 global px py
295 set c [getImageCanvas $theimg]
296 set wc [getControlWindow $theimg]
297 set id [spotSelect $x $y]
298 set n [$wc.image.scale get]
299 set mg_item [micrographItem $n]
300 if { [llength $id] < 1 && $tool == "xtal" } {
301 setSpotIndices
302 # puts "After indices set: $spot_selected"
303 if { [llength $spot_selected] < 1 } { return}
304 set scale [$wc.scale.scale get]
305 set z [$wc.slice.scale get]
306 set px [expr floor( [$c canvasx $x] / $scale )]
307 # set pyi [expr $h - $py - 1]
308 set pyi [yFlip $py]
309 set id [Bmg spot $mg_item create [lindex $spot_selected 0] [lindex $spot_selected 1] \
310 [lindex $spot_selected 2] $px $pyi $z]
311 # puts "created ID = $id"
312 }
313 if { [llength $id] > 0 } {
314 spotDraw [lindex $id 0] [lindex $id 1] [lindex $id 2]
315 }
316 set spot_selected $id
317 set i [Bmg spot $mg_item count]
318 .wxtal.number.num config -text "$i"
319 }
320
321 ## @brief Moves the selected structure factor.
322 #
323 # @param x
324 # @param y SF position in canvas coordinates.
325
326 proc spotMove { x y } {
327 if ![winfo exists .wxtal] { return}
328 global theimg
329 global spot_selected
330 global px py
331 if { [llength $spot_selected] < 1 } { return}
332 set c [getImageCanvas $theimg]
333 set wc [getControlWindow $theimg]
334 set scale [$wc.scale.scale get]
335 set n [$wc.image.scale get]
336 set ix [expr [$c canvasx $x] / $scale]
337 set iy [expr [$c canvasy $y] / $scale]
338 set dx [expr $ix - $px]
339 set dy [expr $py - $iy]
340 set dz 0
341 set px $ix
342 set py $iy
343 # puts "Moving $dx $dy"
344 set mg_item [micrographItem $n]
345 Bmg spot $mg_item move [lindex $spot_selected 0] [lindex $spot_selected 1] \
346 [lindex $spot_selected 2] $dx $dy $dz
347 spotsDrawAll
348 }
349
350 proc spotDisplayLocation { loc } {
351 global theimg
352 if ![winfo exists .wxtal] { return}
353 # set xm [expr [Bimage get $theimg width] / 2]
354 # set ym [expr [Bimage get $theimg height] / 2]
355 set c [getImageCanvas $theimg]
356 set wc [getControlWindow $theimg]
357 set scale [$wc.scale.scale get]
358 # set x [expr ([lindex $loc 0] + $xm) * $scale]
359 # set y [expr [lindex $loc 1] + $ym]
360 set x [expr [lindex $loc 0] * $scale]
361 set y [lindex $loc 1]
362 set y [expr [yFlip $y] * $scale]
363 # set z [$wc.slice.scale get]
364 set z [lindex $loc 2]
365 set loc "$x $y $z"
366 return $loc
367 }
368
369 ## @brief Draws a structure factor on the canvas.
370 #
371 # @param h SF index.
372 # @param k SF index.
373 # @param l SF index.
374
375 proc spotDraw { h k l } {
376 global theimg
377 global spot_selected
378 global show_spot_indices
379 global spot_color spot_select_color
380 if ![winfo exists .wxtal] { return}
381 set c [getImageCanvas $theimg]
382 set wc [getControlWindow $theimg]
383 set n [$wc.image.scale get]
384 set z [$wc.slice.scale get]
385 set scale [$wc.scale.scale get]
386 set mg_item [micrographItem $n]
387 set loc [Bmg spot $mg_item location $h $k $l]
388 set loc [spotDisplayLocation $loc]
389 # puts $loc
390 # set x [expr [lindex $loc 0] * $scale ]
391 # set y [expr [yFlip [lindex $loc 1]] * $scale ]
392 set x [lindex $loc 0]
393 set y [lindex $loc 1]
394 set zr [expr abs([lindex $loc 2] - $z)]
395 set radius [expr [.wxtal.spot_radius.entry get] * $scale]
396 set xmin [expr $x - $radius]
397 set xmax [expr $x + $radius + $scale - 1]
398 set ymin [expr $y - $radius]
399 set ymax [expr $y + $radius + $scale - 1]
400 set color $spot_color
401 if { $h == [lindex $spot_selected 0] && $k == [lindex $spot_selected 1] && $l == [lindex $spot_selected 2] } {
402 set color $spot_select_color
403 }
404 $c create oval $xmin $ymin $xmax $ymax -outline $color -width 1 -tags spot
405 if { $show_spot_indices } {
406 $c create text $xmax $y -text "$h,$k" -fill $color -anchor w -tags spot
407 }
408 }
409
410 ## @brief Draws all structure factors on the canvas.
411 #
412
413 proc spotsDrawAll { } {
414 global theimg
415 global show_spot fom_cutoff
416 set c [getImageCanvas $theimg]
417 set wc [getControlWindow $theimg]
418 $c delete spot
419 if { $show_spot < 1 } { return}
420 set n [$wc.image.scale get]
421 set mg_item [micrographItem $n]
422 set ids [Bmg spot $mg_item ids $fom_cutoff]
423 set nsel 0
424 foreach { h k l} $ids {
425 spotDraw $h $k $l
426 incr nsel 1
427 }
428 .wxtal.number.num config -text "$nsel"
429 }
430
431 ## @brief Deletes the selected structure factor on the canvas.
432 #
433 # @param x
434 # @param y SF particle position in window coordinates.
435
436 proc spotDelete { x y } {
437 global theimg
438 global spot_selected
439 set wc [getControlWindow $theimg]
440 set n [$wc.image.scale get]
441 set id [spotSelect $x $y]
442 puts "Deleting $id"
443 if { [llength $id] > 0 } {
444 set mg_item [micrographItem $n]
445 Bmg spot $mg_item delete [lindex $id 0] [lindex $id 1] [lindex $id 2]
446 set spot_selected []
447 }
448 spotsDrawAll
449 }
450
451 ## @brief Deletes all structure factors.
452 #
453
454 proc spotsDeleteAll { } {
455 global theimg
456 set c [getImageCanvas $theimg]
457 set wc [getControlWindow $theimg]
458 set n [$wc.image.scale get]
459 set mg_item [micrographItem $n]
460 Bmg spot $mg_item delete all
461 $c delete spot
462 .wxtal.number.num config -text "0"
463 }
464
465 ## @brief Generates structure factors from unit cell vectors.
466 #
467
468 proc spotGenerate { } {
469 global spot_resolution
470 set w .wxtalres
471 catch {destroy $w}
472 toplevel $w
473 wm title $w "Set the resolution limit"
474 wm iconname $w "Resolution"
475 tkwait visibility $w
476 grab $w
477 frame $w.buttons
478 button $w.buttons.ok -text OK -command "spotGenerate_and_DestroyWindow $w"
479 button $w.buttons.cancel -text Cancel -command "destroy $w"
480 frame $w.res
481 label $w.res.tag -text "Resolution limit" -anchor e
482 entry $w.res.entry -width 10 -validate key -vcmd { string is double %P }
483 $w.res.entry insert 0 "$spot_resolution"
484 pack $w.res.tag $w.res.entry -side left -padx 5 -pady 5
485 pack $w.res -side top -fill x -pady 2
486 pack $w.buttons -side bottom -fill x -pady 2m
487 pack $w.buttons.ok $w.buttons.cancel -side left -expand 1
488 bind $w <Return> "spotGenerate_and_DestroyWindow $w"
489 tkwait window $w
490 }
491
492 ## @brief Changes the data type of an image.
493 #
494 # @param w the window to destroy.
495
496 proc spotGenerate_and_DestroyWindow { w } {
497 global theimg
498 set wc [getControlWindow $theimg]
499 set n [$wc.image.scale get]
500 set resolution [$w.res.entry get]
501 # set pixel_size [$wc.pixel_size.entry get]
502 # set nx [Bimage get $theimg width]
503 # set hkl_lim [expr int($nx*$pixel_size/$resolution)]
504 # puts "HKL limit = $hkl_lim"
505 set mg_item [micrographItem $n]
506 Bmg spot $mg_item generate $resolution
507 destroy $w
508 updateSpotParam
509 spotsDrawAll
510 }
511
512 ## @brief Masks structure factors.
513 #
514
515 proc spotMask { } {
516 global theimg spot_radius
517 set wc [getControlWindow $theimg]
518 set n [$wc.image.scale get]
519 set mg_item [micrographItem $n]
520 Bmg spot $mg_item mask $spot_radius
521 Update 1
522 }
523
524 ## @brief Updates structure factor parameters from the micrograph parameters in memory.
525 #
526
527 proc updateSpotParam { } {
528 global project_item imgtype
529 global spot_radius spot_selected
530 set w .wxtal
531 if ![winfo exists $w] { return}
532 if ![Bmg exists] { createMgParam}
533 set filename [Bmg get $project_item filename $imgtype]
534 wm title $w [list "Xtal:" $filename]
535 # puts "Updating spot parameters"
536 set pixel_size [Bmg get $project_item pixel_size]
537 Bmg set $project_item sf_radius $spot_radius
538 # set spot_radius [Bmg get $project_item spot_radius]
539 updatePixelsize
540 set spot_selected []
541 $w.spot_radius.entry delete 0 end
542 $w.spot_radius.entry insert 0 $spot_radius
543 set unitcell [Bmg get $project_item unitcell]
544 $w.unitcell.hx config -text [lindex $unitcell 0]
545 $w.unitcell.hy config -text [lindex $unitcell 1]
546 $w.unitcell.kx config -text [lindex $unitcell 2]
547 $w.unitcell.ky config -text [lindex $unitcell 3]
548 }
549