2 proc BindTkImageViewer {widget} {
3 # to avoid queing up multple expose events.
4 SetWidgetVariableValue $widget Rendering 0
6 set imager [[$widget GetImageViewer] GetImager]
8 # stuff for window level text.
9 set mapper [NewWidgetObject $widget vtkTextMapper Mapper1]
10 $mapper SetInput "none"
11 $mapper SetFontFamilyToTimes
12 $mapper SetFontSize 18
15 set actor [NewWidgetObject $widget vtkActor2D Actor1]
16 $actor SetMapper $mapper
17 $actor SetLayerNumber 1
18 [$actor GetPositionCoordinate] SetValue 4 22
19 [$actor GetProperty] SetColor 1 1 0.5
20 $actor SetVisibility 0
21 $imager AddActor2D $actor
23 # stuff for window level text.
24 set mapper [NewWidgetObject $widget vtkTextMapper Mapper2]
25 $mapper SetInput "none"
26 $mapper SetFontFamilyToTimes
27 $mapper SetFontSize 18
30 set actor [NewWidgetObject $widget vtkActor2D Actor2]
31 $actor SetMapper $mapper
32 $actor SetLayerNumber 1
33 [$actor GetPositionCoordinate] SetValue 4 4
34 [$actor GetProperty] SetColor 1 1 0.5
35 $actor SetVisibility 0
36 $imager AddActor2D $actor
40 bind $widget <ButtonPress-1> {StartWindowLevelInteraction %W %x %y}
41 bind $widget <B1-Motion> {UpdateWindowLevelInteraction %W %x %y}
42 bind $widget <ButtonRelease-1> {EndWindowLevelInteraction %W}
45 bind $widget <ButtonPress-3> {StartQueryInteraction %W %x %y}
46 bind $widget <B3-Motion> {UpdateQueryInteraction %W %x %y}
47 bind $widget <ButtonRelease-3> {EndQueryInteraction %W}
49 bind $widget <Expose> {ExposeTkImageViewer %W %x %y %w %h}
50 bind $widget <Enter> {EnterTkViewer %W}
51 bind $widget <Leave> {LeaveTkViewer %W}
52 bind $widget <KeyPress-e> {exit}
53 bind $widget <KeyPress-u> {wm deiconify .vtkInteract}
54 bind $widget <KeyPress-r> {ResetTkImageViewer %W}
58 proc EnterTkViewer {widget} {
59 SetWidgetVariableValue $widget OldFocus [focus]
63 proc LeaveTkViewer {widget} {
64 set old [GetWidgetVariableValue $widget OldFocus]
70 proc ExposeTkImageViewer {widget x y w h} {
71 # Do not render if we are already rendering
72 if {[GetWidgetVariableValue $widget Rendering] == 1} {
73 #puts "Abort Expose: x = $x, y = $y"
77 # empty the que of any other expose events
78 SetWidgetVariableValue $widget Rendering 1
80 SetWidgetVariableValue $widget Rendering 0
82 # ignore the region to redraw for now.
83 #puts "Expose: x = $x, y = $y"
87 proc StartWindowLevelInteraction {widget x y} {
88 set viewer [$widget GetImageViewer]
90 # save the starting mouse position and the corresponding window/level
91 SetWidgetVariableValue $widget X $x
92 SetWidgetVariableValue $widget Y $y
93 SetWidgetVariableValue $widget Window [$viewer GetColorWindow]
94 SetWidgetVariableValue $widget Level [$viewer GetColorLevel]
96 #puts "------------------------------------"
97 #puts "start: ($x, $y), w = [$viewer GetColorWindow], l =[$viewer GetColorLevel] "
99 # make the window level text visible
100 set actor [GetWidgetVariableValue $widget Actor1]
101 $actor SetVisibility 1
102 set actor [GetWidgetVariableValue $widget Actor2]
103 $actor SetVisibility 1
105 UpdateWindowLevelInteraction $widget $x $y
109 proc EndWindowLevelInteraction {widget} {
110 set actor [GetWidgetVariableValue $widget Actor1]
111 $actor SetVisibility 0
112 set actor [GetWidgetVariableValue $widget Actor2]
113 $actor SetVisibility 0
118 # clicking on the window sets up sliders with current value at mouse,
119 # and scaled so that the whole window represents x4 change.
120 proc UpdateWindowLevelInteraction {widget x y} {
121 set viewer [$widget GetImageViewer]
123 # get the widgets dimensions
124 set width [lindex [$widget configure -width] 4]
125 set height [lindex [$widget configure -height] 4]
127 # get the old window level values
128 set window [GetWidgetVariableValue $widget Window]
129 set level [GetWidgetVariableValue $widget Level]
131 # get starting x, y and window/level values to compute delta
132 set start_x [GetWidgetVariableValue $widget X]
133 set start_y [GetWidgetVariableValue $widget Y]
135 # compute normalized delta
136 set dx [expr 4.0 * ($x - $start_x) / $width]
137 set dy [expr 4.0 * ($start_y - $y) / $height]
139 # scale by current values
140 set dx [expr $dx * $window]
141 set dy [expr $dy * $window]
143 #puts " update: ($x, $y), dx = $dx, dy = $dy"
145 # abs so that direction does not flip
151 # compute new window level
152 set new_window [expr $dx + $window]
153 if {$new_window < 0.0} {
154 set new_level [expr $dy + $level]
156 set new_level [expr $level - $dy]
159 # zero window or level can trap the value.
160 # put a limit of 1 / 100 value
163 # if window is negative, then delta level should flip (down is dark).
164 if {$new_window < 0.0} {set dy [expr -$dy]}
167 $viewer SetColorWindow $new_window
168 $viewer SetColorLevel $new_level
170 set mapper [GetWidgetVariableValue $widget Mapper1]
171 $mapper SetInput "Window: $new_window"
173 set mapper [GetWidgetVariableValue $widget Mapper2]
174 $mapper SetInput "Level: $new_level"
179 # ----------- Reset: Set window level to show all values ---------------
181 proc ResetTkImageViewer {widget} {
182 set viewer [$widget GetImageViewer]
183 set input [$viewer GetInput]
187 # Get the extent in viewer
188 set z [$viewer GetZSlice]
190 $input UpdateInformation
191 set whole [$input GetWholeExtent]
192 $input SetUpdateExtent [lindex $whole 0] [lindex $whole 1] \
193 [lindex $whole 2] [lindex $whole 3] $z $z
196 set range [$input GetScalarRange]
197 set low [lindex $range 0]
198 set high [lindex $range 1]
200 $viewer SetColorWindow [expr $high - $low]
201 $viewer SetColorLevel [expr ($high + $low) * 0.5]
209 # ----------- Query PixleValue stuff ---------------
211 proc StartQueryInteraction {widget x y} {
212 set actor [GetWidgetVariableValue $widget Actor2]
213 $actor SetVisibility 1
215 UpdateQueryInteraction $widget $x $y
219 proc EndQueryInteraction {widget} {
220 set actor [GetWidgetVariableValue $widget Actor2]
221 $actor SetVisibility 0
226 proc UpdateQueryInteraction {widget x y} {
227 set viewer [$widget GetImageViewer]
228 set input [$viewer GetInput]
229 set z [$viewer GetZSlice]
231 # y is flipped upside down
232 set height [lindex [$widget configure -height] 4]
233 set y [expr $height - $y]
235 # make sure point is in the whole extent of the image.
236 scan [$input GetWholeExtent] "%d %d %d %d %d %d" \
237 xMin xMax yMin yMax zMin zMax
238 if {$x < $xMin || $x > $xMax || $y < $yMin || $y > $yMax || \
239 $z < $zMin || $z > $zMax} {
243 $input SetUpdateExtent $x $x $y $y $z $z
246 set numComps [$data GetNumberOfScalarComponents]
248 for {set idx 0} {$idx < $numComps} {incr idx} {
249 set val [$data GetScalarComponentAsFloat $x $y $z $idx]
250 set str [format "%s %.1f" $str $val]
253 set mapper [GetWidgetVariableValue $widget Mapper2]
254 $mapper SetInput "($x, $y): $str"