| Bsoft 2.0.5 Bernard's software package

bshow_helix.tcl
Go to the documentation of this file.
1 ##
2 # @file bshow_helix.tcl
3 #
4 # @brief Procedures to manage helical diffraction patterns
5 #
6 # @author Bernard Heymann
7 # @date Created: 20070516
8 # @date Modified: 20160203
9
10 set show_ll 1
11 set show_ll_indices 1
12 set ll_length 100
13 set ll_width 10
14 set ll_resolution 20
15 set ll_selected -1
16 set ll_plot_width 300
17 set ll_plot_height 100
18
19 ## @brief Dialog box to manage helix information
20 #
21
22 proc Helix { } {
23 global project_item theimg
24 global helv12
25 global ll_width ll_length
26 global ll_plot_width ll_plot_height
27
28 if ![Bimage exists $theimg] {
29 tk_dialog .dialog "No image in memory!" \
30 {Please read in an appropriate image first.} \
31 info 0 {OK}
32 return
33 }
34
35 set c [getImageCanvas $theimg]
36
37 if ![Bmg exists] {
38 createMgParam
39 }
40 set rad [Bmg get $project_item helix_radius]
41 set axis [Bmg get $project_item helix_axis]
42 # puts "axis = $axis"
43 if { $rad < 1 } { set rad 100}
44 if { $axis < 0 } { set axis 90}
45 if ![winfo exists .whel] {
46 toplevel .whel
47 menu .whel.menuBar -tearoff 0
48 .whel.menuBar add cascade -menu .whel.menuBar.tomo -label "Helix" -underline 0
49 menu .whel.menuBar.tomo -tearoff 0
50 .whel configure -menu .whel.menuBar
51 .whel.menuBar.tomo add command -label "Help" \
52 -command { showURL "file://$Bsoft/doc/bshow/bshow_helix.html" }
53 # -command { showHelp bshow_xtal.hlp } -underline 0
54 .whel.menuBar.tomo add command -label "Set layer line index and order" \
55 -command { setLayerLineIndex } -underline 0
56 .whel.menuBar.tomo add command -label "Generate layer lines" \
57 -command { layerLinesGenerate } -underline 0
58 .whel.menuBar.tomo add command -label "Mask layer lines" \
59 -command { layerLinesMask } -underline 0
60 .whel.menuBar.tomo add command -label "Delete all layer lines" \
61 -command { layerLineDeleteAll } -underline 0
62 .whel.menuBar.tomo add command -label "Close" \
63 -command { destroy .whel } -underline 0
64
65 frame .whel.switches
66 checkbutton .whel.switches.ll -text "Show layer lines" -variable show_ll \
67 -command { layerLinesDrawAll }
68 checkbutton .whel.switches.labels -text "Show indices" -variable show_ll_indices \
69 -command { layerLinesDrawAll }
70
71 frame .whel.axis
72 label .whel.axis.tag -font $helv12 -text "Helix axis angle" -width 20 -anchor e
73 entry .whel.axis.entry -width 10 -validate key -vcmd { string is double %P }
74 .whel.axis.entry insert 0 $axis
75
76 frame .whel.radius
77 label .whel.radius.tag -font $helv12 -text "Helix radius" -anchor e
78 entry .whel.radius.entry -width 4 -validate key -vcmd { string is double %P }
79 .whel.radius.entry insert 0 $rad
80
81 frame .whel.ll_length
82 label .whel.ll_length.tag -font $helv12 -text "Layer line length" -width 20 -anchor e
83 entry .whel.ll_length.entry -width 10 -validate key -vcmd { string is double %P }
84 .whel.ll_length.entry insert 0 $ll_length
85
86 frame .whel.ll_width
87 label .whel.ll_width.tag -font $helv12 -text "Layer line width" -width 20 -anchor e
88 entry .whel.ll_width.entry -width 10 -validate key -vcmd { string is double %P }
89 .whel.ll_width.entry insert 0 $ll_width
90
91 frame .whel.number
92 label .whel.number.tag -font $helv12 -text "Layer line count" -width 20 -anchor e
93 label .whel.number.num -width 10 -text "0" -relief sunken -bd 1 \
94 -font $helv12 -anchor w
95
96 frame .whel.selected
97 label .whel.selected.tag -font $helv12 -text "Selected" -width 10
98 label .whel.selected.index -width 4 -text "" -relief sunken -bd 1 -font $helv12
99 label .whel.selected.order_tag -width 5 -font $helv12 -text "order"
100 entry .whel.selected.order_entry -width 4
101 label .whel.selected.fom_tag -width 5 -font $helv12 -text "FOM"
102 label .whel.selected.fom -width 10 -text "" -relief sunken -bd 1 -font $helv12
103
104 frame .whel.frame
105 text .whel.table -relief sunken -bd 2 -width 40\
106 -yscrollcommand ".whel.yscroll set" \
107 -setgrid 1 -highlightthickness 0 -pady 2 -padx 3
108 scrollbar .whel.yscroll -command ".whel.table yview" \
109 -highlightthickness 0 -orient vertical
110 grid .whel.table -in .whel.frame -padx 1 -pady 1 \
111 -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
112 grid .whel.yscroll -in .whel.frame -padx 1 -pady 1 \
113 -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
114 grid rowconfig .whel.frame 0 -weight 1 -minsize 0
115 grid columnconfig .whel.frame 0 -weight 1 -minsize 0
116
117 set g .whel.plot
118 canvas $g -width [expr $ll_plot_width + 10] -height [expr $ll_plot_height + 10] \
119 -background white -relief sunken -borderwidth 2
120
121 pack .whel.axis.tag .whel.axis.entry -side left -pady 5 -padx 10
122 pack .whel.radius.tag .whel.radius.entry -side left -pady 5 -padx 10
123 pack .whel.ll_length.tag .whel.ll_length.entry -side left -pady 5 -padx 10
124 pack .whel.ll_width.tag .whel.ll_width.entry -side left -pady 5 -padx 10
125 pack .whel.number.tag .whel.number.num -side left -pady 5 -padx 10
126 pack .whel.selected.tag .whel.selected.index .whel.selected.order_tag \
127 .whel.selected.order_entry .whel.selected.fom_tag .whel.selected.fom \
128 -side left -pady 5 -padx 5
129 pack .whel.switches.ll .whel.switches.labels -side left -ipadx 5 -ipady 5 -pady 5 -padx 5
130 pack .whel.switches .whel.axis .whel.radius .whel.ll_length .whel.ll_width .whel.number \
131 .whel.selected .whel.plot -side top -pady 5 -padx 5
132 # pack .whel.frame -expand yes -fill both -padx 5 -pady 5
133
134 # updateLayerLineTable
135 updateLayerLineParam
136 } else {
137 wm deiconify .whel
138 raise .whel
139 }
140 wm title .whel "Helix"
141 wm iconname .whel "Helix"
142 .menuBar.window entryconfigure "Helix" -state normal
143 bind $c <1> "layerLineCreateSelect %x %y"
144 bind $c <2> "layerLineCreateSelect %x %y"
145 bind $c <Shift-1> "layerLineDelete %x %y"
146 bind $c <Shift-2> "layerLineDelete %x %y"
147 bind $c <B1-Motion> "layerLineMove %x %y"
148 bind $c <B2-Motion> "layerLineMove %x %y"
149 bind .whel <Return> "Update 0"
150 bind .whel <Control-w> { destroy .whel }
151 bind .whel <Command-w> { destroy .whel }
152 # updateLayerLineTable
153 layerLinesDrawAll
154 drawHelixAxis
155 }
156
157 ## @brief Dialog box to set the index for the selected layer line
158
159 proc setLayerLineIndex { } {
160 global helv12 theimg
161 global ll_selected
162 set wc [getControlWindow $theimg]
163 set w .wlli
164 set n [$wc.image.scale get]
165 set mg_item [micrographItem $n]
166
167 if ![winfo exists $w] {
168 toplevel $w
169
170 frame $w.index
171 label $w.index.tag -font $helv12 -text "Index" -width 14
172 entry $w.index.entry -width 6 -validate key \
173 -vcmd { expr {[string match {[-+]} %P] || [string is int %P]} }
174
175 frame $w.order
176 label $w.order.tag -font $helv12 -text "Order" -width 14
177 entry $w.order.entry -width 6 -validate key -vcmd { string is int %P }
178
179 if { $ll_selected >= 0 } {
180 $w.index.entry insert 0 $ll_selected
181 $w.order.entry insert 0 [Bmg layerline $mg_item order $ll_selected]
182 }
183
184 pack $w.index.tag $w.index.entry -side left -padx 5 -pady 5
185 pack $w.order.tag $w.order.entry -side left -padx 5 -pady 5
186 pack $w.index $w.order -side top -fill x -pady 2 -padx 15
187
188 frame $w.buttons
189 button $w.buttons.ok -text OK -command "setLayerLineIndex_and_DestroyWindow $w"
190 button $w.buttons.cancel -text Cancel -command "destroy $w"
191 pack $w.buttons -side bottom -fill x -pady 2m
192 pack $w.buttons.ok $w.buttons.cancel -side left -expand 1
193
194 bind $w <Return> "setLayerLineIndex_and_DestroyWindow $w"
195 } else {
196 wm deiconify $w
197 raise $w
198 }
199
200 wm title $w "Index"
201 wm iconname $w "Index"
202 tkwait window $w
203 }
204
205 ## @brief Sets the index for a layer line.
206 #
207 # @param w the window to destroy.
208
209 proc setLayerLineIndex_and_DestroyWindow { w } {
210 global theimg
211 global ll_selected
212 set wc [getControlWindow $theimg]
213 set num [$w.index.entry get]
214 set order [$w.order.entry get]
215 set n [$wc.image.scale get]
216 set mg_item [micrographItem $n]
217 if { $ll_selected < 0 } {
218 set ids [Bmg layerline $mg_item ids]
219 foreach id $ids {
220 if { $id == $num } {
221 tk_messageBox -icon error -type ok -title "Error" -message \
222 "Layer line $num already exists!"
223 return
224 }
225 }
226 set ll_selected $num
227 } else {
228 set ll_selected [Bmg layerline $mg_item renumber $ll_selected $num]
229 }
230 .whel.selected.index config -text "$ll_selected"
231 .whel.selected.order_entry delete 0 end
232 .whel.selected.order_entry insert 0 $order
233 Bmg layerline $mg_item order $ll_selected $order
234 destroy $w
235 layerLinesDrawAll
236 }
237
238 ## @brief Creates or selects a layer line.
239 #
240 # @param x
241 # @param y Layer line position in canvas coordinates.
242
243 proc layerLineCreateSelect { x y } {
244 if ![winfo exists .whel] { return}
245 global theimg
246 global ll_selected
247 global tool
248 global px py
249 set ll_selected [layerLineSelect $x $y]
250 # puts "Layer line selected = $ll_selected"
251 if { $ll_selected > -1 } { return}
252 if { $tool != "helix" } { return}
253 setLayerLineIndex
254 if { $ll_selected < 0 } { return}
255 set c [getImageCanvas $theimg]
256 set wc [getControlWindow $theimg]
257 set n [$wc.image.scale get]
258 set scale [$wc.scale.scale get]
259 set px [expr floor( [$c canvasx $x] / $scale )]
260 set py [expr floor( [$c canvasy $y] / $scale )]
261 set pyi [yFlip $py]
262 # puts "Layer line created = $ll_selected"
263 set mg_item [micrographItem $n]
264 # puts "Bmg layerline $mg_item create $ll_selected $px $pyi"
265 set ll_selected [Bmg layerline $mg_item create $ll_selected $px $pyi]
266 puts "Layer line created = $ll_selected"
267 layerLineDraw $ll_selected
268 .whel.number.num config -text [Bmg layerline $mg_item count]
269 }
270
271 ## @brief Selects a layer line.
272 #
273 # @param x
274 # @param y Layer line position in canvas coordinates.
275
276 proc layerLineSelect { x y } {
277 if ![winfo exists .whel] { return}
278 global theimg
279 global ll_selected
280 global fom_cutoff ll_width
281 global px py
282 set c [getImageCanvas $theimg]
283 set wc [getControlWindow $theimg]
284 set ll_selected -1
285 set n [$wc.image.scale get]
286 set mg_item [micrographItem $n]
287 if { [Bmg layerline $mg_item count] < 1 } { return $ll_selected}
288 set scale [$wc.scale.scale get]
289 set px [expr floor( [$c canvasx $x] / $scale )]
290 set py [expr floor( [$c canvasy $y] / $scale )]
291 set pyi [yFlip $py]
292 set ll_selected [Bmg layerline $mg_item select $px $pyi $ll_width]
293 if { $ll_selected > -1 } {
294 set fom [Bmg layerline $mg_item fom $ll_selected]
295 set order [Bmg layerline $mg_item order $ll_selected]
296 .whel.selected.index config -text "$ll_selected"
297 .whel.selected.fom config -text "$fom"
298 .whel.selected.order_entry delete 0 end
299 .whel.selected.order_entry insert 0 $order
300 layerLineDraw $ll_selected
301 layerLinePlot $ll_selected $order [.whel.radius.entry get]
302 }
303 return $ll_selected
304 }
305
306 ## @brief Moves the selected layer line location.
307 #
308 # @param x
309 # @param y Layer line position in canvas coordinates.
310
311 proc layerLineMove { x y } {
312 if ![winfo exists .whel] { return}
313 global theimg
314 global ll_selected
315 global px py
316 if { $ll_selected < 0 } { return}
317 set c [getImageCanvas $theimg]
318 set wc [getControlWindow $theimg]
319 set scale [$wc.scale.scale get]
320 set n [$wc.image.scale get]
321 set mg_item [micrographItem $n]
322 set ix [expr [$c canvasx $x] / $scale]
323 set iy [expr [$c canvasy $y] / $scale]
324 set dx [expr $ix - $px]
325 set dy [expr $py - $iy]
326 set px $ix
327 set py $iy
328 # puts "Moving $dx $dy"
329 Bmg layerline $mg_item move $ll_selected $dx $dy
330 layerLinesDrawAll
331 }
332
333 ## @brief Draws a line along the helix axis on the canvas
334 #
335
336 proc drawHelixAxis { } {
337 global theimg
338 if ![winfo exists .whel] { return}
339 global project_item
340 set c [getImageCanvas $theimg]
341 set wc [getControlWindow $theimg]
342 set scale [$wc.scale.scale get]
343 set axis [.whel.axis.entry get]
344 set width [Bimage get $theimg width]
345 set height [Bimage get $theimg height]
346 set ox [getOriginX $c]
347 set oy [getOriginY $c]
348 set len $width
349 if { $len < $height } { set len $height}
350 set len [expr $scale * $len/2]
351 set cosax [expr cos($axis)]
352 set sinax [expr sin($axis)]
353 set xmin [expr $ox - $len*$cosax]
354 set ymin [expr $oy + $len*$sinax]
355 set xmax [expr $ox + $len*$cosax]
356 set ymax [expr $oy - $len*$sinax]
357 $c delete helix_axis
358 $c create line $xmin $ymin $xmax $ymax -fill LightBlue -width 1.5 -tags helix_axis
359 Bmg set $project_item helix_axis $axis
360 }
361
362 ## @brief Draws a layer line in the original image on the canvas
363 #
364 # @param id Layer line index.
365
366 proc layerLineDraw { id } {
367 if ![winfo exists .whel] { return}
368 global theimg
369 global show_ll_indices
370 global ll_length
371 global ll_selected ll_color ll_select_color
372 if ![winfo exists .whel] { return}
373 set c [getImageCanvas $theimg]
374 set wc [getControlWindow $theimg]
375 if { $id < 0 } { return}
376 if { [llength $id] < 1 } {
377 puts "No ID specified!"
378 return
379 }
380 set n [$wc.image.scale get]
381 set mg_item [micrographItem $n]
382 set d [Bmg layerline $mg_item distance $id]
383 if { [llength $d] < 1 } {
384 puts "No distance for ID = $id!"
385 return
386 }
387 set scale [$wc.scale.scale get]
388 set d [expr $d * $scale]
389 # puts "Drawing $id at $d"
390 set ox [getOriginX $c]
391 set oy [getOriginY $c]
392 set axis [.whel.axis.entry get]
393 set cosax [expr cos($axis)]
394 set sinax [expr sin($axis)]
395 set ll_length [.whel.ll_length.entry get]
396 set x [expr $ox + $d * $cosax]
397 set y [expr $oy - $d * $sinax]
398 set len [expr $scale * $ll_length]
399 set xmin [expr $x - $len*$sinax]
400 set ymin [expr $y - $len*$cosax]
401 set xmax [expr $x + $len*$sinax]
402 set ymax [expr $y + $len*$cosax]
403 # puts "$xmin $ymin $xmax $ymax"
404 set color $ll_color
405 if { $id == $ll_selected } { set color $ll_select_color}
406 $c create line $xmin $ymin $xmax $ymax -fill $color -dash . -width 1 -tags ll
407 if { $show_ll_indices } {
408 set x [expr $x + 10]
409 $c create text $x $y -text $id -fill $color -anchor w -tags ll
410 }
411 }
412
413 ## @brief Draws all layer lines on the canvas.
414 #
415
416 proc layerLinesDrawAll { } {
417 global theimg
418 global fom_cutoff
419 global show_ll
420 set c [getImageCanvas $theimg]
421 $c delete ll
422 if ![winfo exists .whel] { return}
423 if { $show_ll < 1 } { return}
424 set wc [getControlWindow $theimg]
425 set n [$wc.image.scale get]
426 set mg_item [micrographItem $n]
427 set ids [Bmg layerline $mg_item ids $fom_cutoff]
428 # puts "drawing IDS = $ids"
429 set nsel 0
430 foreach id $ids {
431 # puts "drawing ID = $id"
432 layerLineDraw $id
433 incr nsel 1
434 }
435 .whel.number.num config -text "$nsel"
436 }
437
438 ## @brief Deletes the selected layer line on the canvas.
439 #
440 # @param x
441 # @param y Layer line position in window coordinates.
442
443 proc layerLineDelete { x y } {
444 global theimg ll_selected
445 set ll_selected [layerLineSelect $x $y]
446 if { $ll_selected < 0 } { return}
447 set wc [getControlWindow $theimg]
448 set n [$wc.image.scale get]
449 set mg_item [micrographItem $n]
450 Bmg layerline $mg_item delete $ll_selected
451 layerLinesDrawAll
452 }
453
454
455 ## @brief Deletes all layer lines in list.
456 #
457
458 proc layerLineDeleteAll { } {
459 global theimg
460 set c [getImageCanvas $theimg]
461 set wc [getControlWindow $theimg]
462 set n [$wc.image.scale get]
463 set mg_item [micrographItem $n]
464 Bmg layerline $mg_item delete all
465 $c delete ll
466 .whel.number.num config -text "0"
467 }
468
469 ## @brief Generates layer lines from unit cell vectors.
470 #
471
472 proc layerLinesGenerate { } {
473 global ll_resolution
474 set w .whelres
475 catch {destroy $w}
476 toplevel $w
477 wm title $w "Set the resolution limit"
478 wm iconname $w "Resolution"
479 tkwait visibility $w
480 grab $w
481 frame $w.buttons
482 button $w.buttons.ok -text OK -command "layerLinesGenerate_and_DestroyWindow $w"
483 button $w.buttons.cancel -text Cancel -command "destroy $w"
484 frame $w.res
485 label $w.res.tag -text "Resolution limit" -anchor e
486 entry $w.res.entry -width 10 -validate key -vcmd { string is double %P }
487 $w.res.entry insert 0 "$ll_resolution"
488 pack $w.res.tag $w.res.entry -side left -padx 5 -pady 5
489 pack $w.res -side top -fill x -pady 2
490 pack $w.buttons -side bottom -fill x -pady 2m
491 pack $w.buttons.ok $w.buttons.cancel -side left -expand 1
492 bind $w <Return> "layerLinesGenerate_and_DestroyWindow $w"
493 tkwait window $w
494 }
495
496 ## @brief Generates layer lines from unit cell vectors.
497 #
498 # @param w the window to destroy.
499
500 proc layerLinesGenerate_and_DestroyWindow { w } {
501 global theimg
502 set wc [getControlWindow $theimg]
503 set resolution [$w.res.entry get]
504 set pixel_size [$wc.pixel_size.entry get]
505 set nx [Bimage get $theimg width]
506 set ny [Bimage get $theimg height]
507 if { $nx > $ny } {
508 set ll_lim [expr int($nx*$pixel_size/$resolution)]
509 } else {
510 set ll_lim [expr int($ny*$pixel_size/$resolution)]
511 }
512 # puts "Radial limit = $ll_lim"
513 set n [$wc.image.scale get]
514 set mg_item [micrographItem $n]
515 set nll [Bmg layerline $mg_item generate $ll_lim]
516 # puts "$nll layer lines generated"
517 destroy $w
518 updateLayerLineParam
519 layerLinesDrawAll
520 }
521
522 ## @brief Masks layer lines.
523 #
524
525 proc layerLinesMask { } {
526 global theimg ll_width
527 set wc [getControlWindow $theimg]
528 set n [$wc.image.scale get]
529 set mg_item [micrographItem $n]
530 Bmg layerline $mg_item mask $ll_width
531 Update 1
532 }
533
534 ## @brief Plots the selected layer line in the plot canvas
535 #
536 # @param id Layer line index.
537 # @param order Layer line order.
538 # @param rad Layer line length.
539
540 proc layerLinePlot { id order rad } {
541 global theimg project_item
542 global ll_plot_width ll_plot_height
543 if ![winfo exists .whel] { return}
544 Bmg set $project_item helix_radius $rad
545 if { $id < 0 } { return}
546 set wc [getControlWindow $theimg]
547 set n [$wc.image.scale get]
548 set mg_item [micrographItem $n]
549 if { [Bmg layerline $mg_item count] < 1 } { return}
550 set ll_len [.whel.ll_length.entry get]
551 set data [Bmg layerline $mg_item plot $id $ll_len]
552 set bessel [Bmg layerline $mg_item bessel $order $rad $ll_len]
553 set len [lindex $data 0]
554 if { $len < 1 } { return}
555 set max 0
556 set bmax 0
557 for {set i 1} {$i <= $len} {incr i 1} {
558 set v [lindex $data $i]
559 if { $max < $v } { set max $v}
560 set b [lindex $bessel $i]
561 if { $bmax < $b } { set bmax $b}
562 }
563 # set max [expr $max/$bmax]
564 # set max [Bimage get $theimg max]
565 set xoff 10
566 set yoff 10
567 set xscale [expr $ll_plot_width*1.0/$len]
568 set yscale [expr $ll_plot_height*1.0/$max]
569 set ybscale [expr $ll_plot_height*1.0/$bmax]
570 set g .whel.plot
571 $g delete llplot
572 set ll ""
573 set bl ""
574 for {set i 1} {$i <= $len} {incr i 1} {
575 set x [expr ($i-1)*$xscale + $xoff]
576 set y [expr ($max - [lindex $data $i]) * $yscale + $yoff]
577 # set b [expr (1 - [lindex $bessel $i]) * $ll_plot_height + $yoff]
578 set b [expr ($bmax - [lindex $bessel $i]) * $ybscale + $yoff]
579 append ll " " $x " " $y
580 append bl " " $x " " $b
581 }
582 $g create line $ll -fill blue -smooth yes -width 1 -tags llplot
583 $g create line $bl -fill red -smooth yes -width 1 -tags llplot
584 set orix [expr $ll_plot_width/2 + $xoff]
585 set oriy [expr $ll_plot_height + 2*$yoff]
586 $g create line $orix 0 $orix $oriy \
587 -fill black -smooth yes -width 1 -tags llplot
588 }
589
590 ## @brief Updates layer line parameters from the micrograph parameters in memory.
591 #
592
593 proc updateLayerLineParam { } {
594 global project_item imgtype
595 global ll_width ll_selected
596 set w .whel
597 if ![winfo exists $w] { return}
598 if ![Bmg exists] { createMgParam}
599 set filename [Bmg get $project_item filename $imgtype]
600 wm title $w [list "Helix:" $filename]
601 # puts "Updating layer line parameters"
602 # set pixel_size [Bmg get $project_item pixel_size]
603 set axis [Bmg get $project_item helix_axis]
604 if !$axis { set axis 90}
605 $w.axis.entry delete 0 end
606 $w.axis.entry insert 0 $axis
607 # set ll_width [Bmg get $project_item ll_width]
608 updatePixelsize
609 $w.ll_width.entry delete 0 end
610 $w.ll_width.entry insert 0 $ll_width
611 set ll_selected -1
612 }
613