| Bsoft 2.0.5 Bernard's software package

bshow_filament.tcl
Go to the documentation of this file.
1 ##
2 # @file bshow_filament.tcl
3 #
4 # @brief Procedures to create, move and destroy filament selections
5 #
6 # @author Bernard Heymann
7 # @date Created: 20020808
8 # @date Modified: 20180410
9
10 set show_filaments 1
11 set show_node_labels 1
12 set show_profiles 0
13 set filament_width 40
14 set filament_node_radius 10
15 set boxing_interval 20
16 set helix_rise 0
17 set helix_angle 0
18 set node_selected []
19 set fil_plot_width 350
20 set fil_plot_height 200
21
22 ## @brief Dialog box to manipulate filaments on the main canvas
23 #
24
25 proc Filaments { } {
26 global project_item theimg imgtype
27 global helv12
28 global filament_width filament_node_radius boxing_interval
29 global helix_rise helix_angle
30 global fil_plot_width fil_plot_height
31
32 if ![Bimage exists $theimg] {
33 tk_dialog .dialog "No image in memory!" \
34 {Please read in an appropriate image first.} \
35 info 0 {OK}
36 return
37 }
38
39 set c [getImageCanvas $theimg]
40 if { $filament_width < 1 } { set filament_width 40}
41 if { $filament_node_radius < 1 } { set filament_node_radius [expr int($filament_width / 4)]}
42 if { $filament_node_radius < 1 } { set filament_node_radius 3}
43 if { $boxing_interval < 1 } { set boxing_interval [expr int($filament_width / 2)]}
44 if ![Bmg exists] {
45 createMgParam
46 setMgParam
47 }
48 puts "Launching Particles for $c: $project_item"
49
50 set w .wfil
51 if ![winfo exists $w] {
52 toplevel $w
53 menu $w.menuBar -tearoff 0
54 $w.menuBar add cascade -menu $w.menuBar.fil -label "Filament" -underline 0
55 menu $w.menuBar.fil -tearoff 0
56 $w configure -menu $w.menuBar
57 $w.menuBar.fil add command -label "Help" -underline 0 \
58 -command { showURL "file://$Bsoft/doc/bshow/bshow_fil.html" }
59 # -command { showHelp bshow_filament.hlp }
60 $w.menuBar.fil add command -label "Write filament profile" \
61 -command { filamentProfileWrite } -underline 0
62 $w.menuBar.fil add command -label "Delete selected filament" \
63 -command { filamentDelete } -underline 0
64 $w.menuBar.fil add command -label "Delete all filaments" \
65 -command { filamentDeleteAll } -underline 0
66 $w.menuBar.fil add command -label "Center nodes" \
67 -command { filamentCenterNodes } -underline 0
68 $w.menuBar.fil add command -label "Extract filaments" \
69 -command { filamentExtract } -underline 0
70 $w.menuBar.fil add command -label "Generate particles" \
71 -command { filamentsToParticles } -underline 0
72 $w.menuBar.fil add command -label "Close" \
73 -command { destroy .wfil } -underline 0
74
75 frame $w.fil_width
76 label $w.fil_width.tag -font $helv12 -text "Box width" -width 15 -anchor e
77 entry $w.fil_width.entry -width 10 -validate key -vcmd { string is double %P }
78 $w.fil_width.entry insert 0 $filament_width
79
80 frame $w.node_radius
81 label $w.node_radius.tag -font $helv12 -text "Node radius" -width 15 -anchor e
82 entry $w.node_radius.entry -width 10 -validate key -vcmd { string is double %P }
83 $w.node_radius.entry insert 0 $filament_node_radius
84
85 frame $w.boxing_interval
86 label $w.boxing_interval.tag -font $helv12 -text "Boxing interval" -width 15 -anchor e
87 entry $w.boxing_interval.entry -width 10 -validate key -vcmd { string is double %P }
88 $w.boxing_interval.entry insert 0 $boxing_interval
89
90 frame $w.helix_rise
91 label $w.helix_rise.tag -font $helv12 -text "Helix rise per unit" -width 15 -anchor e
92 entry $w.helix_rise.entry -width 10 -validate key -vcmd { string is double %P }
93 $w.helix_rise.entry insert 0 $helix_rise
94
95 frame $w.helix_angle
96 label $w.helix_angle.tag -font $helv12 -text "Helix angle per unit" -width 15 -anchor e
97 entry $w.helix_angle.entry -width 10 -validate key \
98 -vcmd { expr {[string match {[-+]} %P] || [string is double %P]} }
99 $w.helix_angle.entry insert 0 $helix_angle
100
101 frame $w.fil
102 label $w.fil.tag -font $helv12 -text "Filaments" -width 15 -anchor e
103 label $w.fil.num -width 10 -relief sunken -bd 1 -font $helv12 -anchor w -text "0"
104
105 frame $w.node
106 label $w.node.tag -font $helv12 -text "Nodes" -width 15 -anchor e
107 label $w.node.num -width 10 -relief sunken -bd 1 -font $helv12 -anchor w -text "0"
108
109 frame $w.fil_selected
110 label $w.fil_selected.tag -font $helv12 -text "Selected filament" -width 15 -anchor e
111 label $w.fil_selected.num -width 10 -relief sunken -bd 1 -font $helv12 -anchor w
112
113 frame $w.node_selected
114 label $w.node_selected.tag -font $helv12 -text "Selected node" -width 15 -anchor e
115 label $w.node_selected.num -width 10 -relief sunken -bd 1 -font $helv12 -anchor w
116
117 # frame $w.neighbor
118 # button $w.neighbor.prev -text "Previous micrograph" \
119 # -relief raised -command "getNeighborImageOfType -1"
120 # button $w.neighbor.next -text "Next micrograph" \
121 # -relief raised -command "getNeighborImageOfType 1"
122 #
123 setupMicrographButtons $w.neighbor "micrograph"
124
125 set g $w.plot
126 canvas $g -width [expr $fil_plot_width + 10] -height [expr $fil_plot_height + 10] \
127 -background white -relief sunken -borderwidth 2
128
129 frame $w.switches
130 checkbutton $w.switches.filaments -text "Show filaments" -variable show_filaments \
131 -command { filamentsDrawAll }
132 checkbutton $w.switches.labels -text "Show labels" -variable show_node_labels \
133 -command { filamentsDrawAll }
134 checkbutton $w.switches.profiles -text "Show profiles" -variable show_profiles
135
136 pack $w.node_radius.tag $w.node_radius.entry -side left -pady 5 -padx 10
137 pack $w.fil_width.tag $w.fil_width.entry -side left -pady 5 -padx 10
138 pack $w.boxing_interval.tag $w.boxing_interval.entry -side left -pady 5 -padx 10
139 pack $w.helix_rise.tag $w.helix_rise.entry -side left -pady 5 -padx 10
140 pack $w.helix_angle.tag $w.helix_angle.entry -side left -pady 5 -padx 10
141 pack $w.fil.tag $w.fil.num -side left -pady 5 -padx 10
142 pack $w.node.tag $w.node.num -side left -pady 5 -padx 10
143 pack $w.fil_selected.tag $w.fil_selected.num -side left -pady 5 -padx 10
144 pack $w.node_selected.tag $w.node_selected.num -side left -pady 5 -padx 10
145 # pack $w.neighbor.prev $w.neighbor.next \
146 # -side left -pady 5 -padx 5 -ipadx 5 -ipady 5
147 pack $w.switches.filaments $w.switches.labels $w.switches.profiles \
148 -side left -pady 5 -padx 5
149 pack $w.fil_width $w.node_radius $w.boxing_interval $w.helix_rise \
150 $w.helix_angle $w.fil $w.node \
151 $w.fil_selected $w.node_selected $w.neighbor $w.plot $w.switches -side top -fill x -pady 2
152
153 } else {
154 wm deiconify $w
155 raise $w
156 }
157 wm title $w "Filaments"
158 wm iconname $w "Filaments"
159 .menuBar.window entryconfigure "Filaments" -state normal
160 bind $c <1> "nodeCreateSelect %x %y"
161 bind $c <2> "filamentCreate %x %y"
162 bind $c <Command-1> "filamentCreate %x %y"
163 bind $c <Control-1> "filamentCreate %x %y"
164 bind $c <Shift-1> "nodeDelete %x %y"
165 bind $c <Shift-2> "nodeDelete %x %y"
166 bind $c <B1-Motion> "nodeMove %x %y"
167 bind $c <B2-Motion> "nodeMove %x %y"
168 # bind $c <ButtonRelease> "filamentsDrawAll"
169 # bind $c <ButtonRelease> "drawSpline %W"
170 bind $w <Return> "Update 0"
171 bind $w <Control-w> { destroy .wfil }
172 bind $w <Command-w> { destroy .wfil }
173 # updateNodeParam
174 filamentsDrawAll
175 }
176
177 ## @brief Sets the node radius from the dialog box.
178
179 proc setNodeRadius { } {
180 if ![winfo exists .wfil] { return}
181 global filament_node_radius project_item
182 set filament_node_radius [.wfil.node_radius.entry get]
183 Bmg set $project_item filament_node_radius $filament_node_radius
184 }
185
186 ## @brief Starts a new filament
187 #
188 # @param x
189 # @param y First node position in canvas coordinates.
190
191 proc filamentCreate { x y } {
192 global node_selected
193 set node_selected []
194 nodeCreateSelect $x $y
195 }
196
197 ## @brief Creates or selects a node.
198 #
199 # @param x
200 # @param y Node position in canvas coordinates.
201
202 proc nodeCreateSelect { x y } {
203 if ![winfo exists .wfil] { return}
204 global theimg
205 global node_selected
206 global tool
207 set snid $node_selected
208 set node_selected [nodeSelect $x $y]
209 if { [llength $node_selected] > 0 } { return}
210 if { $tool != "filament" } { return}
211 set wc [getControlWindow $theimg]
212 setNodeRadius
213 set n [$wc.image.scale get]
214 set mg_item [micrographItem $n]
215 set loc [imageCoordinatesFromCanvas $x $y]
216 set id [Bmg node $mg_item create [lindex $loc 0] [lindex $loc 1] [lindex $loc 2] [lindex $snid 0] [lindex $snid 1]]
217 if { [llength $id] > 0 } {
218 nodeDraw [lindex $id 0] [lindex $id 1]
219 # puts "created ID = $id"
220 }
221 set node_selected $id
222 filamentUpdateSelected
223 filamentsDrawAll
224 # filamentDraw [lindex $node_selected 0]
225 }
226
227 ## @brief Selects a node on the canvas.
228 #
229 # @param x
230 # @param y Node position in window coordinates.
231 #
232 # @returns node_selected Index of the selected node, 0 if none selected.
233
234 proc nodeSelect { x y } {
235 if ![winfo exists .wfil] { return}
236 global theimg
237 global node_selected
238 set wc [getControlWindow $theimg]
239 setNodeRadius
240 set n [$wc.image.scale get]
241 set mg_item [micrographItem $n]
242 set loc [imageCoordinatesFromCanvas $x $y]
243 # puts $loc
244 set id [Bmg node $mg_item select [lindex $loc 0] [lindex $loc 1] [lindex $loc 2]]
245 if { [llength $id] > 0 } {
246 nodeDraw [lindex $id 0] [lindex $id 1]
247 # puts "selected ID = $id"
248 }
249 set node_selected $id
250 filamentUpdateSelected
251 # drawSelectedNode $c
252 return $node_selected
253 }
254
255 ## @brief Moves the selected node
256 #
257 # @param x
258 # @param y Node position in canvas coordinates.
259
260 proc nodeMove { x y } {
261 global theimg
262 global node_selected
263 global px py
264 if { [llength $node_selected] < 1 } { return}
265 set c [getImageCanvas $theimg]
266 set wc [getControlWindow $theimg]
267 set scale [$wc.scale.scale get]
268 set n [$wc.image.scale get]
269 set ix [expr [$c canvasx $x] / $scale]
270 set iy [expr [$c canvasy $y] / $scale]
271 set dx [expr $ix - $px]
272 set dy [expr $py - $iy]
273 set px $ix
274 set py $iy
275 # puts "Moving $dx $dy"
276 set mg_item [micrographItem $n]
277 Bmg node $mg_item move [lindex $node_selected 0] [lindex $node_selected 1] $dx $dy
278 filamentsDrawAll
279 }
280
281 ## @brief Draws a circle for a node on the canvas.
282 #
283 # @param fid Filament identifier.
284 # @param nid Node identifier.
285
286 proc nodeDraw { fid nid } {
287 global theimg
288 global node_selected show_node_labels
289 global filament_color filament_first_color filament_select_color
290 set c [getImageCanvas $theimg]
291 set wc [getControlWindow $theimg]
292 set n [$wc.image.scale get]
293 set z [$wc.slice.scale get]
294 set mg_item [micrographItem $n]
295 set loc [Bmg node $mg_item location $fid $nid]
296 # puts "drawing $fid $nid: $loc"
297 set scale [$wc.scale.scale get]
298 set x [expr [lindex $loc 0] * $scale]
299 set y [expr [yFlip [lindex $loc 1]] * $scale]
300 set zr [expr abs([lindex $loc 2] - $z)]
301 set radius [expr [.wfil.node_radius.entry get] * $scale]
302 set xmin [expr $x - $radius]
303 set xmax [expr $x + $radius + $scale - 1]
304 set ymin [expr $y - $radius]
305 set ymax [expr $y + $radius + $scale - 1]
306 set color $filament_color
307 if { $nid == 1 } {
308 set color $filament_first_color
309 $c create text $xmin $y -text $fid -fill blue -anchor e -tags node
310 }
311 if { $fid == [lindex $node_selected 0] && $nid == [lindex $node_selected 1] } {
312 set color $filament_select_color
313 }
314 $c create oval $xmin $ymin $xmax $ymax -outline $color -width 1 -tags node
315 if { $show_node_labels } {
316 $c create text $xmax $y -text $nid -fill $color -anchor w -tags node
317 }
318 }
319
320 ## @brief Draws a line between two nodes on the canvas.
321 #
322 # @param fid Filament identifier.
323 # @param nid1 Node 1 identifier.
324 # @param nid2 Node 2 identifier.
325
326 proc nodeLinkDraw { fid nid1 nid2 } {
327 global theimg
328 global filament_color
329 set c [getImageCanvas $theimg]
330 set wc [getControlWindow $theimg]
331 set n [$wc.image.scale get]
332 set z [$wc.slice.scale get]
333 set mg_item [micrographItem $n]
334 set loc1 [Bmg node $mg_item location $fid $nid1]
335 set loc2 [Bmg node $mg_item location $fid $nid2]
336 set scale [$wc.scale.scale get]
337 set x1 [expr [lindex $loc1 0] * $scale]
338 set y1 [expr [yFlip [lindex $loc1 1]] * $scale]
339 set x2 [expr [lindex $loc2 0] * $scale]
340 set y2 [expr [yFlip [lindex $loc2 1]] * $scale]
341 set fz -1.0
342 set dz [expr [lindex $loc2 2] - [lindex $loc1 2]]
343 if { $dz == 0 } {
344 set fz [expr [lindex $loc2 2] - $z + 0.5]
345 } else {
346 set fz [expr ([lindex $loc2 2] - $z)/($dz*1.0)]
347 }
348 if { $fz >= 0.0 && $fz <= 1.0 } {
349 $c create line $x1 $y1 $x2 $y2 -fill $filament_color -width 1 -tags fil
350 }
351 }
352
353 ## @brief Draws filament nodes and lines connecting nodes on the canvas
354 #
355
356 proc filamentsDrawAll { } {
357 global theimg
358 global show_filaments
359 set c [getImageCanvas $theimg]
360 set wc [getControlWindow $theimg]
361 $c delete fil node selnode
362 if { $show_filaments < 1 } { return}
363 set n [$wc.image.scale get]
364 set mg_item [micrographItem $n]
365 set ids [Bmg node $mg_item ids]
366 # puts "Node IDs: $ids"
367 updateNodeParam
368 set pfid 0
369 set pnid 0
370 foreach {fid nid} $ids {
371 nodeDraw $fid $nid
372 if { $pfid == $fid } {
373 nodeLinkDraw $fid $pnid $nid
374 }
375 set pfid $fid
376 set pnid $nid
377 }
378 # updateNodeParam
379 }
380
381 ## @brief Updates the selected filament and node in the dialog window
382 #
383
384 proc filamentUpdateSelected { } {
385 if ![winfo exists .wfil] { return}
386 global node_selected project_item
387 # puts "Project item: $project_item"
388 set nfil [Bmg filament $project_item count]
389 set nnode [Bmg node $project_item count]
390 .wfil.fil.num config -text "$nfil"
391 .wfil.node.num config -text "$nnode"
392 if { [llength $node_selected] < 0 } {
393 .wfil.fil_selected.num config -text ""
394 .wfil.node_selected.num config -text ""
395 } else {
396 .wfil.fil_selected.num config -text [lindex $node_selected 0]
397 .wfil.node_selected.num config -text [lindex $node_selected 1]
398 filamentProfilePlot [lindex $node_selected 0] [lindex $node_selected 1]
399 }
400 }
401
402 ## @brief Deletes the selected node.
403 #
404 # @param x
405 # @param y Node position in window coordinates.
406
407 proc nodeDelete { x y } {
408 if ![winfo exists .wfil] { return}
409 global theimg node_selected
410 set wc [getControlWindow $theimg]
411 set n [$wc.image.scale get]
412 set mg_item [micrographItem $n]
413 set id [nodeSelect $x $y]
414 # puts "ID to be deleted = $id"
415 if { [llength $id] > 0 } {
416 Bmg node $mg_item delete [lindex $id 0] [lindex $id 1]
417 set node_selected []
418 }
419 filamentsDrawAll
420 }
421
422 ## @brief Deletes the selected filament.
423 #
424
425 proc filamentDelete { } {
426 if ![winfo exists .wfil] { return}
427 global theimg node_selected project_item
428 set wc [getControlWindow $theimg]
429 set n [$wc.image.scale get]
430 set mg_item [micrographItem $n]
431 if { [llength $node_selected] > 0 } {
432 Bmg filament $mg_item delete [lindex $node_selected 0]
433 set node_selected []
434 }
435 filamentsDrawAll
436 }
437
438 ## @brief Deletes all filaments.
439 #
440
441 proc filamentDeleteAll { } {
442 global theimg project_item
443 set c [getImageCanvas $theimg]
444 Bmg filament $project_item delete all
445 $c delete node selnode
446 $c delete spline
447 $c delete fil
448 filamentUpdateSelected
449 }
450
451 ## @brief Centers filament nodes.
452 #
453
454 proc filamentCenterNodes { } {
455 global filament_width project_item
456 set filament_width [.wfil.fil_width.entry get]
457 puts $project_item
458 Bmg filament $project_item center $filament_width
459 filamentsDrawAll
460 }
461
462 ## @brief Extracts filaments defined in the micrograph parameters.
463 #
464
465 proc filamentExtract { } {
466 global helv12
467 global filament_width project_item
468
469 if { [Bmg node $project_item count] < 1 } {
470 tk_messageBox -icon error -type ok -title "Error" -message \
471 "No filaments picked!"
472 return
473 }
474
475 set w .wfext
476 catch {destroy $w}
477 toplevel $w
478 wm title $w "Extracting filaments"
479 wm iconname $w "ExtFil"
480
481 label $w.msg -font $helv12 -wraplength 4i -justify left \
482 -text {Select parameters for filament extraction}
483
484 frame $w.panel
485
486 frame $w.panel.fil_width
487 label $w.panel.fil_width.tag -font $helv12 -text "Filament width" -width 30 -anchor w
488 entry $w.panel.fil_width.entry -width 10 -relief sunken \
489 -validate key -vcmd { string is double %P }
490 $w.panel.fil_width.entry insert 0 $filament_width
491
492 frame $w.panel.fil_axis
493 label $w.panel.fil_axis.tag -font $helv12 -text "Filament axis" -width 30 -anchor w
494 radiobutton $w.panel.fil_axis.x -text "x" -variable fil_axis -value 1
495 radiobutton $w.panel.fil_axis.y -text "y" -variable fil_axis -value 2
496 radiobutton $w.panel.fil_axis.z -text "z" -variable fil_axis -value 3
497
498 frame $w.panel.path
499 label $w.panel.path.tag -font $helv12 -text "Filament path" -width 10 -anchor w
500 entry $w.panel.path.entry -width 50 -relief sunken
501 $w.panel.path.entry insert 0 ""
502
503 frame $w.check
504 checkbutton $w.check.splitbutton -text "Individual output files" \
505 -width 20 -anchor w -variable fil_split
506
507 frame $w.buttons
508 button $w.buttons.ok -text OK -command "filamentExtract_and_DestroyWindow $w"
509 button $w.buttons.cancel -text Cancel -command "destroy $w"
510
511 pack $w.msg -side top -padx 5 -pady 5
512
513 pack $w.panel.fil_width.tag $w.panel.fil_width.entry -side left -padx 5 -pady 5
514 pack $w.panel.fil_axis.tag $w.panel.fil_axis.x $w.panel.fil_axis.y \
515 $w.panel.fil_axis.z -side left -padx 5 -pady 5
516 pack $w.panel.path.tag $w.panel.path.entry -side left -padx 5 -pady 5
517 pack $w.panel.fil_width $w.panel.fil_axis $w.panel.path -side top
518 pack $w.panel -side top -fill both
519
520 pack $w.check.splitbutton -side left -pady 5 -padx 5
521 pack $w.check -side top -pady 2m
522
523 pack $w.buttons.ok $w.buttons.cancel -side left -padx 5
524 pack $w.buttons -side bottom -pady 2m
525
526 bind $w <Return> "filamentExtract_and_DestroyWindow $w"
527 }
528
529 ## @brief Extracts filaments from the current set of node coordinates.
530 #
531 # @param w Dialog window.
532
533 proc filamentExtract_and_DestroyWindow { w } {
534 global filetypes
535 global filename project_item
536 global filament_width
537 global fil_axis fil_split
538
539 set xname [file root [file tail $filename]]
540 append xname "_fil.pif"
541 set xname [tk_getSaveFile -filetypes $filetypes \
542 -initialfile $xname -defaultextension .pif]
543 if { [string length $xname] < 1 } { return}
544 # puts "Extract from $filename to $xname"
545 set pathname [$w.panel.path.entry get]
546 set filament_width [$w.panel.fil_width.entry get]
547 # set fil_axis 0
548 # puts "Filament axis = $fil_axis split = $fil_split"
549 .wfil.fil_width.entry delete 0 end
550 .wfil.fil_width.entry insert 0 $filament_width
551 Bmg set $project_item pixel_size [.pixel_size.entry get]
552 setMgParam
553 Bmg filament $project_item extract $xname $filament_width $fil_axis $fil_split $pathname
554 destroy $w
555 }
556
557 ## @brief Creates particles on filaments.
558 #
559
560 proc filamentsToParticles { } {
561 global filament_width filament_node_radius boxing_interval
562 global helix_rise helix_angle project_item
563 # puts "toParticles"
564 set filament_width [.wfil.fil_width.entry get]
565 set filament_node_radius [.wfil.node_radius.entry get]
566 set boxing_interval [.wfil.boxing_interval.entry get]
567 set helix_rise [.wfil.helix_rise.entry get]
568 set helix_angle [.wfil.helix_angle.entry get]
569 setMgParam
570 Bmg set $project_item filament_width $filament_width
571 Bmg set $project_item filament_node_radius $filament_node_radius
572 # puts "$filament_width $boxing_interval $helix_rise $helix_angle"
573 set np [Bmg filament $project_item toparticles $filament_width $boxing_interval $helix_rise $helix_angle]
574 # puts "$np particles generated"
575 Particles
576 }
577
578 ## @brief Updates node parameters from the micrograph parameters in memory.
579 #
580
581 proc updateNodeParam { } {
582 global project_item imgtype
583 global filament_width filament_node_radius
584
585 set w .wfil
586 if ![winfo exists $w] { return}
587 # puts "Updating filament parameters"
588 if ![Bmg exists] { createMgParam}
589 set filename [Bmg get $project_item filename $imgtype]
590 # puts "File: $filename"
591 wm title $w [list "Filaments:" $filename]
592 updatePixelsize
593 set filament_width [$w.fil_width.entry get]
594 set filament_node_radius [$w.node_radius.entry get]
595 Bmg set $project_item filament_width $filament_width
596 Bmg set $project_item filament_node_radius $filament_node_radius
597 # puts "$filament_width $filament_node_radius"
598 $w.fil_width.entry delete 0 end
599 $w.fil_width.entry insert 0 $filament_width
600 $w.node_radius.entry delete 0 end
601 $w.node_radius.entry insert 0 $filament_node_radius
602 filamentUpdateSelected
603 }
604
605 ## @brief Plots the selected filament profile in the plot canvas
606 #
607 # @param fid filament identifier.
608 # @param nid node identifier.
609
610 proc filamentProfilePlot { fid nid } {
611 global theimg project_item
612 global filament_width
613 global fil_plot_width fil_plot_height
614 global show_profiles
615
616 if ![winfo exists .wfil] { return}
617 if { $fid < 1 } { return}
618 if { $nid < 1 } { return}
619
620 set g .wfil.plot
621 $g delete filplot
622
623 if !$show_profiles { return}
624
625 set prof [Bmg filament $project_item profile $fid $nid $filament_width]
626 # puts $prof
627 set len [lindex $prof 0]
628 if { $len < 1 } { return}
629
630 set min [lindex $prof 1]
631 set max [lindex $prof 1]
632 for {set i 1} {$i <= $len} {incr i 1} {
633 set v [lindex $prof $i]
634 if { $min > $v } { set min $v}
635 if { $max < $v } { set max $v}
636 }
637 if { $max <= $min } { set max [expr $min + 1]}
638 # puts "profile: $min $max"
639 set xoff 5
640 set yoff [expr $fil_plot_height * ( (3*$max - $min) * 0.25 / ($max - $min)) + 5]
641 set xscale [expr $fil_plot_width*1.0/$len]
642 set yscale [expr $fil_plot_height*0.5/($max - $min)]
643
644 # puts "$yoff $yscale"
645
646 set fp ""
647 set fps ""
648 for {set i 1} {$i <= $len} {incr i 1} {
649 set j [expr $i + $len]
650 set x [expr ($i-1)*$xscale + $xoff]
651 set y [expr $yoff - [lindex $prof $i] * $yscale]
652 set ys [expr $yoff - [lindex $prof $j] * $yscale]
653 append fp " " $x " " $y
654 append fps " " $x " " $ys
655 }
656 $g create line $fp -fill blue -smooth yes -width 1 -tags filplot
657 $g create line $fps -fill red -smooth yes -width 1 -tags filplot
658 set orix [expr $fil_plot_width/2 + $xoff]
659 set oriy $yoff
660 $g create line $orix 0 $orix [expr 2*$yoff + $fil_plot_height] \
661 -fill black -smooth yes -width 1 -tags filplot
662 $g create line 0 $oriy [expr 2*$xoff + $fil_plot_width] $oriy \
663 -fill black -smooth yes -width 1 -tags filplot
664 }
665
666 ## @brief Writes the selected filament profile to a file
667 #
668
669 proc filamentProfileWrite { } {
670 global theimg project_item
671 global node_selected
672 global filament_width
673 if { [llength $node_selected] < 0 } {
674 tk_dialog .dialog "No filament selected!" \
675 {Please select a filament first.} \
676 info 0 {OK}
677 return
678 }
679 set filename [Bimage get $theimg filename]
680 set fprfile "[file rootname [file tail $filename]].txt"
681 set fprfile [tk_getSaveFile -initialfile $fprfile -defaultextension .txt]
682 if { [string length $fprfile] < 1 } { return}
683 set wc [getControlWindow $theimg]
684 set pixel_size [$wc.pixel_size.entry get]
685 set fid [lindex $node_selected 0]
686 set nid [lindex $node_selected 1]
687 set prof [Bmg filament $project_item profile $fid $nid $filament_width]
688 set len [lindex $prof 0]
689 if { $len < 1 } { return}
690 set ffpr [open $fprfile w]
691 puts $ffpr "File name: $filename"
692 puts $ffpr "Filament: $fid"
693 puts $ffpr "Pixel size: $pixel_size angstrom/pixel"
694 puts $ffpr " "
695 puts $ffpr "Pixel Density"
696 for {set i 1} {$i <= $len} {incr i 1} {
697 set v [lindex $prof $i]
698 puts $ffpr "$i $v"
699 }
700 puts $ffpr " "
701 close $ffpr
702 }
703