| Bsoft 2.0.5 Bernard's software package

bshow_ctf.tcl
Go to the documentation of this file.
1 ##
2 # @file bshow_ctf.tcl
3 #
4 # @brief Procedures to do CTF fitting
5 #
6 # @author Bernard Heymann
7 # @date Created: 20020729
8 # @date Modified: 20170712
9
10 set plot_width 500
11 set plot_height 300
12 set ctf_win_x 768
13 set ctf_win_y 768
14 set ctf_scale_x 1
15 set ctf_scale_y 0
16 set cont_update 0
17 set show_rings 1
18 set base_type 1
19 set env_type 4
20 set sub_base 0
21 set rps ""
22 set base ""
23 set envl ""
24 set ctf ""
25 set ctfdir [pwd]
26 set volt 120.0
27 set Cs 2.0
28 set amp_fac 0.07
29 set ctf_hires 1
30 set ctf_lores 50
31
32 ## @brief Dialog box to manipulate CTF parameters
33 #
34 # @param currimg Image identifier.
35
36 proc CTF { currimg } {
37 global project_item theimg imgtype
38 global helv12 step
39 global plot_width plot_height
40 global ctf_win_x ctf_win_y
41 global ctf_scale_x ctf_scale_y
42 global volt Cs amp_fac base_type env_type ctf_hires ctf_lores
43
44 if ![Bimage exists $theimg] {
45 tk_dialog .dialog "No image in memory!" \
46 {Please read in an appropriate image first.} \
47 info 0 {OK}
48 return
49 }
50
51 if { [string first "ps" $imgtype] < 0 } {
52 set i [tk_dialog .dialog "No power spectrum!" \
53 {No power spectrum was found. Please transform the image first to a power spectrum.} \
54 info 0 {Cancel} {Proceed anyway}]
55 if { $i < 1 } { return}
56 set imgtype "ps"
57 }
58 set theimg $currimg
59 # puts "canvas = $c image = $theimg"
60 set filename [Bimage get $theimg filename]
61 set width [Bimage get $theimg width]
62 set height [Bimage get $theimg height]
63 setStep $theimg
64
65 if ![Bmg exists] { createMgParam}
66
67 set wc [getControlWindow $theimg]
68 set n [$wc.image.scale get]
69 set mg_item [micrographItem $n]
70
71 puts "project_item: $mg_item file: $filename imgtype: $imgtype"
72 # puts [Bmg get $mg_item filename ps]
73 if ![string length [Bmg get $mg_item filename ps]] {
74 Bmg set $mg_item filename $filename ps
75 puts "Power spectrum: $filename"
76 }
77
78 setCTFPixelSize $theimg
79
80 set w .wctf
81 if ![winfo exists $w] {
82 toplevel $w
83 wm geometry $w [format "%dx%d" $ctf_win_x $ctf_win_y]
84
85 if { $ctf_scale_y < 0.1 } {
86 # set range [expr [.max.scale get] - [.min.scale get]]
87 set range [expr [Bimage get $theimg max] - [Bimage get $theimg min]]
88 if { $range <= 0 } { set range $plot_height}
89 set ctf_scale_y [expr int($plot_height/$range + 1)]
90 }
91
92 # set hires [expr int(200 * [.pixel_size.entry get]) / 100.0]
93 set hires [expr int(200 * [Bimage get $theimg pixel_size]) / 100.0]
94 if { $hires > $ctf_hires } { set ctf_hires $hires}
95 if { $ctf_lores < [expr 2 * $ctf_hires] } {
96 set ctf_lores [expr 2 * $ctf_hires]
97 }
98
99 menu $w.menuBar -tearoff 0
100 $w.menuBar add cascade -menu $w.menuBar.box -label "CTF" -underline 0
101 menu $w.menuBar.box -tearoff 0
102 $w configure -menu $w.menuBar
103 $w.menuBar.box add command -label "Help" -underline 0 \
104 -command { showURL "file://$Bsoft/doc/bshow/bshow_ctf.html" }
105 $w.menuBar.box add command -label "Write curves" \
106 -command { writeCTF } -underline 0
107 $w.menuBar.box add command -label "Save window" \
108 -command [list capture $w png t.png] -underline 0
109 # -command { canvas2Photo $w } -underline 0
110 $w.menuBar.box add command -label "Close" \
111 -command "destroy $w" -underline 0
112
113 set g $w.plot
114 canvas $g -width $plot_width -height $plot_height -background white \
115 -relief sunken -borderwidth 2
116
117 setupMicrographID $w.mgid
118
119 # Plot parameters
120 frame $w.pp -bg cyan
121 label $w.pp.origin_tag -font $helv12 -text "Origin" -bg cyan
122 entry $w.pp.ox_entry -width 6 -validate key -vcmd { string is double %P }
123 $w.pp.ox_entry insert 0 20
124 entry $w.pp.oy_entry -width 6 -validate key -vcmd { string is double %P }
125 $w.pp.oy_entry insert 0 20
126 label $w.pp.scale_tag -font $helv12 -text "Scale" -bg cyan
127 entry $w.pp.sx_entry -width 6 -validate key -vcmd { string is double %P }
128 $w.pp.sx_entry insert 0 $ctf_scale_x
129 entry $w.pp.sy_entry -width 6 -validate key -vcmd { string is double %P }
130 $w.pp.sy_entry insert 0 $ctf_scale_y
131 label $w.pp.res_tag -font $helv12 -text "Resolution" -bg cyan
132 entry $w.pp.lores_entry -width 6 -validate key -vcmd { string is double %P }
133 $w.pp.lores_entry insert 0 $ctf_lores
134 entry $w.pp.hires_entry -width 6 -validate key -vcmd { string is double %P }
135 $w.pp.hires_entry insert 0 $ctf_hires
136 label $w.pp.val_tag -font $helv12 -text "Value" -bg cyan
137 label $w.pp.value -width 6 -text "" -relief sunken -bd 1 -anchor w
138
139 # Placement in frames
140 pack $w.pp.origin_tag $w.pp.ox_entry $w.pp.oy_entry \
141 $w.pp.scale_tag $w.pp.sx_entry $w.pp.sy_entry \
142 $w.pp.res_tag $w.pp.lores_entry $w.pp.hires_entry \
143 $w.pp.value \
144 -side left -ipadx 3 -ipady 2
145
146 # These scales are used for CTF parameters
147 scale $w.def_avg_scale -orient horizontal -from 0.02 -to 20 \
148 -command { setDefocusAverage } -label "Defocus average (um)"\
149 -resolution 0.001
150 $w.def_avg_scale set 2
151
152 scale $w.def_dev_scale -orient horizontal -from 0 -to 5 \
153 -command { setDefocusDeviation } -label "Defocus deviation (um)"\
154 -resolution 0.001
155 $w.def_dev_scale set 0
156
157 scale $w.ast_ang_scale -orient horizontal -from -90 -to 90 \
158 -command { setAstigmatismAngle } -label "Astigmatism angle (degrees)"
159 $w.ast_ang_scale set 0
160
161 # Imaging parameters
162 frame $w.vca -bg cyan
163 label $w.vca.volt_tag -font $helv12 -text "Voltage (kV)" -bg cyan
164 entry $w.vca.volt_entry -width 6 -validate key -vcmd { string is double %P }
165 $w.vca.volt_entry insert 0 $volt
166 label $w.vca.cs_tag -font $helv12 -text "Cs (mm)" -bg cyan
167 entry $w.vca.cs_entry -width 6 -validate key -vcmd { string is double %P }
168 $w.vca.cs_entry insert 0 $Cs
169 label $w.vca.amp_tag -font $helv12 -text "Amp" -bg cyan
170 entry $w.vca.amp_entry -width 6 -validate key -vcmd { string is double %P }
171 $w.vca.amp_entry insert 0 $amp_fac
172 pack $w.vca.volt_tag $w.vca.volt_entry $w.vca.cs_tag $w.vca.cs_entry \
173 $w.vca.amp_tag $w.vca.amp_entry -side left -ipadx 3
174
175 frame $w.base_eq -bg green
176 label $w.base_eq.tag -font $helv12 -text "Baseline" -bg green
177 entry $w.base_eq.entry
178 $w.base_eq.entry insert 0 {0.2*exp(-5000*$s2) + 0.14*exp(-300*$s2) + 0.4}
179
180 frame $w.base_buttons -bg green
181 label $w.base_buttons.tag -font $helv12 -text " Type" -bg green
182 tk_optionMenu $w.base_buttons.type base_type "1" "2" "3" "4" "5" "6"
183 checkbutton $w.base_buttons.subtract -text "Subtract" \
184 -variable sub_base -relief raised -command "drawCTF" -bg green
185
186 # Placement in frames
187 pack $w.base_eq.tag -side left
188 pack $w.base_eq.entry -side left -fill x -expand yes -ipady 2
189 pack $w.base_buttons.tag $w.base_buttons.type -side left -ipadx 2
190 pack $w.base_buttons.subtract -side left
191
192 frame $w.env_eq -bg orange
193 label $w.env_eq.tag -font $helv12 -text "Envelope" -bg orange
194 entry $w.env_eq.entry
195 $w.env_eq.entry insert 0 {0.2*exp(-1000*$s2)}
196
197 frame $w.env_buttons -bg orange
198 label $w.env_buttons.tag -font $helv12 -text " Type" -bg orange
199 tk_optionMenu $w.env_buttons.type env_type "1" "2" "3" "4"
200
201 # Placement in frames
202 pack $w.env_eq.tag -side left
203 pack $w.env_eq.entry -side left -fill x -expand yes -ipady 2
204 pack $w.env_buttons.tag $w.env_buttons.type -side left -ipadx 2
205
206 # Buttons to do CTF fits
207 frame $w.fit -bg cyan
208 label $w.fit.tag -text "Fit " -bg cyan
209 button $w.fit.quick -text "Quick" \
210 -relief raised -command "autoCTFfit 0"
211 button $w.fit.baseline -text "Baseline" \
212 -relief raised -command "autoCTFfit 1"
213 button $w.fit.envelope -text "Envelope" \
214 -relief raised -command "autoCTFfit 2"
215 button $w.fit.defocus -text "Defocus" \
216 -relief raised -command "autoCTFfit 3"
217 button $w.fit.astig -text "Astigmatism" \
218 -relief raised -command "autoCTFfit 4"
219 pack $w.fit.tag $w.fit.quick $w.fit.baseline $w.fit.envelope \
220 $w.fit.defocus $w.fit.astig -side left -ipadx 5
221
222 # Defocus range for quick fit
223 frame $w.def -bg cyan
224 label $w.def.tag -text "Defocus:" -bg cyan
225 label $w.def.start_tag -text "min" -bg cyan
226 entry $w.def.start -width 4
227 label $w.def.end_tag -text "max" -bg cyan
228 entry $w.def.end -width 4
229 label $w.def.inc_tag -text "inc" -bg cyan
230 entry $w.def.inc -width 4
231 $w.def.start insert 0 0.1
232 $w.def.end insert 0 20
233 $w.def.inc insert 0 0.1
234 pack $w.def.tag $w.def.start_tag $w.def.start $w.def.end_tag \
235 $w.def.end $w.def.inc_tag $w.def.inc -side left -ipadx 5
236
237 # Checkbutton to update the plot and show rings
238 frame $w.checks
239 checkbutton $w.checks.update -text "updateCTF" -variable cont_update \
240 -command "updateCTF"
241 checkbutton $w.checks.rings -text "Show rings" -variable show_rings \
242 -command [list drawEllipse $theimg]
243 pack $w.checks.update $w.checks.rings -side left -padx 2
244 setupMicrographButtons $w.checks "micrograph"
245
246 # Placement in window
247 pack $w.mgid -side top -fill x -ipady 1
248 pack $w.plot -side top -fill both -expand yes
249 pack $w.pp $w.def_avg_scale $w.def_dev_scale $w.ast_ang_scale -side top -fill x -ipady 1
250 pack $w.vca $w.base_eq $w.base_buttons $w.env_eq $w.env_buttons -side top -fill x -ipady 1
251 pack $w.checks -side bottom -fill x -ipady 1
252 pack $w.fit $w.def -side left -fill x -ipady 1
253 } else {
254 wm deiconify $w
255 raise $w
256 }
257
258 getCTFparam
259 wm title $w [list "CTF:" $filename "(" $n ")"]
260 wm iconname $w "CTF"
261
262 bind $g <Motion> "showFrequency %W %x %y"
263 bind $w <Return> "updateCTF"
264
265 bind $w <Control-w> { destroy $w }
266 bind $w <Command-w> { destroy $w }
267 .menuBar.window entryconfigure "CTF" -state normal
268 }
269
270 ## @brief Dialog box to set the pixel size for CTF fitting
271 #
272 # @param theimg Image identifier.
273
274 proc setCTFPixelSize { theimg } {
275 global helv12
276 set wc [getControlWindow $theimg]
277 set pixel_size [$wc.pixel_size.entry get]
278 # puts "pixel size = $pixel_size"
279 if { $pixel_size < 100 } { return}
280 set w .wpx
281 if ![winfo exists $w] {
282 toplevel $w
283
284 frame $w.pxs
285 label $w.pxs.tag -font $helv12 -text "Set a reasonable pixel size"
286 entry $w.pxs.entry -width 6 -validate key -vcmd { string is double %P }
287 $w.pxs.entry insert 0 $pixel_size
288
289 frame $w.buttons
290 button $w.buttons.ok -text OK -command "setPixelSize_and_DestroyWindow $w $theimg"
291 button $w.buttons.cancel -text Cancel -command "destroy $w"
292
293 pack $w.pxs.tag $w.pxs.entry -side left -pady 5
294 pack $w.buttons.ok $w.buttons.cancel -side left -expand 1
295 pack $w.pxs $w.buttons -side top -fill x -pady 2m
296
297 bind $w <Return> "setPixelSize_and_DestroyWindow $w $theimg"
298 } else {
299 wm deiconify $w
300 raise $w
301 }
302 wm title $w "Pixel Size"
303 wm iconname $w "Pixel Size"
304 tkwait window $w
305 }
306
307 ## @brief Sets the pixel size.
308 #
309 # @param w the window to destroy.
310 # @param theimg Image identifier.
311
312 proc setPixelSize_and_DestroyWindow { w theimg } {
313 set pixel_size [$w.pxs.entry get]
314 destroy $w
315 set wc [getControlWindow $theimg]
316 $wc.pixel_size.entry delete 0 end
317 $wc.pixel_size.entry insert 0 $pixel_size
318 setPixelsize $theimg
319 setStep $theimg
320 }
321
322 ## @brief Sets the reciprocal space step size.
323 #
324 # @param theimg Image identifier.
325
326 proc setStep { theimg } {
327 global step
328 set pixel_size [Bimage get $theimg pixel_size]
329 set width [Bimage get $theimg width]
330 set step [expr 1.0 / ($pixel_size * $width)]
331 }
332
333 ## @brief Updates all the CTF curves
334 #
335
336 proc updateCTF { } {
337 global theimg project_item
338 global step
339 global ctf_win_x ctf_win_y
340 set w .wctf
341 if [winfo exists $w] {
342 set wc [getControlWindow $theimg]
343 set n [$wc.image.scale get]
344 set mg_item [micrographItem $n]
345 set idx [Bmg get $mg_item index_of_mg]
346 $w.mgid.str config -text "$mg_item"
347 $w.mgid.idx config -text "$idx"
348 setStep $theimg
349 drawEllipse $theimg
350 drawCTF
351 set ctf_win_x [winfo width $w]
352 set ctf_win_y [winfo height $w]
353 } else {
354 set c [getImageCanvas $theimg]
355 $c delete ellipse
356 }
357 }
358
359 ## @brief Sets the defocus average
360 #
361 # @param def_avg Defocus average.
362
363 proc setDefocusAverage { def_avg } {
364 global project_item theimg
365 set wc [getControlWindow $theimg]
366 set n [$wc.image.scale get]
367 set mg_item [micrographItem $n]
368 set w .wctf
369 Bmg set $mg_item defocus [expr 1e4 * [$w.def_avg_scale get]]
370 updateCTF
371 }
372
373 ## @brief Sets the defocus deviation
374 #
375 # @param def_dev Defocus deviation.
376
377 proc setDefocusDeviation { def_dev } {
378 global project_item theimg
379 set wc [getControlWindow $theimg]
380 set n [$wc.image.scale get]
381 set mg_item [micrographItem $n]
382 set w .wctf
383 Bmg set $mg_item defocus_deviation [expr 1e4 * [$w.def_dev_scale get]]
384 updateCTF
385 }
386
387 ## @brief Sets the astigmatism angle
388 #
389 # @param ast_ang Astigmatism angle in degrees.
390
391 proc setAstigmatismAngle { ast_ang } {
392 global project_item theimg
393 set wc [getControlWindow $theimg]
394 set n [$wc.image.scale get]
395 set mg_item [micrographItem $n]
396 set w .wctf
397 Bmg set $mg_item astigmatism_angle [$w.ast_ang_scale get]
398 updateCTF
399 }
400
401 ## @brief Calculates the wavelength
402 #
403
404 proc getWavelength {} {
405 set volt [expr 1000 * [.wctf.vca.volt_entry get]]
406 return [expr 12.26 / sqrt($volt * (1 + $volt * 0.9788e-6))]
407 }
408
409 ## @brief Returns the first zero at the average defocus
410
411 proc getFirstZero { } {
412 global project_item theimg
413 set wc [getControlWindow $theimg]
414 set n [$wc.image.scale get]
415 set mg_item [micrographItem $n]
416 # puts "Getting the first zero"
417 set firstzero [Bmg get $mg_item zero]
418 if !$firstzero { set firstzero 0}
419 return $firstzero
420 }
421
422 ## @brief Returns all the zeroes at the average defocus
423
424 proc getZeroes { } {
425 set Cs [expr 1e7 * [.wctf.vca.cs_entry get]]
426 set lambda [getWavelength]
427 # puts "Wavelength $lambda angstrom"
428 set invl2Cs [expr 1.0 / ($lambda * $lambda * $Cs)]
429 set inv2l3Cs [expr 2.0 / ($lambda * $lambda * $lambda * $Cs)]
430 set def_avg [expr 1e4 * [.wctf.def_avg_scale get]]
431 set ctf_fz [expr $def_avg * $invl2Cs]
432 set max_s [expr 0.5 / [.pixel_size.entry get]]
433 set nz [expr lambda*def_avg*max_s*max_s - $lambda*$lambda*$lambda*$Cs*max_s*max_s*max_s*max_s/2]
434 if { $nz < 1 } { set nz 1}
435 set zeroes ""
436 for {set i 0} {$i < $nz} {incr i 1} {
437 set nt [expr ($i+1)*$inv2l3Cs]
438 set ctf_fz2 [expr $ctf_fz * $ctf_fz]
439 if { $ctf_fz2 > $nt } {
440 append zeroes " " [expr sqrt(ctf_fz - sqrt(ctf_fz2 - $nt))]
441 }
442 }
443 return $zeroes
444 }
445
446 ## @brief Calculates the radial power spectrum
447 #
448
449 proc calcRPS { } {
450 global project_item theimg
451 global rps
452 set wc [getControlWindow $theimg]
453 set n [$wc.image.scale get]
454 set mg_item [micrographItem $n]
455 set rps [Bmg rps $mg_item]
456 if { [lsearch $rps "Radial"] > -1 } {
457 tk_messageBox -message $rps \
458 -icon question -type ok \
459 -detail "The defocus or Cs values may be invalid!"
460 set rps ""
461 }
462 if { [llength $rps] < 1 } {
463 tk_messageBox -message "The radial average was not calculated!" \
464 -icon question -type ok \
465 -detail "Project item $mg_item"
466 }
467 }
468
469 ## @brief Calculates the contrast transfer function
470 #
471
472 proc calcCTF { } {
473 global PI step
474 global base envl
475 global rps ctf
476 set Cs [expr 1e7 * [.wctf.vca.cs_entry get]]
477 set ampfac [.wctf.vca.amp_entry get]
478 set phifac [expr sqrt(1 - $ampfac * $ampfac)]
479 set base_eq [.wctf.base_eq.entry get]
480 set env_eq [.wctf.env_eq.entry get]
481 set def_avg [expr 1e4 * [.wctf.def_avg_scale get]]
482 set lambda [getWavelength]
483 set hpil3Cs [expr 0.5 * $PI * $lambda * $lambda * $lambda * $Cs];
484 set pil [expr $PI * $lambda];
485 set n [llength $rps]
486 set base ""
487 set envl ""
488 set ctf ""
489 # puts $base_eq
490 # puts $env_eq
491 for {set i 0} {$i < $n} {incr i 1} {
492 set s [expr $i * $step]
493 set s2 [expr $s * $s]
494 set s3 [expr $s * $s2]
495 set s4 [expr $s2 * $s2]
496 set dphi [expr $hpil3Cs*$s4 - $pil*$def_avg*$s2]
497 set amp [expr $ampfac*cos($dphi) - $phifac*sin($dphi)]
498 set e [expr $env_eq]
499 set b [expr $base_eq]
500 set c [expr $amp * $amp]
501 append base " " $b
502 append envl " " $e
503 append ctf " " $c
504 }
505 }
506
507 ## @brief Returns the RMSD between the experimental and calculated RPS curves.
508
509 proc calcR { } {
510 global theimg
511 global step base envl
512 global ctf rps
513 global ctf_hires ctf_lores
514 set wc [getControlWindow $theimg]
515 set pixel_size [$wc.pixel_size.entry get]
516 set lores [.wctf.pp.lores_entry get]
517 set hires [.wctf.pp.hires_entry get]
518 if { $hires < [expr 2.1 * $pixel_size] } {
519 set hires [expr 2.1 * $pixel_size]
520 .wctf.pp.hires_entry delete 0 end
521 .wctf.pp.hires_entry insert 0 $hires
522 set ctf_hires $hires
523 }
524 if { $lores < $hires } {
525 set lores [expr 2 * $hires]
526 .wctf.pp.lores_entry delete 0 end
527 .wctf.pp.lores_entry insert 0 $lores
528 set ctf_lores $lores
529 }
530 set nr [llength $rps]
531 set ilo [expr int(1.0 / ($lores*$step))]
532 set ihi [expr int(1.0 / ($hires*$step))]
533 if { $ihi <= $ilo } { set ihi [expr $ilo + 1]}
534 if { $ilo < 1 } { set ilo 1}
535 if { $ihi >= $nr } { set ihi [expr $nr - 1]}
536 set n 0.0
537 set R 0.0
538 for {set i $ilo} {$i <= $ihi} {incr i 1} {
539 set c [expr [lindex $base $i] + [lindex $envl $i] * [lindex $ctf $i]]
540 set d [expr [lindex $rps $i] - $c]
541 set w 1.0
542 # set w [expr 1.0 - [lindex $ctf $i]]
543 if { $w > 0 } {
544 set R [expr $R + $d * $d * $w]
545 set n [expr $n + $w]
546 }
547 }
548 if { $n > 0 } {
549 set R [expr sqrt($R/$n)]
550 } else {
551 set R 1000.0
552 }
553 return $R
554 }
555
556 ## @brief Attempts an automatic fit of the baseline, envelope and CTF functions
557
558 proc autoCTFfit { level } {
559 global project_item theimg
560 global cont_update base_type env_type
561 set wc [getControlWindow $theimg]
562 set n [$wc.image.scale get]
563 set mg_item [micrographItem $n]
564 set w .wctf
565 setCTFparam
566 set lo_res [$w.pp.lores_entry get]
567 set hi_res [$w.pp.hires_entry get]
568 set def_start [expr [$w.def.start get] * 1e4]
569 set def_end [expr [$w.def.end get] * 1e4]
570 set def_inc [expr [$w.def.inc get] * 1e4]
571 # puts "Fitting the CTF"
572 # puts "base_type=$base_type"
573 set ps [Bmg get $mg_item pixel_size]
574 if { $ps > 1.5 } { # Make sure we are not trying to fit the water ring
575 if { $base_type > 3 } {
576 set base_type [expr $base_type - 3]
577 }
578 }
579 set old_env_type [Bmg get $mg_item envelope_type]
580 Bmg set $mg_item baseline_type $base_type
581 Bmg set $mg_item envelope_type $env_type
582 set result [Bmg ctf_fit $mg_item $level $lo_res $hi_res $def_start $def_end $def_inc]
583 if { $level == 1 && $env_type != $old_env_type } {
584 set result [Bmg ctf_fit $mg_item 2 $lo_res $hi_res]
585 }
586 # puts $result
587 if { [string length $result] < 2 } { return}
588 $w.base_eq.entry delete 0 end
589 $w.base_eq.entry insert 0 [lindex $result 0]
590 $w.env_eq.entry delete 0 end
591 $w.env_eq.entry insert 0 [lindex $result 1]
592 $w.def_avg_scale set [expr 1e-4 * [lindex $result 2]]
593 $w.def_dev_scale set [expr 1e-4 * [lindex $result 3]]
594 $w.ast_ang_scale set [lindex $result 4]
595 if { $level == 4 } { set cont_update 1}
596 updateCTF
597 }
598
599 ## @brief Draws a number of ellipses at the CTF zeroes.
600 #
601 # @param theimg Image identifier.
602
603 proc drawEllipse { theimg } {
604 global PI show_rings step
605 set c [getImageCanvas $theimg]
606 $c delete ellipse
607 if { $show_rings < 1 } { return}
608 set wc [getControlWindow $theimg]
609 set pixel_size [$wc.pixel_size.entry get]
610 set Cs [expr 1e7 * [.wctf.vca.cs_entry get]]
611 set phi [expr asin([.wctf.vca.amp_entry get]) / $PI]
612 set lambda [getWavelength]
613 # puts "Wavelength $lambda angstrom"
614 set invl2Cs [expr 1.0 / ($lambda * $lambda * $Cs)]
615 set inv2l3Cs [expr 2.0 / ($lambda * $lambda * $lambda * $Cs)]
616 set width [Bimage get $theimg width]
617 set height [Bimage get $theimg height]
618 set scale [$wc.scale.scale get]
619 # set originx [expr $scale * ($width + 1) / 2]
620 # set originy [expr $scale * ($height + 2) / 2]
621 set originx [expr $scale * $width / 2]
622 set originy [expr $scale * $height / 2]
623 set def_avg [expr 1e4 * [.wctf.def_avg_scale get]]
624 set def_dev [expr 1e4 * [.wctf.def_dev_scale get]]
625 set ast_ang [expr [.wctf.ast_ang_scale get] * $PI / 180]
626 if { $def_dev > [expr 0.99 * $def_avg] } {
627 set def_dev [expr 0.99 * $def_avg]
628 .wctf.def_dev_scale set [expr $def_dev * 1e-4]
629 }
630 set ellip2 [expr ( $def_avg + $def_dev ) / ( $def_avg - $def_dev )]
631 set fz [expr $def_avg * $invl2Cs]
632 set fz2 [expr $fz * $fz]
633 set nmax [expr int($lambda * $def_avg / (4 * $pixel_size * $pixel_size))]
634 # puts $nmax
635 if { $nmax > 10 } { set nmax 10}
636 for { set n 1} { $n < $nmax } { incr n 1} {
637 set r $width
638 set t [expr ($n - $phi) * $inv2l3Cs]
639 if { $fz2 > $t } {
640 set r [expr ($scale / $step) * sqrt($fz - sqrt($fz2 - $t))]
641 }
642 # puts "Pixel distance $r"
643 set xl [expr $originx + $r * sqrt( ($ellip2 + 1) / \
644 (2 * ($ellip2 * cos($ast_ang) * cos($ast_ang) + sin($ast_ang) * sin($ast_ang))) )]
645 set yl $originy
646 for {set i 0} {$i < 360} {incr i 5} {
647 set a [expr $i * $PI / 180]
648 set da [expr $a - $ast_ang]
649 set re [expr $r * sqrt( ($ellip2 + 1) / \
650 (2 * ($ellip2 * cos($da) * cos($da) + sin($da) * sin($da))) )]
651 set x [expr $re*cos($a) + $originx]
652 set y [expr $re*sin($a) + $originy]
653 # y is flipped because the canvas origin is upper left
654 set y [expr $scale * $height - $y]
655 if { [expr $i % 10] == 0 } {
656 $c create line $xl $yl $x $y -fill yellow -smooth yes -width 1 -tags ellipse
657 }
658 set xl $x
659 set yl $y
660 }
661 }
662 }
663
664 ## @brief Draws four curves: baseline, envelope, CTF and RPS
665 #
666
667 proc drawCTF { } {
668 global cont_update sub_base
669 global bl step
670 global base envl ctf rps
671 global plot_height
672 global ctf_scale_x ctf_scale_y
673 if { $cont_update || [string length $rps] < 2 } {
674 calcRPS
675 }
676 set c .wctf.plot
677 set R [calcCTF]
678 set base_line ""
679 set env_line ""
680 set ctf_line ""
681 set rps_line ""
682 $c delete xscale
683 $c delete ctf
684 $c delete rps
685 # set pixel_size [.pixel_size.entry get]
686 set orix [.wctf.pp.ox_entry get]
687 set oriy [expr $plot_height - [.wctf.pp.oy_entry get]]
688 set ctf_scale_x [.wctf.pp.sx_entry get]
689 set ctf_scale_y [.wctf.pp.sy_entry get]
690 set wri [lindex $rps end]
691 lreplace $rps end end
692 set n [llength $rps]
693 for {set i 1} {$i < $n} {incr i 1} {
694 set x [expr $orix + $ctf_scale_x * $i]
695 if { [string length $rps] > 2 } {
696 set y [lindex $rps $i]
697 } else {
698 set y 0
699 }
700 set b [lindex $base $i]
701 set e [lindex $envl $i]
702 set cv [lindex $ctf $i]
703 if { $sub_base } {
704 set y [expr $y - $b]
705 set cv [expr $e * $cv]
706 set b 0
707 } else {
708 set cv [expr $b + $e * $cv]
709 set e [expr $b + $e]
710 }
711 if { [string length $rps] > 2 } {
712 set y [expr $oriy - $ctf_scale_y * $y]
713 append rps_line " " $x " " $y
714 }
715 set b [expr $oriy - $ctf_scale_y * $b]
716 set e [expr $oriy - $ctf_scale_y * $e]
717 set cv [expr $oriy - $ctf_scale_y * $cv]
718 append base_line " " $x " " $b
719 append env_line " " $x " " $e
720 append ctf_line " " $x " " $cv
721 }
722 $c create line $base_line -fill green -smooth yes -width 1 -tags ctf
723 $c create line $env_line -fill orange -smooth yes -width 1 -tags ctf
724 $c create line $ctf_line -fill red -smooth yes -width 1 -tags ctf
725 if { [string length $rps_line] > 2 } {
726 $c create line $rps_line -fill blue -smooth yes -width 1.5 -tags rps
727 }
728 $c create line $orix 0 $orix [expr 2 * $oriy] \
729 -fill black -smooth yes -width 1 -tags xscale
730 $c create line $orix $oriy [expr $orix + $ctf_scale_x * $n] $oriy \
731 -fill black -smooth yes -width 1 -tags xscale
732 set res 0
733 for {set i 0} {$i < $n} {incr i 50} {
734 set x [expr $orix + $ctf_scale_x * $i]
735 if { $i } { set res [format "%5.1f" [expr 1.0 /($i*$step)]]}
736 $c create text $x [expr $oriy + 10] -text $res -fill black -tags xscale
737 $c create line $x $oriy $x [expr $oriy - 5] -fill black -smooth yes -width 1 -tags xscale
738 }
739 set lores [.wctf.pp.lores_entry get]
740 set x [expr $orix + $ctf_scale_x/($lores*$step)]
741 # puts "$oriy $plot_height"
742 $c create line $x 0 $x $plot_height \
743 -fill green -smooth yes -width 1 -tags xscale
744 set hires [.wctf.pp.hires_entry get]
745 set x [expr $orix + $ctf_scale_x/($hires*$step)]
746 $c create line $x 0 $x $plot_height \
747 -fill green -smooth yes -width 1 -tags xscale
748 set R [calcR]
749 # set Z [expr 1.0 / [getFirstZero]]
750 set Z [getFirstZero]
751 $c create text [expr $orix + 300] 30 -text [format "R = %10.6f" $R] -anchor w -fill black -tags rps
752 $c create text [expr $orix + 300] 50 -text [format "First zero = %10.2f A" $Z] -anchor w -fill black -tags rps
753 $c create text [expr $orix + 300] 70 -text [format "Water ring index = %8.4f" $wri] -anchor w -fill black -tags rps
754 }
755
756 ## @brief Shows the spatial frequency at that point where the mouse is moved.
757 #
758 # @param c Canvas object.
759 # @param x
760 # @param y Coordinates on the canvas.
761
762 proc showFrequency { c x y } {
763 global step
764 global ctf_scale_x
765 set orix [.wctf.pp.ox_entry get]
766 set r [expr $ctf_scale_x * 1.0 / (($x - $orix)*$step)]
767 set w .wctf
768 $w.pp.value config -text [format "%6.2f" $r]
769 }
770
771 ## @brief Saves CTF curves to a text file
772 #
773
774 proc writeCTF { } {
775 global theimg
776 global step base envl
777 global ctf rps
778 if { [string length $rps] < 2 } { return}
779 set filename [Bimage get $theimg filename]
780 set ctffile "[file rootname [file tail $filename]].txt"
781 set ctffile [tk_getSaveFile -initialfile $ctffile -defaultextension .txt]
782 if { [string length $ctffile] < 1 } { return}
783 set fctf [open $ctffile w]
784 set wc [getControlWindow $theimg]
785 set pixel_size [$wc.pixel_size.entry get]
786 set n [llength $rps]
787 set w .wctf
788 puts $fctf "File name: $filename"
789 puts $fctf "Pixel size: $pixel_size angstrom/pixel"
790 puts $fctf "Acceleration voltage: [$w.vca.volt_entry get] kV"
791 puts $fctf "Cs: [$w.vca.cs_entry get] mm"
792 puts $fctf "Amplitude contribution: [$w.vca.amp_entry get]"
793 puts $fctf "Defocus average: [$w.def_avg_scale get] um"
794 puts $fctf "Defocus deviation: [$w.def_dev_scale get] um"
795 puts $fctf "Astigmatism angle: [$w.ast_ang_scale get] degrees"
796 puts $fctf "Baseline: [$w.base_eq.entry get]"
797 puts $fctf "Envelope: [$w.env_eq.entry get]"
798 puts $fctf "First zero: [getFirstZero] angstrom"
799 puts $fctf " "
800 puts $fctf "s Baseline Envelope CTF RPS"
801 for {set i 0} {$i < $n} {incr i 1} {
802 set s [expr $step * $i]
803 set b [lindex $base $i]
804 set e [lindex $envl $i]
805 set c [lindex $ctf $i]
806 set r [lindex $rps $i]
807 puts $fctf "$s $b $e $c $r"
808 }
809 puts $fctf " "
810 close $fctf
811 }
812
813
814 ## @brief Updates CTF parameters from the micrograph parameters in memory.
815 #
816
817 proc getCTFparam { } {
818 global project_item theimg imgtype
819 global filename
820 global volt Cs amp_fac base_type env_type
821 set w .wctf
822 if ![winfo exists $w] { return}
823 if ![Bmg exists] { return}
824 set wc [getControlWindow $theimg]
825 set n [$wc.image.scale get]
826 set mg_item [micrographItem $n]
827 if { $imgtype != "ps" } { return}
828 # if [regexp "Field" $project_item] { return }
829 # puts "Updating CTF parameters: $project_item"
830 # set idx [Bmg get $project_item index_of_mg]
831 set idx [Bmg get $mg_item index_of_mg]
832 set volt [expr 0.001 * [Bmg get $mg_item volt]]
833 set Cs [expr 1e-7 * [Bmg get $mg_item Cs]]
834 set amp_fac [Bmg get $mg_item amp_fac]
835 set defocus [expr 1e-4 * [Bmg get $mg_item defocus]]
836 # puts "Updating CTF parameters: defocus = $defocus"
837 set def_dev [expr 1e-4 * [Bmg get $mg_item defocus_deviation]]
838 set ast_ang [Bmg get $mg_item astigmatism_angle]
839 set base_eq [Bmg get $mg_item baseline]
840 set base_type [Bmg get $mg_item baseline_type]
841 set env_eq [Bmg get $mg_item envelope]
842 set env_type [Bmg get $mg_item envelope_type]
843 # puts "Baseline type = $base_type"
844 if { $volt < 1 } { set volt 120}
845 if { $Cs < 0.000001 } { set Cs 2}
846 if { $amp_fac < 0 } { set amp_fac 0}
847 if { $amp_fac > 1 } { set amp_fac 1}
848 if { $defocus < 0.001 } { set defocus 2}
849 if { [string length $base_eq] < 1 } { set base_eq {0.2*exp(-5000*$s2) + 0.14*exp(-300*$s2) + 0.4}}
850 if { [string length $env_eq] < 1 } { set env_eq {0.2*exp(-1000*$s2)}}
851 set filename [Bmg get $mg_item filename ps]
852 # puts "Updating CTF parameters: $mg_item"
853 # puts "Power spectrum filename: -$filename-"
854 wm title $w [list "CTF:" $filename "(" $n ")"]
855 $w.mgid.str config -text "$mg_item"
856 $w.mgid.idx config -text "$idx"
857 $w.vca.volt_entry delete 0 end
858 $w.vca.volt_entry insert 0 $volt
859 $w.vca.cs_entry delete 0 end
860 $w.vca.cs_entry insert 0 $Cs
861 $w.vca.amp_entry delete 0 end
862 $w.vca.amp_entry insert 0 $amp_fac
863 $w.def_avg_scale set $defocus
864 $w.def_dev_scale set $def_dev
865 $w.ast_ang_scale set $ast_ang
866 $w.base_eq.entry delete 0 end
867 $w.base_eq.entry insert 0 $base_eq
868 $w.env_eq.entry delete 0 end
869 $w.env_eq.entry insert 0 $env_eq
870 calcRPS
871 updateCTF
872 # puts "Updated CTF parameters"
873 }
874
875 ## @brief Saves CTF parameters to the micrograph parameters in memory.
876 #
877
878 proc setCTFparam { } {
879 set w .wctf
880 if ![winfo exists $w] { return}
881 global project_item theimg
882 global volt Cs amp_fac base_type env_type
883 global ctf_hires ctf_lores
884 set wc [getControlWindow $theimg]
885 set n [$wc.image.scale get]
886 set mg_item [micrographItem $n]
887 set volt [$w.vca.volt_entry get]
888 set Cs [$w.vca.cs_entry get]
889 set amp_fac [$w.vca.amp_entry get]
890 set ctf_lores [$w.pp.lores_entry get]
891 set ctf_hires [$w.pp.hires_entry get]
892 if ![Bmg exists] { createMgParam}
893 set filename [Bmg get $mg_item filename ps]
894 wm title $w [list "CTF:" $filename "(" $n ")"]
895 Bmg set $mg_item volt [expr 1000 * $volt]
896 Bmg set $mg_item Cs [expr 1e7 * $Cs]
897 Bmg set $mg_item amp_fac $amp_fac
898 Bmg set $mg_item defocus [expr 1e4 * [$w.def_avg_scale get]]
899 Bmg set $mg_item defocus_deviation [expr 1e4 * [$w.def_dev_scale get]]
900 Bmg set $mg_item astigmatism_angle [$w.ast_ang_scale get]
901 Bmg set $mg_item baseline_type $base_type
902 Bmg set $mg_item baseline [$w.base_eq.entry get]
903 Bmg set $mg_item envelope_type $env_type
904 Bmg set $mg_item envelope [$w.env_eq.entry get]
905 Bmg get $mg_item zero
906 # puts "Setting CTF parameters: base_type=$base_type"
907 }