| Bsoft 2.0.5 Bernard's software package

bshow_select.tcl
Go to the documentation of this file.
1 ##
2 # @file bshow_select.tcl
3 #
4 # @brief Procedures to draw selections in Bshow.
5 #
6 # @author Bernard Heymann
7 # @date Created: 20060811
8 # @date Modified: 20130725
9
10 set seltype "rectangle"
11 set calc_stats 0
12
13 ## @brief Handles selections from the image data.
14 #
15
16 proc Selection { } {
17 global helv12 theimg
18 global selectiontype
19
20 set c [getImageCanvas $theimg]
21
22 if { [info exists selpoly] } { unset selpoly}
23 if ![winfo exists .wsel] {
24 toplevel .wsel
25
26 # menu .wsel.menuBar -tearoff 0
27 # .wsel.menuBar add cascade -menu .wsel.menuBar.his -label "Selection" -underline 0
28 # menu .wsel.menuBar.his -tearoff 0
29 # .wsel configure -menu .wsel.menuBar
30 # .wsel.menuBar.his add command -label "Help" \
31 # -command { showHelp bshow_select.hlp } -underline 0
32 # .wsel.menuBar.his add command -label "Clear" \
33 # -command {
34 # if { [info exists selpoly] } { unset selpoly }
35 # $c delete selection
36 # } -underline 0
37 # .wsel.menuBar.his add command -label "Close" -underline 0 \
38 # -command {
39 # if { [info exists selpoly] } { unset selpoly }
40 # destroy .wsel
41 # }
42
43 frame .wsel.selectiontype
44 label .wsel.selectiontype.tag -text "Type" -width 20 -anchor w
45 tk_optionMenu .wsel.selectiontype.menu selectiontype "Square" "Rectangle" \
46 "Cube" "Circle" "Ellipse" "Sphere"
47
48 frame .wsel.size
49 label .wsel.size.tag -font $helv12 -text "Size" -width 5 -anchor w
50 label .wsel.size.x -width 10 -text "" -relief sunken -bd 1 \
51 -font $helv12 -anchor w
52 label .wsel.size.y -width 10 -text "" -relief sunken -bd 1 \
53 -font $helv12 -anchor w
54 label .wsel.size.z -width 10 -text "" -relief sunken -bd 1 \
55 -font $helv12 -anchor w
56
57 frame .wsel.num
58 label .wsel.num.tag -font $helv12 -text "Number" -width 25 -anchor w
59 label .wsel.num.value -width 10 -text "" -relief sunken -bd 1 \
60 -font $helv12 -anchor w
61
62 frame .wsel.sum
63 label .wsel.sum.tag -font $helv12 -text "Sum" -width 25 -anchor w
64 label .wsel.sum.value -width 10 -text "" -relief sunken -bd 1 \
65 -font $helv12 -anchor w
66
67 frame .wsel.avg
68 label .wsel.avg.tag -font $helv12 -text "Average" -width 25 -anchor w
69 label .wsel.avg.value -width 10 -text "" -relief sunken -bd 1 \
70 -font $helv12 -anchor w
71
72 frame .wsel.std
73 label .wsel.std.tag -font $helv12 -text "Standard deviation" -width 25 -anchor w
74 label .wsel.std.value -width 10 -text "" -relief sunken -bd 1 \
75 -font $helv12 -anchor w
76
77 checkbutton .wsel.calc -text "Calculate" -variable calc_stats \
78 -command { updateSelectionStats }
79
80 frame .wsel.buttons
81 button .wsel.buttons.clear -text Clear \
82 -command {
83 if { [info exists selpoly] } { unset selpoly }
84 $c delete selection
85 } -underline 0
86 button .wsel.buttons.close -text Close \
87 -command {
88 if { [info exists selpoly] } { unset selpoly }
89 destroy .wsel
90 }
91
92 pack .wsel.selectiontype.tag .wsel.selectiontype.menu -side left -pady 5 -padx 10
93 pack .wsel.size.tag .wsel.size.x .wsel.size.y .wsel.size.z -side left -pady 5 -padx 5
94 pack .wsel.num.tag .wsel.num.value -side left -pady 5 -padx 20
95 pack .wsel.sum.tag .wsel.sum.value -side left -pady 5 -padx 20
96 pack .wsel.avg.tag .wsel.avg.value -side left -pady 5 -padx 20
97 pack .wsel.std.tag .wsel.std.value -side left -pady 5 -padx 20
98 pack .wsel.buttons.clear .wsel.buttons.close -side left -expand 1
99 pack .wsel.selectiontype .wsel.size .wsel.num .wsel.sum \
100 .wsel.avg .wsel.std .wsel.calc .wsel.buttons -side top -pady 2
101
102 } else {
103 wm deiconify .wsel
104 raise .wsel
105 }
106 wm title .wsel "Selection"
107 wm iconname .wsel "Selection"
108 .menuBar.window entryconfigure "Selection" -state normal
109 bind $c <1> "mousePressed %W %x %y"
110 bind $c <B1-Motion> "mouseMoved %W %x %y 1"
111 bind $c <B1-ButtonRelease> "mouseReleased %W"
112 bind .wsel <Control-w> {
113 if { [info exists selpoly] } { unset selpoly }
114 destroy .wsel
115 }
116 }
117
118 ## @brief Updates selection object.
119 #
120
121 proc updateSelection { } {
122 global tool theimg
123 # global px py
124 # global mx my
125 global selectiontype
126 global sx1 sx2 sy1 sy2 sz1 sz2
127
128 set c [getImageCanvas $theimg]
129 $c delete selection
130
131 if { [winfo exists .wsel] && $tool == "select" && $sx1 != $sx2 && $sy1 != $sy2 } {
132 set wc [getControlWindow $theimg]
133 set slice_num [$wc.slice.scale get]
134 if { $sz1 <= $slice_num && $sz2 >= $slice_num } {
135 set scale [$wc.scale.scale get]
136 set h [lindex [$c cget -scrollregion] 3]
137 if { $selectiontype == "Square" || $selectiontype == "Rectangle" || $selectiontype == "Cube" } {
138 set cx1 [expr int($sx1 * $scale)]
139 set cy1 [expr int($h - $sy1 * $scale)]
140 set cx2 [expr int($sx2 * $scale)]
141 set cy2 [expr int($h - $sy2 * $scale)]
142 $c create rectangle $cx1 $cy1 $cx2 $cy2 -tags selection -outline red
143 }
144 if { $selectiontype == "Circle" || $selectiontype == "Ellipse" || $selectiontype == "Sphere" } {
145 set t 0.0
146 set z [expr ($sz1 + $sz2)*0.5 - $slice_num]
147 if { $z != 0 } {
148 set r [expr ($sz1 - $sz2)*0.5]
149 set t [expr $z/$r]
150 }
151 set t [expr sqrt(1.0 - $t*$t)]
152 set tn [expr 0.5*(1.0 - $t)]
153 set tp [expr 0.5*(1.0 + $t)]
154 set cx1 [expr $sx1 * $scale]
155 set cy1 [expr $h - $sy1 * $scale]
156 set cx2 [expr $sx2 * $scale]
157 set cy2 [expr $h - $sy2 * $scale]
158 set ccx1 [expr int($tp*$cx1 + $tn*$cx2)]
159 set ccx2 [expr int($tn*$cx1 + $tp*$cx2)]
160 set ccy1 [expr int($tp*$cy1 + $tn*$cy2)]
161 set ccy2 [expr int($tn*$cy1 + $tp*$cy2)]
162 $c create oval $ccx1 $ccy1 $ccx2 $ccy2 -tags selection -outline red
163 }
164 }
165 }
166 }
167
168 ## @brief Updates selection object statistics.
169 #
170
171 proc updateSelectionStats { } {
172 global theimg
173 global selectiontype calc_stats
174 global sx1 sx2 sy1 sy2 sz1 sz2
175 if { ! $calc_stats } { return}
176 # set c [getImageCanvas $theimg]
177 set wc [getControlWindow $theimg]
178 set img_num [$wc.image.scale get]
179 set slice_num [$wc.slice.scale get]
180 set vlist "$sx1 $sy1 $sz1 $sx2 $sy2 $sz2"
181 if { $selectiontype == "Square" || $selectiontype == "Rectangle" || $selectiontype == "Cube" } {
182 set stats [Bimage stats $theimg $img_num 1 $vlist]
183 }
184 if { $selectiontype == "Circle" || $selectiontype == "Ellipse" || $selectiontype == "Sphere" } {
185 set stats [Bimage stats $theimg $img_num 2 $vlist]
186 }
187 if { $selectiontype == "Polygon" } {
188 set poly ""
189 append poly "$sx1 $sy1 $slice_num "
190 append poly "$sx1 $sy2 $slice_num "
191 append poly "$sx2 $sy2 $slice_num "
192 append poly "$sx2 $sy1 $slice_num "
193 # puts $poly
194 set stats [Bimage stats $theimg $img_num 3 $poly]
195 }
196 .wsel.num.value config -text [lindex $stats 0]
197 .wsel.sum.value config -text [lindex $stats 1]
198 .wsel.avg.value config -text [lindex $stats 2]
199 .wsel.std.value config -text [lindex $stats 3]
200 # puts "Expected size [expr (abs($sx1 - $sx2) + 1)*(abs($sy1 - $sy2) + 1)]"
201 }
202
203 proc Measure {} {
204 global theimg
205 set c [getImageCanvas $theimg]
206 bind $c <1> "mousePressed %W %x %y"
207 }
208
209