1 set TkInteractor_StartRenderMethod ""
2 set TkInteractor_EndRenderMethod ""
3 set TkInteractor_InteractiveUpdateRate 15.0
4 set TkInteractor_StillUpdateRate 0.1
6 proc BindTkRenderWidget {widget} {
7 bind $widget <Any-ButtonPress> {StartMotion %W %x %y}
8 bind $widget <Any-ButtonRelease> {EndMotion %W %x %y}
9 bind $widget <B1-Motion> {Rotate %W %x %y}
10 bind $widget <B2-Motion> {Pan %W %x %y}
11 bind $widget <B3-Motion> {Zoom %W %x %y}
12 bind $widget <Shift-B1-Motion> {Pan %W %x %y}
13 bind $widget <Shift-B3-Motion> {RubberZoom %W %x %y}
14 bind $widget <KeyPress-r> {Reset %W %x %y}
15 bind $widget <KeyPress-u> {wm deiconify .vtkInteract}
16 bind $widget <KeyPress-w> {Wireframe %W}
17 bind $widget <KeyPress-s> {Surface %W}
18 bind $widget <KeyPress-p> {PickActor %W %x %y}
19 bind $widget <Enter> {Enter %W %x %y}
20 bind $widget <Leave> {focus $oldFocus}
21 bind $widget <Expose> {Expose %W}
24 # a litle more complex than just "bind $widget <Expose> {%W Render}"
25 # we have to handle all pending expose events otherwise they que up.
26 proc Expose {widget} {
27 global TkInteractor_StillUpdateRate
28 if {[GetWidgetVariableValue $widget InExpose] == 1} {
31 SetWidgetVariableValue $widget InExpose 1
32 [$widget GetRenderWindow] SetDesiredUpdateRate $TkInteractor_StillUpdateRate
34 [$widget GetRenderWindow] Render
35 SetWidgetVariableValue $widget InExpose 0
38 # Global variable keeps track of whether active renderer was found
41 # Create event bindings
43 proc Render {widget} {
44 global CurrentCamera CurrentLight
45 global TkInteractor_StartRenderMethod
46 global TkInteractor_EndRenderMethod
48 if { $TkInteractor_StartRenderMethod != "" } {
49 $TkInteractor_StartRenderMethod
52 eval $CurrentLight SetPosition [$CurrentCamera GetPosition]
53 eval $CurrentLight SetFocalPoint [$CurrentCamera GetFocalPoint]
57 if { $TkInteractor_EndRenderMethod != "" } {
58 $TkInteractor_EndRenderMethod
62 proc UpdateRenderer {widget x y} {
63 global CurrentCamera CurrentLight
64 global CurrentRenderWindow CurrentRenderer
65 global RendererFound LastX LastY
66 global WindowCenterX WindowCenterY
68 # Get the renderer window dimensions
69 set WindowX [lindex [$widget configure -width] 4]
70 set WindowY [lindex [$widget configure -height] 4]
72 # Find which renderer event has occurred in
73 set CurrentRenderWindow [$widget GetRenderWindow]
74 set renderers [$CurrentRenderWindow GetRenderers]
75 set numRenderers [$renderers GetNumberOfItems]
77 $renderers InitTraversal; set RendererFound 0
78 for {set i 0} {$i < $numRenderers} {incr i} {
79 set CurrentRenderer [$renderers GetNextItem]
80 set vx [expr double($x) / $WindowX]
81 set vy [expr ($WindowY - double($y)) / $WindowY]
82 set viewport [$CurrentRenderer GetViewport]
83 set vpxmin [lindex $viewport 0]
84 set vpymin [lindex $viewport 1]
85 set vpxmax [lindex $viewport 2]
86 set vpymax [lindex $viewport 3]
87 if { $vx >= $vpxmin && $vx <= $vpxmax && \
88 $vy >= $vpymin && $vy <= $vpymax} {
90 set WindowCenterX [expr double($WindowX)*(($vpxmax - $vpxmin)/2.0\
92 set WindowCenterY [expr double($WindowY)*(($vpymax - $vpymin)/2.0\
98 set CurrentCamera [$CurrentRenderer GetActiveCamera]
99 set lights [$CurrentRenderer GetLights]
100 $lights InitTraversal; set CurrentLight [$lights GetNextItem]
106 proc Enter {widget x y} {
111 UpdateRenderer $widget $x $y
114 proc StartMotion {widget x y} {
115 global CurrentCamera CurrentLight
116 global CurrentRenderWindow CurrentRenderer
119 global TkInteractor_InteractiveUpdateRate
120 global RubberZoomPerformed
122 UpdateRenderer $widget $x $y
123 if { ! $RendererFound } { return }
125 set RubberZoomPerformed 0
127 $CurrentRenderWindow SetDesiredUpdateRate $TkInteractor_InteractiveUpdateRate
130 proc EndMotion {widget x y} {
131 global CurrentRenderWindow
133 global TkInteractor_StillUpdateRate
134 global RubberZoomPerformed
135 global CurrentRenderer
137 if { ! $RendererFound } {return}
138 $CurrentRenderWindow SetDesiredUpdateRate $TkInteractor_StillUpdateRate
141 if { $RubberZoomPerformed } {
142 $CurrentRenderer RemoveProp RubberBandActor
149 # Objects used to display rubberband
150 vtkPoints RubberBandPoints
151 vtkCellArray RubberBandLines
152 vtkScalars RubberBandScalars
153 vtkPolyData RubberBandPolyData
154 vtkPolyDataMapper2D RubberBandMapper
155 vtkActor2D RubberBandActor
156 vtkLookupTable RubberBandColors
158 RubberBandPolyData SetPoints RubberBandPoints
159 RubberBandPolyData SetLines RubberBandLines
160 RubberBandMapper SetInput RubberBandPolyData
161 RubberBandMapper SetLookupTable RubberBandColors
162 RubberBandActor SetMapper RubberBandMapper
164 RubberBandColors SetNumberOfTableValues 2
165 RubberBandColors SetNumberOfColors 2
166 RubberBandColors SetTableValue 0 1.0 0.0 0.0 1.0
167 RubberBandColors SetTableValue 1 1.0 1.0 1.0 1.0
169 [RubberBandPolyData GetPointData] SetScalars RubberBandScalars
171 RubberBandMapper SetScalarRange 0 1
173 RubberBandPoints InsertPoint 0 0 0 0
174 RubberBandPoints InsertPoint 1 0 10 0
175 RubberBandPoints InsertPoint 2 10 10 0
176 RubberBandPoints InsertPoint 3 10 0 0
178 RubberBandLines InsertNextCell 5
179 RubberBandLines InsertCellPoint 0
180 RubberBandLines InsertCellPoint 1
181 RubberBandLines InsertCellPoint 2
182 RubberBandLines InsertCellPoint 3
183 RubberBandLines InsertCellPoint 0
185 RubberBandScalars InsertNextScalar 0
186 RubberBandScalars InsertNextScalar 1
187 RubberBandScalars InsertNextScalar 0
188 RubberBandScalars InsertNextScalar 1
190 RubberBandMapper ScalarVisibilityOn
192 # Called when the mouse button is release - do the zoom
193 proc DoRubberZoom { widget } {
194 global CurrentCamera CurrentRenderer
196 global StartRubberZoomX StartRubberZoomY
197 global EndRubberZoomX EndRubberZoomY
199 # Return if there is no renderer, or the rubber band is less
200 # that 5 pixels in either direction
201 if { ! $RendererFound } { return }
202 if { [expr $StartRubberZoomX - $EndRubberZoomX] < 5 && \
203 [expr $StartRubberZoomX - $EndRubberZoomX] > -5 } { return }
204 if { [expr $StartRubberZoomY - $EndRubberZoomY] < 5 && \
205 [expr $StartRubberZoomY - $EndRubberZoomY] > -5 } { return }
207 # We'll need the window height later
208 set WindowY [lindex [$widget configure -height] 4]
210 # What is the center of the rubber band box in pixels?
211 set centerX [expr ($StartRubberZoomX + $EndRubberZoomX)/2.0]
212 set centerY [expr ($StartRubberZoomY + $EndRubberZoomY)/2.0]
214 # Convert the focal point to a display coordinate in order to get the
215 # depth of the focal point in display units
216 set FPoint [$CurrentCamera GetFocalPoint]
217 set FPoint0 [lindex $FPoint 0]
218 set FPoint1 [lindex $FPoint 1]
219 set FPoint2 [lindex $FPoint 2]
220 $CurrentRenderer SetWorldPoint $FPoint0 $FPoint1 $FPoint2 1.0
221 $CurrentRenderer WorldToDisplay
222 set DPoint [$CurrentRenderer GetDisplayPoint]
223 set focalDepth [lindex $DPoint 2]
225 # Convert the position of the camera to a display coordinate in order
226 # to get the depth of the camera in display coordinates. Note this is
227 # a negative number (behind the near clipping plane of 0) but it works
229 set PPoint [$CurrentCamera GetPosition]
230 set PPoint0 [lindex $PPoint 0]
231 set PPoint1 [lindex $PPoint 1]
232 set PPoint2 [lindex $PPoint 2]
233 $CurrentRenderer SetWorldPoint $PPoint0 $PPoint1 $PPoint2 1.0
234 $CurrentRenderer WorldToDisplay
235 set DPoint [$CurrentRenderer GetDisplayPoint]
236 set positionDepth [lindex $DPoint 2]
238 # Find out the world position of where our new focal point should
239 # be - it will be at the center of the box, back at the same focal depth
240 # Don't actually set it now - we need to do all our computations before
241 # we modify the camera
242 $CurrentRenderer SetDisplayPoint $centerX $centerY $focalDepth
243 $CurrentRenderer DisplayToWorld
244 set newFocalPoint [$CurrentRenderer GetWorldPoint]
245 set newFocalPoint0 [lindex $newFocalPoint 0]
246 set newFocalPoint1 [lindex $newFocalPoint 1]
247 set newFocalPoint2 [lindex $newFocalPoint 2]
248 set newFocalPoint3 [lindex $newFocalPoint 3]
249 if { $newFocalPoint3 != 0.0 } {
250 set newFocalPoint0 [expr $newFocalPoint0 / $newFocalPoint3]
251 set newFocalPoint1 [expr $newFocalPoint1 / $newFocalPoint3]
252 set newFocalPoint2 [expr $newFocalPoint2 / $newFocalPoint3]
255 # Find out where the new camera position will be - at the center of
256 # the rubber band box at the position depth. Don't set it yet...
257 $CurrentRenderer SetDisplayPoint $centerX $centerY $positionDepth
258 $CurrentRenderer DisplayToWorld
259 set newPosition [$CurrentRenderer GetWorldPoint]
260 set newPosition0 [lindex $newPosition 0]
261 set newPosition1 [lindex $newPosition 1]
262 set newPosition2 [lindex $newPosition 2]
263 set newPosition3 [lindex $newPosition 3]
264 if { $newPosition3 != 0.0 } {
265 set newPosition0 [expr $newPosition0 / $newPosition3]
266 set newPosition1 [expr $newPosition1 / $newPosition3]
267 set newPosition2 [expr $newPosition2 / $newPosition3]
270 # We figured out how to position the camera to be centered, now we
271 # need to "zoom". In parallel, this is simple since we only need to
272 # change our parallel scale to encompass the entire y range of the
273 # rubber band box. In perspective, we assume the box is drawn on the
274 # near plane - this means that it is not possible that someone can
275 # draw a rubber band box around a nearby object and dolly past it. It
276 # also means that you won't get very close to distance objects - but that
277 # seems better than getting lost.
278 if {[$CurrentCamera GetParallelProjection]} {
279 # the new scale is just based on the y size of the rubber band box
280 # compared to the y size of the window
281 set ydiff [expr ($StartRubberZoomX - $EndRubberZoomX)]
282 if { $ydiff < 0.0 } { set ydiff [expr $ydiff * -1.0] }
283 set newScale [$CurrentCamera GetParallelScale]
284 set newScale [expr $newScale * $ydiff / $WindowY]
286 # now we can actually modify the camera
287 $CurrentCamera SetFocalPoint $newFocalPoint0 $newFocalPoint1 $newFocalPoint2
288 $CurrentCamera SetPosition $newPosition0 $newPosition1 $newPosition2
289 $CurrentCamera SetParallelScale $newScale
292 # find out the center of the rubber band box on the near plane
293 $CurrentRenderer SetDisplayPoint $centerX $centerY 0.0
294 $CurrentRenderer DisplayToWorld
295 set nearFocalPoint [$CurrentRenderer GetWorldPoint]
296 set nearFocalPoint0 [lindex $nearFocalPoint 0]
297 set nearFocalPoint1 [lindex $nearFocalPoint 1]
298 set nearFocalPoint2 [lindex $nearFocalPoint 2]
299 set nearFocalPoint3 [lindex $nearFocalPoint 3]
300 if { $nearFocalPoint3 != 0.0 } {
301 set nearFocalPoint0 [expr $nearFocalPoint0 / $nearFocalPoint3]
302 set nearFocalPoint1 [expr $nearFocalPoint1 / $nearFocalPoint3]
303 set nearFocalPoint2 [expr $nearFocalPoint2 / $nearFocalPoint3]
306 # find the world coordinates of the point centered on the rubber band box
307 # in x, on the border in y, and at the near plane depth.
308 $CurrentRenderer SetDisplayPoint $centerX $StartRubberZoomY 0.0
309 $CurrentRenderer DisplayToWorld
310 set focalEdge [$CurrentRenderer GetWorldPoint]
311 set focalEdge0 [lindex $focalEdge 0]
312 set focalEdge1 [lindex $focalEdge 1]
313 set focalEdge2 [lindex $focalEdge 2]
314 set focalEdge3 [lindex $focalEdge 3]
315 if { $focalEdge3 != 0.0 } {
316 set focalEdge0 [expr $focalEdge0 / $focalEdge3]
317 set focalEdge1 [expr $focalEdge1 / $focalEdge3]
318 set focalEdge2 [expr $focalEdge2 / $focalEdge3]
321 # how far is this "rubberband edge point" from the focal point?
324 ($nearFocalPoint0 - $focalEdge0)*($nearFocalPoint0 - $focalEdge0) + \
325 ($nearFocalPoint1 - $focalEdge1)*($nearFocalPoint1 - $focalEdge1) + \
326 ($nearFocalPoint2 - $focalEdge2)*($nearFocalPoint2 - $focalEdge2) )]
328 # We need to know how far back we must be so that when we view the scene
329 # with the current view angle, we see all of the y range of the rubber
330 # band box. Use a simple tangent equation - opposite / adjacent = tan theta
331 # where opposite is half the y height of the rubber band box on the near
332 # plane, adjacent is the distance we are solving for, and theta is half
333 # the viewing angle. This distance that we solve for is the new distance
334 # to the near plane - to find the new distance to the focal plane we
335 # must take the old distance to the focal plane, subtract the near plane
336 # distance, and add in the distance we solved for.
337 set angle [expr 0.5 * (3.141592 / 180.0) * [$CurrentCamera GetViewAngle]]
338 set d [expr $ydist/tan($angle)]
339 set range [$CurrentCamera GetClippingRange]
340 set nearplane [lindex $range 0]
341 set factor [expr [$CurrentCamera GetDistance] / \
342 ([$CurrentCamera GetDistance] - $nearplane + $d)]
344 # now we can actually modify the camera
345 $CurrentCamera SetFocalPoint $newFocalPoint0 $newFocalPoint1 $newFocalPoint2
346 $CurrentCamera SetPosition $newPosition0 $newPosition1 $newPosition2
347 $CurrentCamera Dolly $factor
348 $CurrentRenderer ResetCameraClippingRange
352 proc Rotate {widget x y} {
357 if { ! $RendererFound } { return }
359 $CurrentCamera Azimuth [expr ($LastX - $x)]
360 $CurrentCamera Elevation [expr ($y - $LastY)]
361 $CurrentCamera OrthogonalizeViewUp
369 proc RubberZoom {widget x y} {
371 global CurrentRenderer
372 global RubberZoomPerformed
374 global StartRubberZoomX StartRubberZoomY
375 global EndRubberZoomX EndRubberZoomY
377 if { ! $RendererFound } { return }
379 set WindowY [lindex [$widget configure -height] 4]
381 if { ! $RubberZoomPerformed } {
382 $CurrentRenderer AddProp RubberBandActor
384 set StartRubberZoomX $x
385 set StartRubberZoomY [expr $WindowY - $y - 1]
387 set RubberZoomPerformed 1
390 set EndRubberZoomX $x
391 set EndRubberZoomY [expr $WindowY - $y - 1]
393 RubberBandPoints SetPoint 0 $StartRubberZoomX $StartRubberZoomY 0
394 RubberBandPoints SetPoint 1 $StartRubberZoomX $EndRubberZoomY 0
395 RubberBandPoints SetPoint 2 $EndRubberZoomX $EndRubberZoomY 0
396 RubberBandPoints SetPoint 3 $EndRubberZoomX $StartRubberZoomY 0
402 proc Pan {widget x y} {
403 global CurrentRenderer CurrentCamera
404 global WindowCenterX WindowCenterY LastX LastY
407 if { ! $RendererFound } { return }
409 set FPoint [$CurrentCamera GetFocalPoint]
410 set FPoint0 [lindex $FPoint 0]
411 set FPoint1 [lindex $FPoint 1]
412 set FPoint2 [lindex $FPoint 2]
414 set PPoint [$CurrentCamera GetPosition]
415 set PPoint0 [lindex $PPoint 0]
416 set PPoint1 [lindex $PPoint 1]
417 set PPoint2 [lindex $PPoint 2]
419 $CurrentRenderer SetWorldPoint $FPoint0 $FPoint1 $FPoint2 1.0
420 $CurrentRenderer WorldToDisplay
421 set DPoint [$CurrentRenderer GetDisplayPoint]
422 set focalDepth [lindex $DPoint 2]
424 set APoint0 [expr $WindowCenterX + ($x - $LastX)]
425 set APoint1 [expr $WindowCenterY - ($y - $LastY)]
427 $CurrentRenderer SetDisplayPoint $APoint0 $APoint1 $focalDepth
428 $CurrentRenderer DisplayToWorld
429 set RPoint [$CurrentRenderer GetWorldPoint]
430 set RPoint0 [lindex $RPoint 0]
431 set RPoint1 [lindex $RPoint 1]
432 set RPoint2 [lindex $RPoint 2]
433 set RPoint3 [lindex $RPoint 3]
434 if { $RPoint3 != 0.0 } {
435 set RPoint0 [expr $RPoint0 / $RPoint3]
436 set RPoint1 [expr $RPoint1 / $RPoint3]
437 set RPoint2 [expr $RPoint2 / $RPoint3]
440 $CurrentCamera SetFocalPoint \
441 [expr ($FPoint0 - $RPoint0)/2.0 + $FPoint0] \
442 [expr ($FPoint1 - $RPoint1)/2.0 + $FPoint1] \
443 [expr ($FPoint2 - $RPoint2)/2.0 + $FPoint2]
445 $CurrentCamera SetPosition \
446 [expr ($FPoint0 - $RPoint0)/2.0 + $PPoint0] \
447 [expr ($FPoint1 - $RPoint1)/2.0 + $PPoint1] \
448 [expr ($FPoint2 - $RPoint2)/2.0 + $PPoint2]
456 proc Zoom {widget x y} {
457 global CurrentCamera CurrentRenderer
461 if { ! $RendererFound } { return }
463 set zoomFactor [expr pow(1.02,(0.5*($y - $LastY)))]
465 if {[$CurrentCamera GetParallelProjection]} {
466 set parallelScale [expr [$CurrentCamera GetParallelScale] * $zoomFactor];
467 $CurrentCamera SetParallelScale $parallelScale;
469 $CurrentCamera Dolly $zoomFactor
470 $CurrentRenderer ResetCameraClippingRange
479 proc Reset {widget x y} {
480 global CurrentRenderWindow
482 global CurrentRenderer
484 # Get the renderer window dimensions
485 set WindowX [lindex [$widget configure -width] 4]
486 set WindowY [lindex [$widget configure -height] 4]
488 # Find which renderer event has occurred in
489 set CurrentRenderWindow [$widget GetRenderWindow]
490 set renderers [$CurrentRenderWindow GetRenderers]
491 set numRenderers [$renderers GetNumberOfItems]
493 $renderers InitTraversal; set RendererFound 0
494 for {set i 0} {$i < $numRenderers} {incr i} {
495 set CurrentRenderer [$renderers GetNextItem]
496 set vx [expr double($x) / $WindowX]
497 set vy [expr ($WindowY - double($y)) / $WindowY]
499 set viewport [$CurrentRenderer GetViewport]
500 set vpxmin [lindex $viewport 0]
501 set vpymin [lindex $viewport 1]
502 set vpxmax [lindex $viewport 2]
503 set vpymax [lindex $viewport 3]
504 if { $vx >= $vpxmin && $vx <= $vpxmax && \
505 $vy >= $vpymin && $vy <= $vpymax} {
511 if { $RendererFound } {$CurrentRenderer ResetCamera}
516 proc Wireframe {widget} {
517 global CurrentRenderer
519 set actors [$CurrentRenderer GetActors]
521 $actors InitTraversal
522 set actor [$actors GetNextItem]
523 while { $actor != "" } {
524 [$actor GetProperty] SetRepresentationToWireframe
525 set actor [$actors GetNextItem]
531 proc Surface {widget} {
532 global CurrentRenderer
534 set actors [$CurrentRenderer GetActors]
536 $actors InitTraversal
537 set actor [$actors GetNextItem]
538 while { $actor != "" } {
539 [$actor GetProperty] SetRepresentationToSurface
540 set actor [$actors GetNextItem]
546 # Used to support picking operations
548 set PickedAssembly ""
549 vtkCellPicker ActorPicker
550 vtkProperty PickedProperty
551 PickedProperty SetColor 1 0 0
552 set PrePickedProperty ""
554 proc PickActor {widget x y} {
555 global CurrentRenderer RendererFound
556 global PickedAssembly PrePickedProperty WindowY
558 set WindowY [lindex [$widget configure -height] 4]
560 if { ! $RendererFound } { return }
561 ActorPicker Pick $x [expr $WindowY - $y - 1] 0.0 $CurrentRenderer
562 set assembly [ActorPicker GetAssembly]
564 if { $PickedAssembly != "" && $PrePickedProperty != "" } {
565 $PickedAssembly SetProperty $PrePickedProperty
566 # release hold on the property
567 $PrePickedProperty UnRegister $PrePickedProperty
568 set PrePickedProperty ""
571 if { $assembly != "" } {
572 set PickedAssembly $assembly
573 set PrePickedProperty [$PickedAssembly GetProperty]
574 # hold onto the property
575 $PrePickedProperty Register $PrePickedProperty
576 $PickedAssembly SetProperty PickedProperty