| Bsoft 2.0.5 Bernard's software package

bshow_magnify.tcl
Go to the documentation of this file.
1 ##
2 # @file bshow_magnify.tcl
3 #
4 # @brief Procedures for rendering the magnifying window in Bshow.
5 #
6 # @author Bernard Heymann
7 # @date Created: 20010516
8 # @date Modified: 20161102
9
10 set magnification 2
11 set magsize 75
12 set maglock 0
13 set aniproc2 0
14 set aniaxis z
15 set mag3D 0
16
17 ## @brief Window to show a region magnified.
18 #
19 # @param x
20 # @param y Coordinates on the canvas.
21
22 proc Magnify { x y } {
23 global helv12 theimg
24 global magnification magsize maglock show_cross
25
26 if ![Bimage exists $theimg] {
27 tk_dialog .dialog "No image in memory!" \
28 {Please read in an appropriate image first.} \
29 info 0 {OK}
30 return
31 }
32
33 set wc [getControlWindow $theimg]
34 set w .wmag
35
36 if ![winfo exists $w] {
37 toplevel $w
38
39 set nslices [Bimage get $theimg nslices]
40
41 frame $w.frame -relief ridge -borderwidth 2 -bg black
42
43 if { $nslices < 2 } {
44 wm minsize $w 200 200
45 set m $w.frame.c
46 canvas $m -width 200 -height 200
47
48 grid $m -in $w.frame -sticky nw -padx 2 -pady 2
49 grid rowconfig $w.frame 0 -weight 1 -minsize 0
50 grid columnconfig $w.frame 0 -weight 1 -minsize 0
51
52 image create photo theimg0
53 $m create image 0 0 -image theimg0 -anchor nw -tags magimage
54 } else {
55 wm minsize $w 300 300
56 set m $w.frame.c
57 set m1 $w.frame.c1
58 set m2 $w.frame.c2
59 canvas $m -width 150 -height 150
60 canvas $m1 -width 150 -height 150
61 canvas $m2 -width 150 -height 150
62
63 grid $m $m1 -in $w.frame -sticky nw -padx 2 -pady 2
64 grid $m2 -in $w.frame -sticky nw -padx 2 -pady 2
65 grid rowconfig $w.frame 0 -weight 1 -minsize 0
66 grid columnconfig $w.frame 0 -weight 1 -minsize 0
67
68 image create photo theimg0
69 $m create image 0 0 -image theimg0 -anchor nw -tags magimage
70 image create photo theimg1
71 $m1 create image 0 0 -image theimg1 -anchor nw -tags magimage
72 image create photo theimg2
73 $m2 create image 0 0 -image theimg2 -anchor nw -tags magimage
74 }
75
76 frame $w.n
77 label $w.n.x_tag -font $helv12 -text X
78 entry $w.n.x -width 6 -validate key -vcmd { string is double %P }
79 label $w.n.y_tag -font $helv12 -text Y
80 entry $w.n.y -width 6 -validate key -vcmd { string is double %P }
81 checkbutton $w.n.cross -text "Crosses" -variable show_cross
82 set show_cross 1
83
84 frame $w.p
85 label $w.p.size_tag -font $helv12 -text "Size"
86 entry $w.p.size -width 6 -validate key -vcmd { string is double %P }
87 $w.p.size insert 0 $magsize
88 label $w.p.mag_tag -font $helv12 -text "Magnification"
89 entry $w.p.mag -width 6 -validate key -vcmd { string is double %P }
90 $w.p.mag insert 0 $magnification
91
92 frame $w.q
93 label $w.q.slice_tag -font $helv12 -text "Slice"
94 scale $w.q.slice -from 0 -to [expr [Bimage get $theimg nslices] - 1] -orient horizontal -length 175 \
95 -command changeSlice
96 $w.q.slice set [$wc.slice.scale get]
97
98 frame $w.r
99 label $w.r.range_tag -font $helv12 -text "Range"
100 entry $w.r.range -width 3 -validate key -validatecommand {check_length %P 3}
101 $w.r.range insert 0 5
102 label $w.r.speed_tag -font $helv12 -text "Speed"
103 entry $w.r.speed -width 3 -validate key -validatecommand {check_length %P 3}
104 $w.r.speed insert 0 15
105 button $w.r.animate -text Animate \
106 -relief raised -command animateSlices -font $helv12
107 tk_optionMenu $w.r.axis aniaxis x y z
108
109 frame $w.instr
110 label $w.instr.lock -font $helv12 -text "Press l to lock into xy position"
111 label $w.instr.mag -font $helv12 -text "Press m to decrease magnification"
112
113 pack $w.n.x_tag $w.n.x $w.n.y_tag $w.n.y $w.n.cross \
114 -side left -ipadx 3 -ipady 2
115 pack $w.p.size_tag $w.p.size $w.p.mag_tag $w.p.mag \
116 -side left -ipadx 3 -ipady 2
117 pack $w.q.slice_tag $w.q.slice \
118 -side left -ipadx 3 -ipady 2
119 pack $w.r.range_tag $w.r.range \
120 $w.r.speed_tag $w.r.speed $w.r.animate \
121 $w.r.axis -side left -ipadx 2 -ipady 2
122 pack $w.q $w.r $w.p $w.n -side bottom -fill x
123 pack $w.instr.lock $w.instr.mag -side left -ipadx 10
124 pack $w.instr $w.frame -side top -fill both -expand yes
125
126
127 wm title $w "Magnify"
128 wm iconname $w "Magnify"
129 } else {
130 wm deiconify $w
131 raise $w
132 }
133 bind .wmag <Control-w> { destroy .wmag }
134 bind .wmag <Command-w> { destroy .wmag }
135 bind . <Key-l> { set maglock [expr 1 - $maglock] }
136 bind . <Key-m> {
137 if { $magnification > 0.1 } { set magnification [expr $magnification / 2.0] }
138 .wmag.p.mag delete 0 end
139 .wmag.p.mag insert 0 $magnification
140 }
141 }
142
143 proc drawCross { c lx ly } {
144 $c create line [expr $lx - 5] $ly [expr $lx + 5] $ly -fill yellow -width 1 -tags cross
145 $c create line $lx [expr $ly - 5] $lx [expr $ly + 5] -fill yellow -width 1 -tags cross
146 }
147
148 ## @brief Updates the magnifying window.
149 #
150 # @param x
151 # @param y Coordinates within the image.
152 # @param currSlice Current slice (defaults to main window's slice unless animating)
153 # @param updatesource Procedure calling update (mouse or slicer)
154
155 proc updateMagnify { x y currSlice updatesource } {
156 global theimg fom_cutoff
157 global mag3D show_cross project_item
158 global magnification magsize maglock
159 global show_boxes show_bad show_filaments
160 global fom_cutoff show_markers
161 global show_comp show_comp_labels comp_selected line_width
162 global show_box_labels box_color box_select_color bad_color bad_select_color
163 global filament_color filament_first_color filament_select_color
164
165 set w .wmag
166 if ![winfo exists $w] { return}
167 if { $maglock && $updatesource=="mouse" } { return}
168 if { $x > [Bimage get $theimg width] } { return}
169 if { $y < 0 } { return}
170
171 set x [expr int($x)]
172 set y [expr int($y)]
173
174 set wc [getControlWindow $theimg]
175 set scale [$wc.scale.scale get]
176 set n [$wc.image.scale get]
177 set mg_item [micrographItem $n]
178
179 if { $currSlice=="default" } {
180 set z [$wc.slice.scale get]
181 } else {
182 set z $currSlice
183 }
184
185 set magnification [$w.p.mag get]
186 set magsize [$w.p.size get]
187 set sx $magsize
188 set sy $magsize
189 set sz $magsize
190 set width [expr int($magnification*$sx)]
191 set height [expr int($magnification*$sy)]
192 set nslices [Bimage get $theimg nslices]
193
194 $w.frame.c delete cross box bad node marker component link
195 $w.frame.c configure -width $width -height $height -scrollregion "0 0 $width $height"
196
197 set mag3D 0
198 if { $nslices > 1 } {
199 set mag3D 1
200 $w.frame.c1 delete cross box bad node marker component link
201 $w.frame.c2 delete cross box bad node marker component link
202 $w.frame.c1 configure -width $width -height $height -scrollregion "0 0 $width $height"
203 $w.frame.c2 configure -width $width -height $height -scrollregion "0 0 $width $height"
204 }
205 wm minsize $w [expr 2*$width+60] [expr 2*$height+210]
206 Bimage magnify $theimg $n $x $y $z $magnification $sx $sy $sz
207 # puts "Mag image extracted"
208
209 set lx [expr $width/2]
210 set ly [expr $height/2]
211 if { $show_cross } {
212 drawCross $w.frame.c $lx $ly
213 if { $mag3D } {
214 drawCross $w.frame.c1 $lx $ly
215 drawCross $w.frame.c2 $lx $ly
216 }
217 }
218 if { $maglock==0 || $updatesource=="slicer" } {
219 $w.n.x delete 0 end
220 $w.n.x insert 0 $x
221 $w.n.y delete 0 end
222 $w.n.y insert 0 $y
223 }
224
225 if [winfo exists .wbox] {
226 if { $show_boxes } {
227 set ids [Bmg box $mg_item ids $fom_cutoff]
228 foreach id $ids {
229 drawMagBox $id $x $y $z
230 }
231 }
232 if { $show_bad } {
233 set ids [Bmg box $mg_item ids bad]
234 foreach id $ids {
235 drawMagBox $id $x $y $z
236 }
237 }
238 }
239
240 if [winfo exists .wfil] {
241 if { $show_filaments } {
242 set rad [.wfil.node_radius.entry get]
243 set ids [Bmg node $mg_item ids]
244 set pfid 0
245 set pnid 0
246 foreach {fid nid} $ids {
247 set loc [Bmg node $mg_item location $fid $nid]
248 if { $pfid == $fid } {
249 set color $filament_color
250 } else {
251 set color $filament_first_color
252 }
253 drawMagSphere [lindex $loc 0] [lindex $loc 1] [lindex $loc 2] \
254 $x $y $z $rad $color $line_width $nid node
255 if { $pfid == $fid } {
256 drawMagLine [lindex $loc 0] [lindex $loc 1] [lindex $loc 2] \
257 [lindex $ploc 0] [lindex $ploc 1] [lindex $ploc 2] \
258 $x $y $z 1 $filament_color link
259 }
260 set pfid $fid
261 set pnid $nid
262 set ploc $loc
263 }
264 }
265 }
266
267 if [winfo exists .wtomo] {
268 if { $show_markers } {
269 set ids [Bmg marker $mg_item ids $fom_cutoff]
270 foreach id $ids {
271 drawMagMarker $id $x $y $z
272 }
273 }
274 }
275
276 if [winfo exists .wmod] {
277 if { $show_comp } {
278 set comps [Bmodel component $project_item img_coords $fom_cutoff]
279 if { $show_comp_labels } {
280 foreach {id cx cy cz rad color} $comps {
281 drawMagSphere $cx $cy $cz $x $y $z $rad $color $line_width $id component
282 }
283 } else {
284 foreach {id cx cy cz rad color} $comps {
285 drawMagSphere $cx $cy $cz $x $y $z $rad $color $line_width "" component
286 }
287 }
288 set links [Bmodel link $project_item img_coords $fom_cutoff]
289 foreach {x1 y1 z1 x2 y2 z2 rad color} $links {
290 drawMagLine $x1 $y1 $z1 $x2 $y2 $z2 $x $y $z $rad $color link
291 }
292 }
293 }
294 }
295
296
297 ## @brief Draws a box in the magnification window.
298 #
299 # @param id Box identifier.
300 # @param ptx
301 # @param pty Coordinates within the image.
302 # @param ptz Current slice (defaults to main window's slice unless animating)
303
304 proc drawMagBox { id ptx pty ptz } {
305 global theimg
306
307 set w .wmag
308 if ![winfo exists $w] { return}
309
310 set wb .wbox
311 if ![winfo exists $wb] { return}
312
313 global project_item
314 global show_box_labels box_color box_select_color bad_color bad_select_color
315
316 set wc [getControlWindow $theimg]
317
318 set magnification [$w.p.mag get]
319 set magsize [$w.p.size get]
320 set slice_num [$wc.slice.scale get]
321 set h [Bimage get $theimg height]
322 set n [$wc.image.scale get]
323 set mg_item [micrographItem $n]
324 set loc [Bmg box $mg_item location $id]
325 set x [lindex $loc 0]
326 # set y [expr ($h - [lindex $loc 1] - 1) ]
327 set y [yFlip [lindex $loc 1]]
328 set z [lindex $loc 2]
329
330 if { $id > 0 } {
331 set xrad [expr [$wb.box_size.x get]*0.5]
332 set yrad [expr [$wb.box_size.y get]*0.5]
333 set zrad [expr [$wb.box_size.z get]*0.5]
334 } else {
335 set xrad [expr [$wb.bad_radius.e get]*1.0]
336 set yrad $xrad
337 set zrad $xrad
338 }
339
340 set pty [expr $h - $pty]
341 set nslices [Bimage get $theimg nslices]
342
343 set xr [expr abs($ptx - $x)]
344 set yr [expr abs($pty - $y)]
345 set zr [expr abs($ptz - $z)]
346
347 set xdiff [expr ($ptx - $x)*$magnification]
348 set ydiff [expr ($pty - $y)*$magnification]
349 set zdiff [expr ($ptz - $z)*$magnification]
350
351 set lx [expr $magnification*$magsize/2]
352 set ly [expr $magnification*$magsize/2]
353
354 set idtag [format "box%d" $id]
355
356 if { $zr <= $zrad } {
357 set fac 1.0
358 if { $zrad > 0 } { set fac [expr sqrt(1-(($zr*$zr)/($zrad*$zrad)))]}
359 set xy_x_radius [expr $magnification * $xrad * $fac]
360 set xy_y_radius [expr $magnification * $yrad * $fac]
361 set xmin [expr ($lx-$xdiff-$xrad*$magnification)]
362 set xmax [expr ($lx-$xdiff+$xrad*$magnification) + $magnification - 1]
363 set ymin [expr ($ly-$ydiff-$yrad*$magnification)]
364 set ymax [expr ($ly-$ydiff+$yrad*$magnification) + $magnification - 1]
365 set cxmin [expr ($lx-$xdiff-$xy_x_radius)]
366 set cxmax [expr ($lx-$xdiff+$xy_x_radius) + $magnification - 1]
367 set cymin [expr ($ly-$ydiff-$xy_y_radius)]
368 set cymax [expr ($ly-$ydiff+$xy_y_radius) + $magnification - 1]
369 if { $id > 0 } {
370 $w.frame.c create oval $cxmin $cymin $cxmax $cymax -outline $box_color -width 1 -tags [list box $idtag]
371 $w.frame.c create rect $xmin $ymin $xmax $ymax -outline $box_color -width 1 -tags [list box $idtag]
372 if { $show_box_labels } {
373 $w.frame.c create text [expr $lx-$xdiff] [expr $ly-$ydiff] -text $id -fill $box_color -tags [list box $idtag]
374 }
375 } else {
376 $w.frame.c create oval $cxmin $cymin $cxmax $cymax -outline $bad_color -width 1 -tags bad
377 }
378 }
379
380 if { $nslices > 1 } {
381 if { [expr $xrad*$xrad-$xr*$xr] >= 0 } {
382 set yz_z_radius [expr $magnification * $zrad * sqrt(1-(($xr*$xr)/($xrad*$xrad)))]
383 set yz_y_radius [expr $magnification * $yrad * sqrt(1-(($xr*$xr)/($xrad*$xrad)))]
384 set xmin [expr ($lx-$zdiff-$zrad*$magnification)]
385 set xmax [expr ($lx-$zdiff+$zrad*$magnification) + $magnification - 1]
386 set ymin [expr ($ly-$ydiff-$yrad*$magnification)]
387 set ymax [expr ($ly-$ydiff+$yrad*$magnification) + $magnification - 1]
388 set cxmin [expr ($lx-$zdiff-$yz_z_radius)]
389 set cxmax [expr ($lx-$zdiff+$yz_z_radius) + $magnification - 1]
390 set cymin [expr ($ly-$ydiff-$yz_y_radius)]
391 set cymax [expr ($ly-$ydiff+$yz_y_radius) + $magnification - 1]
392 if { $id > 0 } {
393 $w.frame.c1 create oval $cxmin $cymin $cxmax $cymax -outline $box_color -width 1 -tags [list box $idtag]
394 $w.frame.c1 create rect $xmin $ymin $xmax $ymax -outline $box_color -width 1 -tags [list box $idtag]
395 if { $show_box_labels } {
396 $w.frame.c1 create text [expr $lx-$zdiff] [expr $ly-$ydiff] -text $id -fill $box_color -tags [list box $idtag]
397 }
398 } else {
399 $w.frame.c1 create oval $cxmin $cymin $cxmax $cymax -outline $bad_color -width 1 -tags bad
400 }
401 }
402
403 if { [expr $yrad*$yrad-$yr*$yr] >= 0 } {
404 set xz_x_radius [expr $magnification * $xrad * sqrt(1-(($yr*$yr)/($yrad*$yrad)))]
405 set xz_z_radius [expr $magnification * $zrad * sqrt(1-(($yr*$yr)/($yrad*$yrad)))]
406 set xmin [expr ($lx-$xdiff-$xrad*$magnification)]
407 set xmax [expr ($lx-$xdiff+$xrad*$magnification) + $magnification - 1]
408 set ymin [expr ($ly+$zdiff-$zrad*$magnification)]
409 set ymax [expr ($ly+$zdiff+$zrad*$magnification) + $magnification - 1]
410 set cxmin [expr ($lx-$xdiff-$xz_x_radius)]
411 set cxmax [expr ($lx-$xdiff+$xz_x_radius) + $magnification - 1]
412 set cymin [expr ($ly+$zdiff-$xz_z_radius)]
413 set cymax [expr ($ly+$zdiff+$xz_z_radius) + $magnification - 1]
414 if { $id > 0 } {
415 $w.frame.c2 create oval $cxmin $cymin $cxmax $cymax -outline $box_color -width 1 -tags [list box $idtag]
416 $w.frame.c2 create rect $xmin $ymin $xmax $ymax -outline $box_color -width 1 -tags [list box $idtag]
417 if { $show_box_labels } {
418 $w.frame.c2 create text [expr $lx-$xdiff] [expr $ly+$zdiff] -text $id -fill $box_color -tags [list box $idtag]
419 }
420 } else {
421 $w.frame.c2 create oval $cxmin $cymin $cxmax $cymax -outline $bad_color -width 1 -tags bad
422 }
423 }
424 }
425 }
426
427 ## @brief Draws a marker in the magnification window.
428 #
429 # @param id Marker identifier.
430 # @param ptx
431 # @param pty Coordinates within the image.
432 # @param ptz Current slice (defaults to main window's slice unless animating)
433
434 proc drawMagMarker { id ptx pty ptz } {
435 global theimg
436
437 set w .wmag
438 if ![winfo exists $w] { return}
439 global project_item markers_selected marker_radius
440 global show_marker_errors show_marker_labels
441 global marker_color marker_select_color error_color error_select_color
442
443 set wc [getControlWindow $theimg]
444
445 set magnification [$w.p.mag get]
446 set magsize [$w.p.size get]
447 set slice_num [$wc.slice.scale get]
448 set h [Bimage get $theimg height]
449 set n [$wc.image.scale get]
450 set mg_item [micrographItem $n]
451 set locerr [Bmg marker $mg_item location $id]
452 set x [lindex $locerr 0]
453 set y [expr ($h - [lindex $locerr 1] - 1)]
454 set z [lindex $locerr 2]
455 set ex [expr $x + [lindex $locerr 3]]
456 set ey [expr $y - [lindex $locerr 4]]
457 set ez [expr $z + [lindex $locerr 5]]
458
459 set idtag [format "m%d" $id]
460
461 set pty [expr $h - $pty]
462 set nslices [Bimage get $theimg nslices]
463
464 set xr [expr $ptx - $x]
465 set yr [expr $pty - $y]
466 set zr [expr $ptz - $z]
467
468 set xdiff [expr $xr*$magnification]
469 set ydiff [expr $yr*$magnification]
470 set zdiff [expr $zr*$magnification]
471 set exdiff [expr ($ptx - $ex)*$magnification]
472 set eydiff [expr ($pty - $ey)*$magnification]
473
474 if { $ez > 0 } {
475 set ezdiff [expr ($ptz - $ez)*$magnification]
476 } else {
477 set ezdiff 0
478 }
479
480 set lx [expr $magnification*$magsize/2]
481 set ly [expr $magnification*$magsize/2]
482
483 # set rad [expr $marker_radius*$magnification]
484 set rad [expr $marker_radius]
485 set rad2 [expr $rad*$rad]
486
487 if { [lsearch $markers_selected $id] >= 0 } {
488 set markcolorshow $marker_select_color;
489 set errcolorshow $error_select_color;
490 } else {
491 set markcolorshow $marker_color;
492 set errcolorshow $error_color;
493 }
494
495 if { [expr $rad2-$zr*$zr] >= 0 } {
496 set xy_radius [expr $magnification*sqrt($rad2-$zr*$zr)]
497 set xmin [expr ($lx-$xdiff-$xy_radius)]
498 set xmax [expr ($lx-$xdiff+$xy_radius) + $magnification - 1]
499 set ymin [expr ($ly-$ydiff-$xy_radius)]
500 set ymax [expr ($ly-$ydiff+$xy_radius) + $magnification - 1]
501 $w.frame.c create oval $xmin $ymin $xmax $ymax -outline $markcolorshow -width 1 -tags marker
502 if { $show_marker_labels } {
503 $w.frame.c create text [expr $lx-$xdiff+$rad*$magnification+10] [expr $ly-$ydiff] -text $id -fill $markcolorshow -tags [list marker $idtag]
504 }
505 if { $show_marker_errors } {
506 $w.frame.c create line [expr $lx-$xdiff] [expr $ly-$ydiff] [expr $lx-$exdiff] [expr $ly-$eydiff] -fill $errcolorshow -width 2 -tags [list marker $idtag]
507 }
508 }
509
510 if { $nslices > 1 } {
511 if { [expr $rad2-$xr*$xr] >= 0 } {
512 set yz_radius [expr $magnification*sqrt($rad2-$xr*$xr)]
513 set xmin [expr ($lx-$zdiff-$yz_radius)]
514 set xmax [expr ($lx-$zdiff+$yz_radius) + $magnification - 1]
515 set ymin [expr ($ly-$ydiff-$yz_radius)]
516 set ymax [expr ($ly-$ydiff+$yz_radius) + $magnification - 1]
517 $w.frame.c1 create oval $xmin $ymin $xmax $ymax -outline $markcolorshow -width 1 -tags marker
518 if { $show_marker_labels } {
519 $w.frame.c1 create text [expr $lx-$zdiff+$rad*$magnification+10] [expr $ly-$ydiff] -text $id -fill $markcolorshow -tags [list marker $idtag]
520 }
521 if { $show_marker_errors } {
522 $w.frame.c1 create line [expr $lx-$zdiff] [expr $ly-$ydiff] [expr $lx-$ezdiff] [expr $ly-$eydiff] -fill $errcolorshow -width 2 -tags [list marker $idtag]
523 }
524 }
525
526 if { [expr $rad2-$yr*$yr] >= 0 } {
527 set xz_radius [expr $magnification*sqrt($rad2-$yr*$yr)]
528 set xmin [expr ($lx-$xdiff-$xz_radius)]
529 set xmax [expr ($lx-$xdiff+$xz_radius) + $magnification - 1]
530 set ymin [expr ($ly+$zdiff-$xz_radius)]
531 set ymax [expr ($ly+$zdiff+$xz_radius) + $magnification - 1]
532 $w.frame.c2 create oval $xmin $ymin $xmax $ymax -outline $markcolorshow -width 1 -tags marker
533 if { $show_marker_labels } {
534 $w.frame.c2 create text [expr $lx-$xdiff+$rad*$magnification+10] [expr $ly+$zdiff] -text $id -fill $markcolorshow -tags [list marker $idtag]
535 }
536 if { $show_marker_errors } {
537 $w.frame.c2 create line [expr $lx-$xdiff] [expr $ly+$zdiff] [expr $lx-$exdiff] [expr $ly+$ezdiff] -fill $errcolorshow -width 2 -tags [list marker $idtag]
538 }
539 }
540 }
541 }
542
543 proc drawMagSphere { x y z ptx pty ptz rad col width lbl tag } {
544 global mag3D
545
546 set w .wmag
547 if ![winfo exists $w] { return}
548
549 set c $w.frame.c
550 set c1 $w.frame.c1
551 set c2 $w.frame.c2
552
553 set magnification [$w.p.mag get]
554 set magsize [$w.p.size get]
555
556 set rm [expr $rad * $magnification]
557 if { $rm < 1 } { set rm 1}
558
559 set lx [expr 0.5 * $magnification * $magsize]
560 set ly $lx
561
562 set max [expr $lx + $rm]
563 set m2 [expr $lx * $lx]
564
565 set xr [expr ($ptx - $x)*$magnification]
566 set yr [expr ($y - $pty)*$magnification]
567 set zr [expr ($ptz - $z)*$magnification]
568
569 # Test if within the magnification window
570 set xr2 [expr $xr*$xr]
571 if { $xr2 > $m2 } { return}
572
573 set yr2 [expr $yr*$yr]
574 if { $yr2 > $m2 } { return}
575
576 set zr2 [expr $zr*$zr]
577 if { $zr2 > $m2 } { return}
578
579 set xxd [expr $lx - $xr]
580 set yyd [expr $ly - $yr]
581
582 set mag_1 [expr $magnification - 1]
583
584 set rm2 [expr $rm*$rm]
585
586 set dz2 [expr $rm2 - $zr2]
587
588 if { $dz2 >= 0 } {
589 set xy_radius [expr sqrt($dz2)]
590 set xmin [expr $xxd - $xy_radius]
591 set xmax [expr $xxd + $xy_radius + $mag_1]
592 set ymin [expr $yyd - $xy_radius]
593 set ymax [expr $yyd + $xy_radius + $mag_1]
594 $c create oval $xmin $ymin $xmax $ymax -outline $col -width $width -tags $tag
595 if { [string length $lbl] } {
596 $c create text $xmax $ymax -text $lbl -fill $col -anchor w -tags $tag
597 }
598 }
599
600 if { $mag3D } {
601 set xzd [expr $lx - $zr]
602 set yzd [expr $ly + $zr]
603 set dx2 [expr $rm2 - $xr2]
604 if { $dx2 >= 0 } {
605 set yz_radius [expr sqrt($dx2)]
606 set xmin [expr $xzd - $yz_radius]
607 set xmax [expr $xzd + $yz_radius + $mag_1]
608 set ymin [expr $yyd - $yz_radius]
609 set ymax [expr $yyd + $yz_radius + $mag_1]
610 $c1 create oval $xmin $ymin $xmax $ymax -outline $col -width $width -tags $tag
611 if { [string length $lbl] } {
612 $c1 create text $xmax $ymax -text $lbl -fill $col -anchor w -tags $tag
613 }
614 }
615
616 set dy2 [expr $rm2 - $yr2]
617 if { $dy2 >= 0 } {
618 set xz_radius [expr sqrt($dy2)]
619 set xmin [expr $xxd - $xz_radius]
620 set xmax [expr $xxd + $xz_radius + $mag_1]
621 set ymin [expr $yzd - $xz_radius]
622 set ymax [expr $yzd + $xz_radius + $mag_1]
623 $c2 create oval $xmin $ymin $xmax $ymax -outline $col -width $width -tags $tag
624 if { [string length $lbl] } {
625 $c2 create text $xmax $ymax -text $lbl -fill $col -anchor w -tags $tag
626 }
627 }
628 }
629 }
630
631 proc drawMagLine { xs ys zs xe ye ze ptx pty ptz width col tag } {
632 global mag3D
633 if ![winfo exists $w] { return}
634
635 set c $w.frame.c
636 set c1 $w.frame.c1
637 set c2 $w.frame.c2
638
639 set magnification [$w.p.mag get]
640 set magsize [$w.p.size get]
641
642 set width [expr int($width * $magnification)]
643 if { $width < 1 } { set width 1}
644
645 set xsr [expr $ptx - $xs]
646 set ysr [expr $ys - $pty]
647 set zsr [expr $ptz - $zs]
648 set xer [expr $ptx - $xe]
649 set yer [expr $ye - $pty]
650 set zer [expr $ptz - $ze]
651
652 set xsdiff [expr $xsr*$magnification]
653 set ysdiff [expr $ysr*$magnification]
654 set zsdiff [expr $zsr*$magnification]
655 set xediff [expr $xer*$magnification]
656 set yediff [expr $yer*$magnification]
657 set zediff [expr $zer*$magnification]
658
659 set magdim [expr $magnification*$magsize]
660 set lx [expr $magdim * 0.5]
661 set ly [expr $magdim * 0.5]
662
663 set z -1.0
664 if { $zer != $zsr } {
665 set z [expr $zsr / (1.0*($ze - $zs))]
666 } else {
667 if { abs($zsr) < 0.5 } { set z 0.5}
668 }
669
670 set xmin [expr $lx - $xsdiff]
671 set xmax [expr $lx - $xediff]
672 set ymin [expr $ly - $ysdiff]
673 set ymax [expr $ly - $yediff]
674 if { $xmin == $xmax && $ymin == $ymax } { set ymax [expr $ymax + 1]}
675
676 if { $z >= 0.0 && $z <= 1.0 } {
677 $c create line $xmin $ymin $xmax $ymax -fill $col -smooth yes -width $width -tags $tag
678 }
679
680 if { $mag3D } {
681 set x -1.0
682 if { $xe != $xs } {
683 set x [expr $xsr / (1.0*($xe - $xs))]
684 } else {
685 if { abs($xsr) < 0.5 } { set x 0.5}
686 }
687
688 set zmin [expr $ly - $zsdiff]
689 set zmax [expr $ly - $zediff]
690 if { $x >= 0.0 && $x <= 1.0 } {
691 if { $zmin == $zmax && $ymin == $ymax } { set ymax [expr $ymax + 1]}
692 $c1 create line $zmin $ymin $zmax $ymax -fill $col -smooth yes -width $width -tags $tag
693 }
694
695 set y -1.0
696 if { $ye != $ys } {
697 set y [expr $ysr / (1.0*($ys - $ye))]
698 } else {
699 if { abs($ysr) < 0.5 } { set y 0.5}
700 }
701
702 set zmin [expr $magdim - $zmin]
703 set zmax [expr $magdim - $zmax]
704 if { $y >= 0.0 && $y <= 1.0 } {
705 if { $xmin == $xmax && $zmin == $zmax } { set zmax [expr $zmax + 1]}
706 $c2 create line $xmin $zmin $xmax $zmax -fill $col -smooth yes -width $width -tags $tag
707 }
708 }
709 }
710
711 proc changeSlice { deltaslice } {
712 global maglock theimg
713
714 set w .wmag
715
716 if { $maglock == 1 } {
717 updateMagnify [$w.n.x get] [$w.n.y get] $deltaslice slicer
718 } else {
719 set wc [getControlWindow $theimg]
720 $wc.slice.scale set [$w.q.slice get]
721 }
722 }
723
724 proc updateSlicer { aniaxis anidirection } {
725 set w .wmag
726
727 set x [$w.n.x get]
728 set y [$w.n.y get]
729 set z [$w.q.slice get]
730 if { $aniaxis == "x" } {
731 if { $anidirection == 1 } { updateMagnify [expr $x + 1] $y $z slicer}
732 if { $anidirection == 0 } { updateMagnify [expr $x - 1] $y $z slicer}
733 }
734 if { $aniaxis == "y" } {
735 if { $anidirection == 1 } { updateMagnify $x [expr $y + 1] $z slicer}
736 if { $anidirection == 0 } { updateMagnify $x [expr $y - 1] $z slicer}
737 }
738 if { $aniaxis == "z" } {
739 if { $anidirection == 1 } {$w.q.slice set [expr [$w.q.slice get] + 1]}
740 if { $anidirection == 0 } {$w.q.slice set [expr [$w.q.slice get] - 1]}
741 }
742 }
743
744 proc animateSlices {} {
745 global theimg
746 global aniproc2
747 global aniaxis
748
749 set w .wmag
750
751 if ![winfo exists $w] { return}
752 if { $aniaxis=="x" } {
753 set anisource "$w.n.x"
754 set lim [expr [Bimage get $theimg width] - 1]
755 }
756 if { $aniaxis=="y" } {
757 set anisource "$w.n.y"
758 set lim [expr [Bimage get $theimg height] - 1]
759 }
760 if { $aniaxis=="z" } {
761 set anisource "$w.q.slice"
762 set lim [expr [Bimage get $theimg nslices] - 1]
763 }
764 set aniceiling [expr [$anisource get] + [$w.r.range get]]
765 set anifloor [expr [$anisource get] - [$w.r.range get]]
766 if { $aniceiling > $lim } { set aniceiling $lim}
767 if { $anifloor < 0 } { set anifloor 0}
768 set anidirection 1
769 set speed [$w.r.speed get]
770 if { $speed == "" || $speed < 0 } {
771 set speed 15
772 }
773 if { $speed > 200 } {
774 set speed 200
775 }
776 $w.r.speed delete 0 end
777 $w.r.speed insert 0 $speed
778
779 if { $aniproc2 == 0 } {
780 $w.r.animate configure -text "Stop"
781 $w.r.axis configure -state disabled
782 $w.r.range configure -state disabled
783 $w.r.speed configure -state disabled
784 set aniproc2 1
785 } else {
786 $w.r.animate configure -text "Animate"
787 $w.r.axis configure -state normal
788 $w.r.range configure -state normal
789 $w.r.speed configure -state normal
790 set aniproc2 0
791 }
792
793 while { [winfo exists $w] && $aniproc2 == 1 } {
794 set slice [$anisource get]
795 if { $slice == $aniceiling } {
796 set anidirection 0
797 }
798 if { $slice == $anifloor } {
799 set anidirection 1
800 }
801 after [expr 1000/[$w.r.speed get]]
802 updateSlicer $aniaxis $anidirection
803 update
804 }
805 }
806
807 proc check_length {newstring max_length} {
808 return [expr {[string length $newstring] <= $max_length}]
809 }
810