| Bsoft 2.0.5 Bernard's software package

bshow_model.tcl
Go to the documentation of this file.
1 ##
2 # @file bshow_model.tcl
3 #
4 # @brief Procedures to create and destroy model components and links in images.
5 #
6 # @author Bernard Heymann
7 # @date Created: 20010516
8 # @date Modified: 20160601
9
10 set modelfile ""
11 set modeldir ""
12 set comp_radius 0
13 set link_radius 0
14 set comp_selected 0
15 set link_selected []
16 set show_comp 1
17 set show_comp_labels 1
18 set comp_selection "Current"
19 set selected_color "#ffffff"
20 set color_selection "Selection"
21 set types_selected []
22 set line_width 1
23
24 ## @brief Menu for opening and closing parameter files
25 #
26
27 proc setupModelMenu {} {
28 global modelfile
29
30 .menuBar add cascade -menu .menuBar.model -label "Model" -underline 0
31 menu .menuBar.model -tearoff 0
32 .menuBar.model add command -label "Read model" -underline 0 \
33 -command { readModel }
34 .menuBar.model add command -label "Write model" -underline 0 \
35 -command { writeModel }
36 .menuBar.model add command -label "Edit model" -underline 0 \
37 -command { editTextFile $modelfile }
38 .menuBar.model add command -label "Set views" -underline 0 \
39 -command { setViews }
40 .menuBar.model add command -label "Delete all components" -underline 0 \
41 -command { objectsDeleteAll }
42 .menuBar.model add command -label "Delete non-selected components" -underline 0 \
43 -command { deleteNonSelectedObjects }
44 .menuBar.model add command -label "Add or update component type" -underline 0 \
45 -command { createUpdateComponentType }
46 .menuBar.model add command -label "Extract marked segments" -underline 0 \
47 -command { extractSegments }
48 .menuBar.model add command -label "Generate particles" -underline 0 \
49 -command { componentsToParticles }
50 .menuBar.model add command -label "Analyze component symmetry" -underline 0 \
51 -command { componentSymmetry }
52 # .menuBar.model add command -label "Help" -underline 0 \
53 # -command { showURL "file://$Bsoft/doc/bshow/bshow_model.html" }
54 }
55
56 ## @brief Dialog box to manipulate componets and links on the main canvas
57 #
58
59 proc Model { } {
60 global theimg filename project_item
61 global helv12 cour12
62 global comp_radius link_radius
63 global selected_color color_selection line_width comp_selection
64
65 if ![Bimage exists $theimg] {
66 tk_dialog .dialog "No image in memory!" \
67 {Please read in an appropriate image first.} \
68 info 0 {OK}
69 return
70 }
71
72 if ![Bmodel exists] {
73 set project_item [Bmodel create]
74 }
75 set c [getImageCanvas $theimg]
76 set modid [Bmodel get $project_item id]
77 set modsel [Bmodel get $project_item selection]
78 set ncomp [Bmodel component $project_item count]
79 set nlink [Bmodel link $project_item count]
80 set ps [.pixel_size.entry get]
81 if { $comp_radius < $ps } { set comp_radius [expr 2*$ps]}
82 if { $link_radius < $ps } { set link_radius [expr $ps]}
83 set w .wmod
84 if ![winfo exists $w] {
85 toplevel $w
86
87 frame $w.modid
88 label $w.modid.tag -text "Model" -width 15 -anchor e
89 label $w.modid.str -width 50 -text $modid -relief sunken -bd 1 \
90 -font $helv12 -anchor w
91 label $w.modid.sel -width 5 -text $modsel -relief sunken -bd 1 \
92 -font $helv12 -anchor w
93
94 frame $w.comp
95 label $w.comp.tag -text "Components" -width 15 -anchor e
96 label $w.comp.num -width 10 -text $ncomp -relief sunken -bd 1 \
97 -font $helv12 -anchor w
98 label $w.comp.tag2 -text "Selected" -width 15 -anchor e
99 label $w.comp.sel -width 10 -text $ncomp -relief sunken -bd 1 \
100 -font $helv12 -anchor w
101
102 frame $w.link
103 label $w.link.tag -text "Links" -width 15 -anchor e
104 label $w.link.num -width 10 -text $nlink -relief sunken -bd 1 \
105 -font $helv12 -anchor w
106 label $w.link.tag2 -text "Selected" -width 15 -anchor e
107 label $w.link.sel -width 10 -text $nlink -relief sunken -bd 1 \
108 -font $helv12 -anchor w
109
110 frame $w.curr
111 label $w.curr.tag -text "Current" -width 15 -anchor e
112 label $w.curr.id -width 10 -text " " -relief sunken -bd 1 \
113 -font $helv12 -anchor w
114 label $w.curr.tag2 -text "FOM" -width 15 -anchor e
115 label $w.curr.fom -width 10 -text " " -relief sunken -bd 1 \
116 -font $helv12 -anchor w
117
118 frame $w.dist
119 label $w.dist.tag -text "Distance" -width 15 -anchor e
120 label $w.dist.val -width 10 -text " " -relief sunken -bd 1 \
121 -font $helv12 -anchor w
122
123 frame $w.switches
124 checkbutton $w.switches.components -text "Show components" -variable show_comp \
125 -command { objectsDrawAll }
126 checkbutton $w.switches.labels -text "Show labels" -variable show_comp_labels \
127 -command { objectsDrawAll }
128 label $w.switches.widthlabel -text "Line width" -width 10 -anchor e
129 tk_optionMenu $w.switches.linewidth line_width 1 2 3 4 5 6 7 8 9 10
130
131 frame $w.select
132 label $w.select.tag -text "Select" -anchor w -width 20
133 tk_optionMenu $w.select.menu comp_selection \
134 "Current" "Selected" "Selected Types" "None" "All"
135
136 frame $w.compradius
137 button $w.compradius.tag -text "Component radius" -width 20 \
138 -anchor e -command setComponentRadius
139 entry $w.compradius.entry -width 10 -validate key -vcmd { string is double %P }
140 $w.compradius.entry insert 0 $comp_radius
141
142 frame $w.linkradius
143 button $w.linkradius.tag -text "Link radius" -width 20 \
144 -anchor e -command setLinkRadius
145 entry $w.linkradius.entry -width 10 -validate key -vcmd { string is double %P }
146 $w.linkradius.entry insert 0 $link_radius
147
148 frame $w.color
149 button $w.color.button -text "Color" -anchor w -width 20 -command setColor
150 canvas $w.color.well -width 30 -height 30 -relief sunken \
151 -borderwidth 2 -background $selected_color
152 tk_optionMenu $w.color.menu color_selection \
153 "All" "Selection" "By Density" "By FOM"
154
155 frame $w.fom
156 label $w.fom.label -text "FOM cutoff" -anchor w
157 scale $w.fom.scale -orient horizontal -length 200 -from 0 -to 1 \
158 -command { setFOMcutoff } -resolution 0.001
159
160 frame $w.neighbor
161 button $w.neighbor.prev -text "Previous model" \
162 -relief raised -command "getNeighborImageOfType2 -1"
163 button $w.neighbor.next -text "Next model" \
164 -relief raised -command "getNeighborImageOfType2 1"
165
166 label $w.header -font $cour12 -anchor w \
167 -text " Type Number Mass FOM Select Image File"
168
169 frame $w.frame
170 text $w.table -relief sunken -bd 2 -width 70 \
171 -yscrollcommand "$w.yscroll set" \
172 -setgrid 1 -highlightthickness 0 -pady 2 -padx 3 -font $cour12
173 scrollbar $w.yscroll -command "$w.table yview" \
174 -highlightthickness 0 -orient vertical
175 grid $w.table -in $w.frame -padx 1 -pady 1 \
176 -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
177 grid $w.yscroll -in $w.frame -padx 1 -pady 1 \
178 -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
179 grid rowconfig $w.frame 0 -weight 1 -minsize 0
180 grid columnconfig $w.frame 0 -weight 1 -minsize 0
181
182
183 pack $w.modid.tag $w.modid.str $w.modid.sel\
184 -side left -pady 5 -padx 10
185 pack $w.comp.tag $w.comp.num $w.comp.tag2 $w.comp.sel \
186 -side left -pady 5 -padx 10
187 pack $w.link.tag $w.link.num $w.link.tag2 $w.link.sel \
188 -side left -pady 5 -padx 10
189 pack $w.curr.tag $w.curr.id $w.curr.tag2 $w.curr.fom -side left -pady 5 -padx 10
190 pack $w.dist.tag $w.dist.val -side left -pady 5 -padx 10
191 pack $w.switches.components $w.switches.labels \
192 $w.switches.widthlabel $w.switches.linewidth -side left -pady 5 -padx 5
193 pack $w.select.tag $w.select.menu -side left -pady 5 -padx 10
194 pack $w.compradius.tag $w.compradius.entry -side left -pady 5 -padx 10
195 pack $w.linkradius.tag $w.linkradius.entry -side left -pady 5 -padx 10
196 pack $w.color.button $w.color.well $w.color.menu -side left -pady 5 -padx 10
197 pack $w.fom.label -side top -fill x
198 pack $w.fom.scale -side top -fill x
199 pack $w.neighbor.prev $w.neighbor.next \
200 -side left -pady 5 -padx 5 -ipadx 5 -ipady 5
201 pack $w.modid $w.comp $w.link $w.curr $w.dist $w.switches $w.select \
202 $w.compradius $w.linkradius $w.color $w.fom $w.neighbor \
203 -side top -fill x -pady 2
204 pack $w.header -side top -fill x -padx 5
205 pack $w.frame -expand yes -fill both -padx 5 -pady 5
206
207 } else {
208 wm deiconify $w
209 raise $w
210 }
211 wm title $w "Model"
212 wm iconname $w "Model"
213 .menuBar.window entryconfigure "Model" -state normal
214 bind $c <1> "componentCreateSelect %x %y"
215 bind $c <2> "linkCreate %x %y"
216 bind $c <Shift-1> "componentDelete %x %y"
217 bind $c <Shift-2> "linkDelete %x %y"
218 bind $c <B1-Motion> "componentMove %x %y"
219 bind $c <B2-Motion> "componentMove %x %y"
220 bind . <u> "componentMoveSelectedUpDown 1"
221 bind . <d> "componentMoveSelectedUpDown -1"
222 bind $w <Return> "objectsDrawAll"
223 bind $w <Control-w> { destroy .wmod }
224 bind $w <Command-w> { destroy .wmod }
225 bind $w.color.well <1> { selectColor .wmod.color.well }
226 trace add variable comp_selection write setSelection
227 trace add variable line_width write objectsDrawAll
228 objectsDrawAll
229 updateCompTypeTable
230 }
231
232 proc toggleCompTypeSelection { id sel } {
233 global project_item
234 # puts "$id $sel"
235 if { $sel } {
236 Bmodel comptype $project_item deselect $id
237 } else {
238 Bmodel comptype $project_item select $id
239 }
240 updateCompTypeTable
241 }
242
243 ## @brief Updates the component type table from the model parameters in memory.
244 #
245
246 proc updateCompTypeTable { } {
247 global project_item types_selected
248 set w .wmod
249 if ![winfo exists $w] { return}
250 if ![Bmodel exists] { return}
251 set types [Bmodel comptype $project_item list]
252 # puts "Updating type table"
253 $w.table delete 0.0 end
254 set types_selected []
255 foreach {id fmod img_num num mass fom sel} $types {
256 $w.table insert end \
257 [format "%-10s %5d %9.0f %7.3f %5d %5d %s\n" $id $num $mass $fom $sel $img_num $fmod] $id
258 if { $sel } {
259 $w.table tag configure $id -background #aaaaff -borderwidth 1
260 lappend types_selected $id
261 } else {
262 $w.table tag configure $id -background {}
263 }
264 $w.table tag bind $id <Button-1> "toggleCompTypeSelection $id $sel"
265 }
266 # puts $types_selected
267 }
268
269 ## @brief Converts image coordinates to model coordinates.
270 #
271 # @param x
272 # @param y
273 # @param z Position in image coordinates.
274
275 proc convertImageToModel { x y z } {
276 global theimg
277 set ps [.pixel_size.entry get]
278 set ori [Bimage get $theimg origin [.image.scale get]]
279 set x [expr ($x - [lindex $ori 0])*$ps]
280 set y [expr ($y - [lindex $ori 1])*$ps]
281 set z [expr ($z - [lindex $ori 2])*$ps]
282 # puts "1 $x $y $z"
283 return "$x $y $z"
284 }
285
286 ## @brief Selects a component.
287 #
288 # @param x
289 # @param y Position in canvas coordinates.
290
291 proc componentSelect { x y } {
292 set w .wmod
293 if ![winfo exists $w] { return}
294 global theimg project_item
295 global comp_selected
296 # global tool
297 global px py
298 set c [getImageCanvas $theimg]
299 set scale [.scale.scale get]
300 set n [.image.scale get]
301 set z [.slice.scale get]
302 set px [expr floor( [$c canvasx $x] / $scale )]
303 set py [expr floor( [$c canvasy $y] / $scale )]
304 set pyi [yFlip $py]
305 set id1 $comp_selected
306 set loc [convertImageToModel $px $pyi $z]
307 set id [Bmodel component $project_item select [lindex $loc 0] [lindex $loc 1] [lindex $loc 2]]
308 # puts "selected comp = $id"
309 set comp_selected $id
310 if { $id > 0 } {
311 componentDraw $id
312 }
313 set fom [Bmodel component $project_item fom $id]
314 set dist [Bmodel component $project_item distance $id $id1]
315 $w.comp.sel config -text [Bmodel component $project_item countselected]
316 $w.curr.id config -text $id
317 $w.curr.fom config -text [format "%8.2f" $fom]
318 $w.compradius.entry delete 0 end
319 $w.compradius.entry insert 0 [Bmodel component $project_item radius $id]
320 if { $dist } {
321 $w.dist.val config -text [format "%8.2f" $dist]
322 } else {
323 $w.dist.val config -text " "
324 }
325 return $id
326 }
327
328 ## @brief Selects a link.
329 #
330 # @param x
331 # @param y Position in canvas coordinates.
332
333 proc linkSelect { x y } {
334 set w .wmod
335 if ![winfo exists $w] { return}
336 global theimg project_item
337 global link_selected link_radius
338 # global tool
339 global px py
340 set c [getImageCanvas $theimg]
341 set scale [.scale.scale get]
342 set n [.image.scale get]
343 set z [.slice.scale get]
344 set px [expr floor( [$c canvasx $x] / $scale )]
345 set py [expr floor( [$c canvasy $y] / $scale )]
346 set pyi [yFlip $py]
347 set loc [convertImageToModel $px $pyi $z]
348 set id [Bmodel link $project_item select [lindex $loc 0] [lindex $loc 1] [lindex $loc 2] $link_radius]
349 # puts "selected link = $id ($loc)"
350 if { [llength $id] > 1 } {
351 linkDraw [lindex $id 0] [lindex $id 1]
352 }
353 set link_selected $id
354 return $id
355 }
356
357 ## @brief Creates or updates a component type.
358 #
359
360 proc createUpdateComponentType { } {
361 if ![winfo exists .wmod] { return}
362 global project_item
363 set w .wnct
364 catch {destroy $w}
365 toplevel $w
366 wm title $w "Component type"
367 wm iconname $w "Type"
368 tkwait visibility $w
369 grab $w
370 set type [Bmodel comptype $project_item firstselected]
371 label $w.label -text "Create or update a component type" -anchor w
372 frame $w.type
373 label $w.type.label -text "Type name" -anchor w
374 entry $w.type.entry -width 10
375 $w.type.entry insert 0 [lindex $type 0]
376 frame $w.mass
377 label $w.mass.label -text "Mass" -anchor w
378 entry $w.mass.entry -width 10 -validate key -vcmd { string is double %P }
379 $w.mass.entry insert 0 [lindex $type 4]
380 frame $w.file
381 label $w.file.label -text "File name" -anchor w
382 entry $w.file.entry -width 10
383 $w.file.entry insert 0 [lindex $type 1]
384 frame $w.img_num
385 label $w.img_num.label -text "Image number" -anchor w
386 entry $w.img_num.entry -width 10 -validate key -vcmd { string is integer %P }
387 $w.img_num.entry insert 0 [lindex $type 2]
388 frame $w.buttons
389 button $w.buttons.set -text Set -command {
390 set n [.image.scale get]
391 Bmodel comptype $project_item create [.wnct.type.entry get] [.wnct.mass.entry get] \
392 [.wnct.file.entry get] [.wnct.img_num.entry get]
393 destroy .wnct
394 }
395 button $w.buttons.cancel -text Cancel -command "destroy $w"
396 pack $w.type.label $w.type.entry -side left -fill x
397 pack $w.mass.label $w.mass.entry -side left -fill x
398 pack $w.file.label $w.file.entry -side left -fill x
399 pack $w.img_num.label $w.img_num.entry -side left -fill x
400 pack $w.buttons.set $w.buttons.cancel -side left -expand 1
401 pack $w.label $w.type $w.mass $w.file $w.img_num $w.buttons -side top -fill x -pady 2m
402 tkwait window $w
403 updateCompTypeTable
404 }
405
406 ## @brief Creates or selects a component.
407 #
408 # @param x
409 # @param y Component position in canvas coordinates.
410
411 proc componentCreateSelect { x y } {
412 set w .wmod
413 if ![winfo exists $w] { return}
414 global theimg project_item
415 global comp_selected
416 global comp_radius selected_color
417 global tool
418 global px py
419 set c [getImageCanvas $theimg]
420 set comp_radius [$w.compradius.entry get]
421 set scale [.scale.scale get]
422 set n [.image.scale get]
423 set z [.slice.scale get]
424 set px [expr floor( [$c canvasx $x] / $scale )]
425 set py [expr floor( [$c canvasy $y] / $scale )]
426 # set h [Bimage get theimg height]
427 # set pyi [expr $h - $py - 1]
428 set pyi [yFlip $py]
429 set loc [convertImageToModel $px $pyi $z]
430 set id [Bmodel component $project_item select [lindex $loc 0] [lindex $loc 1] [lindex $loc 2]]
431 # puts "selected ID = $id"
432 if { $id < 1 && $tool == "model" } {
433 if { [Bmodel comptype $project_item countselected] < 1 } { createUpdateComponentType}
434 set id [Bmodel component $project_item create [lindex $loc 0] [lindex $loc 1] [lindex $loc 2]]
435 Bmodel component $project_item radius $id $comp_radius
436 Bmodel component $project_item color $selected_color $id
437 # puts "created ID = $id color = $selected_color"
438 }
439 if { $id > 0 } {
440 componentDraw $id
441 }
442 set id1 $comp_selected
443 set comp_selected $id
444 set fom [Bmodel component $project_item fom $id]
445 set dist [Bmodel component $project_item distance $id $id1]
446 $w.comp.num config -text [Bmodel component $project_item count]
447 $w.comp.sel config -text [Bmodel component $project_item countselected]
448 $w.curr.id config -text $id
449 $w.curr.fom config -text [format "%8.2f" $fom]
450 $w.compradius.entry delete 0 end
451 $w.compradius.entry insert 0 [Bmodel component $project_item radius $id]
452 if { $dist } {
453 $w.dist.val config -text [format "%8.2f" $dist]
454 } else {
455 $w.dist.val config -text " "
456 }
457 updateCompTypeTable
458 }
459
460 ## @brief Creates a link if a starting component is selected
461 #
462 # @param x
463 # @param y Ending component position in canvas coordinates.
464
465 proc linkCreate { x y } {
466 set w .wmod
467 if ![winfo exists $w] { return}
468 global project_item comp_selected
469 if { $comp_selected < 1 } { return}
470 set n [.image.scale get]
471 set id $comp_selected
472 componentCreateSelect $x $y
473 if { $id == $comp_selected } { return}
474 set link_selected "$id $comp_selected"
475 Bmodel link $project_item create $id $comp_selected
476 linkDraw $id $comp_selected
477 # set i [Bmodel link $project_item count $n]
478 # $w.link.num config -text "$i"
479 $w.link.num config -text [Bmodel link $project_item count]
480 $w.link.num config -text [Bmodel link $project_item countselected]
481 }
482
483 ## @brief Moves the selected component to the new coordinates.
484 #
485 # @param x
486 # @param y Component position in canvas coordinates.
487
488 proc componentMove { x y } {
489 set w .wmod
490 if ![winfo exists $w] { return}
491 global theimg project_item
492 global comp_selected
493 global px py
494 if { $comp_selected < 1 } { return}
495 set c [getImageCanvas $theimg]
496 set scale [.scale.scale get]
497 set n [.image.scale get]
498 set ix [expr [$c canvasx $x] / $scale]
499 set iy [expr [$c canvasy $y] / $scale]
500 set dx [expr $ix - $px]
501 set dy [expr $py - $iy]
502 set px $ix
503 set py $iy
504 # puts "Moving $dx $dy"
505 set ps [.pixel_size.entry get]
506 set dx [expr $dx * $ps]
507 set dy [expr $dy * $ps]
508 Bmodel component $project_item move $comp_selected $dx $dy
509 objectsDrawAll
510 }
511
512 ## @brief Moves the selected component one slice up or down.
513 #
514 # @param dz Number of slices (+ up, - down)
515
516 proc componentMoveSelectedUpDown { dz } {
517 set w .wmod
518 if ![winfo exists $w] { return}
519 global theimg project_item comp_selected
520 # puts "Moving $comp_selected up/down $dz"
521 if { $comp_selected < 1 } { return}
522 set n [.image.scale get]
523 set nslices [Bimage get $theimg nslices]
524 set z [expr [.slice.scale get] + $dz]
525 if { $z < 0 } { set z 0}
526 if { $z >= $nslices } { set z [expr $nslices - 1]}
527 set ps [.pixel_size.entry get]
528 set dz [expr $dz * $ps]
529 Bmodel component $project_item move $comp_selected 0 0 $dz
530 .slice.scale set $z
531 }
532
533 ## @brief Draws a component on the canvas.
534 #
535 # @param id Component identifier.
536
537 proc componentDraw { id } {
538 global theimg project_item
539 global show_comp_labels comp_selected line_width
540 set c [getImageCanvas $theimg]
541 set n [.image.scale get]
542 set comp [Bmodel component $project_item img_coords $id]
543 # puts $comp
544 set lbl ""
545 set fill 0
546 if { $show_comp_labels } { set lbl $id}
547 drawSphere $c [lindex $comp 1] [lindex $comp 2] [lindex $comp 3] [lindex $comp 4] [lindex $comp 5] $line_width $lbl $fill component
548 }
549
550 proc drawSphere { c x y z rad col width lbl fill tag } {
551 # puts "drawSphere $x $y $z"
552 set scale [.scale.scale get]
553 if { $rad < 1 } { set rad 1}
554 set zr [expr [.slice.scale get] - $z]
555 if { $zr >= $rad } { return}
556 set r [expr $rad*$rad - $zr*$zr]
557 if { $r < 0 } { return}
558 set xy_radius [expr $scale*sqrt($r)]
559 set rad [expr $rad * $scale]
560 set h [Bimage get theimg height]
561 set x [expr $x * $scale]
562 set y [expr ($h - $y - 1) * $scale]
563 # set y [yFlip $py]
564 set xmin [expr $x - $xy_radius]
565 set xmax [expr $x + $xy_radius + $scale - 1]
566 set ymin [expr $y - $xy_radius]
567 set ymax [expr $y + $xy_radius + $scale - 1]
568 set symbol "-outline"
569 if { $fill } { set symbol "-fill"}
570 $c create oval $xmin $ymin $xmax $ymax $symbol $col -width $width -tags $tag
571 if { [string length $lbl] } {
572 $c create text $xmax $ymax -text $lbl -fill $col -anchor w -tags $tag
573 }
574 }
575
576 proc drawLine { c x1 y1 z1 x2 y2 z2 width col tag } {
577 # puts "drawLine $x1 $y1 $z1 $x2 $y2 $z2"
578 set scale [.scale.scale get]
579 set width [expr int($width * $scale)]
580 if { $width < 1 } { set width 1}
581 set z [.slice.scale get]
582 set h [Bimage get theimg height]
583 set xs [expr $x1 * $scale]
584 set ys [expr ($h - $y1 - 1) * $scale]
585 set zs $z1
586 set xe [expr $x2 * $scale]
587 set ye [expr ($h - $y2 - 1) * $scale]
588 set ze $z2
589 set zf -1.0
590 if { abs($ze - $zs) > 0.001 } {
591 set zf [expr ($z - $zs) / (1.0*($ze - $zs))]
592 } else {
593 if { abs($z - $zs) < 0.9 } { set zf 0.5}
594 }
595 if { $xs == $xe && $ys == $ye } { set xe [expr $xe + 1]}
596 if { $zf >= 0.0 && $zf <= 1.0 } {
597 $c create line $xs $ys $xe $ye -fill $col -smooth yes -width $width -tags link
598 }
599 }
600
601 ## @brief Draws a link line connecting two components on the canvas.
602 #
603 # @param id1 Component 1 identifier.
604 # @param id2 Component 2 identifier.
605
606 proc linkDraw { id1 id2 } {
607 global theimg project_item
608 global show_comp fom_cutoff
609 if { $show_comp < 1 } { return}
610 set c [getImageCanvas $theimg]
611 set scale [.scale.scale get]
612 set n [.image.scale get]
613 set linkcoor [Bmodel link $project_item img_coords $id1 $id2]
614 set fom1 [Bmodel component $project_item fom $id1]
615 set fom2 [Bmodel component $project_item fom $id2]
616 # puts "Link: $loc1 $fom1 $loc2 $fom2"
617 if { $fom1 < $fom_cutoff || $fom2 < $fom_cutoff } { return}
618 drawLine $c [lindex $linkcoor 0] [lindex $linkcoor 1] [lindex $linkcoor 2] \
619 [lindex $linkcoor 3] [lindex $linkcoor 4] [lindex $linkcoor 5] \
620 [lindex $linkcoor 6] [lindex $linkcoor 7] link
621 }
622
623 ## @brief Draws all components and links on the canvas.
624 #
625
626 proc objectsDrawAll args {
627 # puts "Drawing all objects"
628 componentsDrawAll
629 linksDrawAll
630 }
631
632 ## @brief Draws all components on the canvas.
633 #
634
635 proc componentsDrawAll { } {
636 global theimg project_item
637 global show_comp fom_cutoff
638 global show_comp_labels comp_selected line_width
639 set c [getImageCanvas $theimg]
640 $c delete component
641 set w .wmod
642 if ![winfo exists $w] { return}
643 if { $show_comp < 1 } { return}
644 # set n [.image.scale get]
645 # puts "Drawing components ($project_item)"
646 set comps [Bmodel component $project_item img_coords $fom_cutoff]
647 foreach {id x y z rad color} $comps {
648 # puts "Drawing $id"
649 set lbl ""
650 if { $show_comp_labels } { set lbl $id}
651 set fill 0
652 # puts $color
653 drawSphere $c $x $y $z $rad $color $line_width $lbl $fill component
654 }
655 $w.modid.str config -text [Bmodel get $project_item id]
656 $w.modid.sel config -text [Bmodel get $project_item selection]
657 $w.comp.num config -text [Bmodel component $project_item count]
658 $w.comp.sel config -text [Bmodel component $project_item countselected]
659 }
660
661 ## @brief Draws all links on the canvas.
662 #
663
664 proc linksDrawAll { } {
665 global theimg project_item
666 global show_comp fom_cutoff
667 # puts "linksDrawAll"
668 set c [getImageCanvas $theimg]
669 $c delete link
670 set w .wmod
671 if ![winfo exists $w] { return}
672 if { $show_comp < 1 } { return}
673 set n [.image.scale get]
674 set links [Bmodel link $project_item img_coords $fom_cutoff]
675 # puts [llength $links]
676 foreach {x1 y1 z1 x2 y2 z2 rad color} $links {
677 drawLine $c $x1 $y1 $z1 $x2 $y2 $z2 $rad $color link
678 }
679 $w.link.num config -text [Bmodel link $project_item count]
680 $w.link.sel config -text [Bmodel link $project_item countselected]
681 }
682
683 ## @brief Deletes the selected component.
684 #
685 # @param x
686 # @param y Cooordinates on the canvas.
687
688 proc componentDelete { x y } {
689 if ![winfo exists .wmod] { return}
690 global project_item
691 set n [.image.scale get]
692 set id [componentSelect $x $y]
693 # puts "ID to be deleted = $id"
694 if { $id > 0 } {
695 Bmodel component $project_item delete $id
696 }
697 objectsDrawAll
698 }
699
700 ## @brief Deletes the selected link.
701 #
702 # @param x
703 # @param y Cooordinates on the canvas.
704
705 proc linkDelete { x y } {
706 if ![winfo exists .wmod] { return}
707 global project_item
708 set n [.image.scale get]
709 set id [linkSelect $x $y]
710 # puts "link ID to be deleted = $id"
711 if { [llength $id] > 1 } {
712 Bmodel link $project_item delete [lindex $id 0] [lindex $id 1]
713 }
714 objectsDrawAll
715 }
716
717 ## @brief Deletes all components and links.
718 #
719
720 proc objectsDeleteAll { } {
721 global theimg
722 set c [getImageCanvas $theimg]
723 $c delete component link
724 Bmodel delete
725 set w .wmod
726 if [winfo exists $w] {
727 $w.comp.num config -text "0"
728 $w.comp.sel config -text "0"
729 $w.link.num config -text "0"
730 $w.link.sel config -text "0"
731 }
732 }
733
734 ## @brief Deletes all components and links that are not selected.
735 #
736
737 proc deleteNonSelectedObjects { } {
738 Bmodel delete_non_selected
739 objectsDrawAll
740 updateCompTypeTable
741 }
742
743 ## @brief Sets radii of selected components.
744 #
745
746 proc setComponentRadius { } {
747 global project_item
748 global comp_radius comp_selection
749 set comp_radius [.wmod.compradius.entry get]
750 if { [string compare $comp_selection "Current"] == 0 } {
751 set id [.wmod.curr.id cget -text]
752 Bmodel set $project_item compradius $id $comp_radius
753 } else {
754 Bmodel set $project_item compradius $comp_radius
755 }
756 objectsDrawAll
757 }
758
759 ## @brief Sets radii of selected links.
760 #
761
762 proc setLinkRadius { } {
763 global project_item
764 global link_radius
765 set link_radius [.wmod.linkradius.entry get]
766 Bmodel set $project_item linkradius $link_radius
767 objectsDrawAll
768 }
769
770 ## @brief Sets the selection of components.
771 #
772
773 proc setSelection args {
774 global project_item comp_selected comp_selection types_selected
775 # puts $comp_selection
776 if { [string compare $comp_selection "All"] == 0 } {
777 Bmodel component $project_item select all
778 } elseif { [string compare $comp_selection "None"] == 0 } {
779 Bmodel component $project_item select none
780 } elseif { [string compare $comp_selection "Selected Types"] == 0 } {
781 Bmodel component $project_item select types $types_selected
782 }
783 objectsDrawAll
784 updateCompTypeTable
785 }
786
787 ## @brief Sets the color for selected components.
788 #
789
790 proc setColor { } {
791 global project_item color_selection selected_color types_selected
792 if { [string compare $color_selection "All"] == 0 } {
793 Bmodel component $project_item color all $selected_color
794 } elseif { [string compare $color_selection "Selection"] == 0 } {
795 Bmodel component $project_item color selected $selected_color
796 } elseif { [string compare $color_selection "By Density"] == 0 } {
797 Bmodel component $project_item color density
798 } elseif { [string compare $color_selection "By FOM"] == 0 } {
799 Bmodel component $project_item color fom
800 }
801 objectsDrawAll
802 }
803
804 ## @brief Sets the views relative to the origin.
805 #
806
807 proc setViews { } {
808 global project_item
809 Bmodel set $project_item views
810 }
811
812 ## @brief Extracts all panels tagged by the component list.
813 #
814
815 proc extractSegments { } {
816 global filetypes fom_cutoff
817 if ![Bmodel exists] { return}
818
819 set xname [tk_getSaveFile -filetypes $filetypes \
820 -initialfile "panels.tif" -defaultextension .tif]
821 if { [string length $xname] < 1 } { return}
822
823 set multi_level 1
824 Bmodel extract_segments $xname $multi_level
825 }
826
827 ## @brief Generates particles from the component list.
828 #
829
830 proc componentsToParticles { } {
831 if ![Bmodel exists] { return}
832 global project_item
833 createMgParam
834 Bmodel components_to_particles $project_item
835 }
836
837 ## @brief Reads model from a file.
838 #
839
840 proc readModel { } {
841 global filename
842 global modelfile modeldir
843 global comp_radius
844 # if { ![Bimage exists $theimg] } {
845 # set i [tk_dialog .dialog "No image!" \
846 # {Please read an image associated with the model first.} \
847 # info 0 {OK}]
848 # return
849 # }
850 if ![Bmodel exists] { set modeldir [file dirname $filename]}
851 set currdir $modeldir
852 if { [string length $currdir] < 2 } { set currdir [pwd]}
853 set currdir [pwd]
854 set types {
855 {"STAR files" {.star .STAR} }
856 {"XML files" {.xml .XML} }
857 {"PDB files" {.pdb .PDB} }
858 {"CMM files" {.cmm .CMM} }
859 {"Vega files" {.v3d .V3D} }
860 }
861 if { [string length $modelfile] < 1 } { set $modelfile "model.star"}
862 # puts "$modeldir $modelfile ($currdir) ([pwd])"
863 # puts [file pathtype $currdir]
864 # puts [file exists $currdir]
865 # puts [file system $currdir]
866 # puts [file nativename $modelfile]
867 set modelfile [tk_getOpenFile -title "Open model file" -filetypes $types \
868 -initialfile $modelfile -initialdir $currdir -defaultextension .star]
869 # puts "$modeldir $modelfile"
870 if { [string length $modelfile] < 1 } { return}
871 objectsDeleteAll
872 loadModel $modelfile
873 }
874
875 # loadModel
876 # Read model into the model structures.
877 #
878 # @param thefile Model file name.
879
880 proc loadModel { thefile } {
881 global filename project_item
882 global modelfile modeldir
883 global comp_radius
884 set project_item "all"
885 Bmodel read $thefile
886 set ids [Bmodel component $project_item ids 0]
887 foreach id $ids {
888 set comp_radius [Bmodel component $project_item radius $id]
889 }
890 set modeldir [file dirname $thefile]
891 set modelfile [file tail $thefile]
892 selectAFile
893 wm title . [list $filename ":" $modelfile]
894 Model
895 }
896
897 ## @brief Saves the component and link model to a file.
898 #
899
900 proc writeModel { } {
901 global filename
902 global project_item
903 global modelfile modeldir
904 set currdir $modeldir
905 if { [string length $currdir] < 2 } { set currdir [pwd]}
906 # set ncomp [Bmodel component $project_item count]
907 # set nlink [Bmodel link $project_item count]
908 # puts "Number of components and links: $ncomp $nlink"
909 set model_name [file rootname [file tail $filename]]
910 if { [string length $modelfile] < 1 } {
911 set modelfile $model_name
912 append modelfile "_model.star"
913 }
914 set modelfile [file tail $modelfile]
915 set types {
916 {"STAR files" {.star .STAR} }
917 {"XML files" {.xml .XML} }
918 {"PDB files" {.pdb .PDB} }
919 {"CMM files" {.cmm .CMM} }
920 {"Vega files" {.v3d .V3D} }
921 }
922 set modelfile [tk_getSaveFile -filetypes $types \
923 -initialfile $modelfile -initialdir $currdir -defaultextension .star]
924 if { [string length $modelfile] < 1 } { return}
925 set modelfile [relativePath $modeldir $modelfile]
926 if ![Bmodel exists] {
927 set project_item [Bmodel create]
928 }
929 Bmodel set $project_item map $filename
930 Bmodel write $modelfile
931 wm title . [list $filename ":" $modelfile]
932 writeSettingsFile
933 }
934
935 ## @brief Edits a text parameter file.
936 #
937
938 proc editModel { } {
939 global modelfile modeldir
940 if [file exists $modelfile] {
941 editTextFile $modelfile
942 }
943 }
944
945 ## @brief Dialog box for creating a shell (ring for 2D)
946 #
947
948 proc Shell { } {
949 global helv12
950
951 Model
952
953 set w .wsph
954 if ![winfo exists $w] {
955 toplevel $w
956
957 label $w.lab -font $helv12 -text \
958 "Only two of the three parameters should be specified"
959
960 setupEntry $w.num "Number" integer 0 "The number of components in the shell"
961 setupEntry $w.rad "Radius (angstrom)" double 0 "The shell radius in angstrom"
962 setupEntry $w.dist "Distance (angstrom)" double 0 "The distance between components in angstrom"
963
964 frame $w.buttons
965 button $w.buttons.do -text Do -command "doCreateShell $w"
966 button $w.buttons.close -text Close -command "destroy $w"
967 pack $w.buttons.do $w.buttons.close -side left -expand 1
968
969 pack $w.lab $w.num $w.rad $w.dist $w.buttons -side top -fill x -pady 2m
970
971 } else {
972 wm deiconify $w
973 raise $w
974 }
975 wm title $w "Shell"
976 wm iconname $w "Shell"
977 # .menuBar.window entryconfigure "Shell" -state normal
978 }
979
980 ## @brief Analyzes model components to determine cyclic symmetry.
981 #
982
983 proc componentSymmetry { } {
984 Model
985
986 set w .wsym
987 if ![winfo exists $w] {
988 toplevel $w
989
990 label $w.lab -text "Analyzing component symmetry"
991
992 setupEntry $w.min "Minimum symmetry" integer 1 "The smallest cyclic symmetry to test for"
993 setupEntry $w.max "Maximum symmetry" integer 20 "The largest cyclic symmetry to test for"
994 setupEntry $w.ann "Annular width (pixels)" double 10 "The number of annuli in pixels to integrate over"
995
996 frame $w.buttons
997 button $w.buttons.do -text Do -command "doComponentSymmetry $w"
998 button $w.buttons.close -text Close -command "destroy $w"
999 pack $w.buttons.do $w.buttons.close -side left -expand 1
1000
1001 pack $w.lab $w.min $w.max $w.ann $w.buttons -side top -fill x -pady 2m
1002
1003 } else {
1004 wm deiconify $w
1005 raise $w
1006 }
1007 wm title $w "Symmetry"
1008 wm iconname $w "Symmetry"
1009 }
1010
1011 proc doComponentSymmetry { w } {
1012 global env modelfile
1013 set min [$w.min.e get]
1014 set max [$w.max.e get]
1015 set ann [$w.ann.e get]
1016 if { ![file exists $modelfile] } {
1017 puts "$modelfile not found!"
1018 }
1019 set logfile "[file rootname $modelfile]_sym.log"
1020 set cmd "$env(BSOFT)/bin/bmodsym -verb 1 -all -find $min,$max -ann $ann $modelfile"
1021 executeCommand $cmd $logfile
1022 }
1023