lib/maracasVisuLib/src/interface/tcl/to_change/TkInteractor.tcl

   1 set TkInteractor_StartRenderMethod ""
   2 set TkInteractor_EndRenderMethod ""
   3 set TkInteractor_InteractiveUpdateRate 15.0
   4 set TkInteractor_StillUpdateRate 0.1
   5
   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}
  22 }
  23
  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} {
  29         return
  30     }
  31     SetWidgetVariableValue $widget InExpose 1
  32     [$widget GetRenderWindow] SetDesiredUpdateRate $TkInteractor_StillUpdateRate
  33     update
  34     [$widget GetRenderWindow] Render
  35     SetWidgetVariableValue $widget InExpose 0
  36 }
  37
  38 # Global variable keeps track of whether active renderer was found
  39 set RendererFound 0
  40
  41 # Create event bindings
  42 #
  43 proc Render {widget} {
  44     global CurrentCamera CurrentLight
  45     global TkInteractor_StartRenderMethod
  46     global TkInteractor_EndRenderMethod
  47
  48     if { $TkInteractor_StartRenderMethod != "" } {
  49         $TkInteractor_StartRenderMethod
  50     }
  51
  52     eval $CurrentLight SetPosition [$CurrentCamera GetPosition]
  53     eval $CurrentLight SetFocalPoint [$CurrentCamera GetFocalPoint]
  54
  55     $widget Render
  56
  57     if { $TkInteractor_EndRenderMethod != "" } {
  58         $TkInteractor_EndRenderMethod
  59     }
  60 }
  61
  62 proc UpdateRenderer {widget x y} {
  63     global CurrentCamera CurrentLight
  64     global CurrentRenderWindow CurrentRenderer
  65     global RendererFound LastX LastY
  66     global WindowCenterX WindowCenterY
  67
  68     # Get the renderer window dimensions
  69     set WindowX [lindex [$widget configure -width] 4]
  70     set WindowY [lindex [$widget configure -height] 4]
  71
  72     # Find which renderer event has occurred in
  73     set CurrentRenderWindow [$widget GetRenderWindow]
  74     set renderers [$CurrentRenderWindow GetRenderers]
  75     set numRenderers [$renderers GetNumberOfItems]
  76
  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} {
  89             set RendererFound 1
  90             set WindowCenterX [expr double($WindowX)*(($vpxmax - $vpxmin)/2.0\
  91                                 + $vpxmin)]
  92             set WindowCenterY [expr double($WindowY)*(($vpymax - $vpymin)/2.0\
  93                                 + $vpymin)]
  94             break
  95         }
  96     }
  97
  98     set CurrentCamera [$CurrentRenderer GetActiveCamera]
  99     set lights [$CurrentRenderer GetLights]
 100     $lights InitTraversal; set CurrentLight [$lights GetNextItem]
 101
 102     set LastX $x
 103     set LastY $y
 104 }
 105
 106 proc Enter {widget x y} {
 107     global oldFocus
 108
 109     set oldFocus [focus]
 110     focus $widget
 111     UpdateRenderer $widget $x $y
 112 }
 113
 114 proc StartMotion {widget x y} {
 115     global CurrentCamera CurrentLight
 116     global CurrentRenderWindow CurrentRenderer
 117     global LastX LastY
 118     global RendererFound
 119     global TkInteractor_InteractiveUpdateRate
 120     global RubberZoomPerformed
 121
 122     UpdateRenderer $widget $x $y
 123     if { ! $RendererFound } { return }
 124
 125     set RubberZoomPerformed 0
 126
 127     $CurrentRenderWindow SetDesiredUpdateRate $TkInteractor_InteractiveUpdateRate
 128 }
 129
 130 proc EndMotion {widget x y} {
 131     global CurrentRenderWindow
 132     global RendererFound
 133     global TkInteractor_StillUpdateRate
 134     global RubberZoomPerformed
 135     global CurrentRenderer
 136
 137     if { ! $RendererFound } {return}
 138     $CurrentRenderWindow SetDesiredUpdateRate $TkInteractor_StillUpdateRate
 139
 140
 141     if { $RubberZoomPerformed } {
 142         $CurrentRenderer RemoveProp RubberBandActor
 143         DoRubberZoom $widget
 144     }
 145
 146     Render $widget
 147 }
 148
 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
 157
 158 RubberBandPolyData SetPoints      RubberBandPoints
 159 RubberBandPolyData SetLines       RubberBandLines
 160 RubberBandMapper   SetInput       RubberBandPolyData
 161 RubberBandMapper   SetLookupTable RubberBandColors
 162 RubberBandActor    SetMapper      RubberBandMapper
 163
 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
 168
 169 [RubberBandPolyData GetPointData] SetScalars RubberBandScalars
 170
 171 RubberBandMapper SetScalarRange 0 1
 172
 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
 177
 178 RubberBandLines  InsertNextCell 5
 179 RubberBandLines  InsertCellPoint 0
 180 RubberBandLines  InsertCellPoint 1
 181 RubberBandLines  InsertCellPoint 2
 182 RubberBandLines  InsertCellPoint 3
 183 RubberBandLines  InsertCellPoint 0
 184
 185 RubberBandScalars InsertNextScalar 0
 186 RubberBandScalars InsertNextScalar 1
 187 RubberBandScalars InsertNextScalar 0
 188 RubberBandScalars InsertNextScalar 1
 189
 190 RubberBandMapper ScalarVisibilityOn
 191
 192 # Called when the mouse button is release - do the zoom
 193 proc DoRubberZoom { widget } {
 194     global CurrentCamera CurrentRenderer
 195     global RendererFound
 196     global StartRubberZoomX StartRubberZoomY
 197     global EndRubberZoomX EndRubberZoomY
 198
 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 }
 206
 207     # We'll need the window height later
 208     set WindowY [lindex [$widget configure -height] 4]
 209
 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]
 213
 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]
 224
 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
 228     # ok anyway
 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]
 237
 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]
 253     }
 254
 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]
 268     }
 269
 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]
 285
 286         # now we can actually modify the camera
 287         $CurrentCamera SetFocalPoint $newFocalPoint0 $newFocalPoint1 $newFocalPoint2
 288         $CurrentCamera SetPosition $newPosition0 $newPosition1 $newPosition2
 289         $CurrentCamera SetParallelScale $newScale
 290
 291     } else {
 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]
 304         }
 305
 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]
 319         }
 320
 321         # how far is this "rubberband edge point" from the focal point?
 322         set ydist [expr \
 323                 sqrt( \
 324                 ($nearFocalPoint0 - $focalEdge0)*($nearFocalPoint0 - $focalEdge0) + \
 325                 ($nearFocalPoint1 - $focalEdge1)*($nearFocalPoint1 - $focalEdge1) + \
 326                 ($nearFocalPoint2 - $focalEdge2)*($nearFocalPoint2 - $focalEdge2) )]
 327
 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)]
 343
 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
 349     }
 350 }
 351
 352 proc Rotate {widget x y} {
 353     global CurrentCamera
 354     global LastX LastY
 355     global RendererFound
 356
 357     if { ! $RendererFound } { return }
 358
 359     $CurrentCamera Azimuth [expr ($LastX - $x)]
 360     $CurrentCamera Elevation [expr ($y - $LastY)]
 361     $CurrentCamera OrthogonalizeViewUp
 362
 363     set LastX $x
 364     set LastY $y
 365
 366     Render $widget
 367 }
 368
 369 proc RubberZoom {widget x y} {
 370     global RendererFound
 371     global CurrentRenderer
 372     global RubberZoomPerformed
 373     global LastX LastY
 374     global StartRubberZoomX StartRubberZoomY
 375     global EndRubberZoomX EndRubberZoomY
 376
 377     if { ! $RendererFound } { return }
 378
 379     set WindowY [lindex [$widget configure -height] 4]
 380
 381     if { ! $RubberZoomPerformed } {
 382         $CurrentRenderer AddProp RubberBandActor
 383
 384         set StartRubberZoomX $x
 385         set StartRubberZoomY [expr $WindowY - $y - 1]
 386
 387         set RubberZoomPerformed 1
 388     }
 389
 390     set EndRubberZoomX $x
 391     set EndRubberZoomY [expr $WindowY - $y - 1]
 392
 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
 397
 398     Render $widget
 399 }
 400
 401
 402 proc Pan {widget x y} {
 403     global CurrentRenderer CurrentCamera
 404     global WindowCenterX WindowCenterY LastX LastY
 405     global RendererFound
 406
 407     if { ! $RendererFound } { return }
 408
 409     set FPoint [$CurrentCamera GetFocalPoint]
 410         set FPoint0 [lindex $FPoint 0]
 411         set FPoint1 [lindex $FPoint 1]
 412         set FPoint2 [lindex $FPoint 2]
 413
 414     set PPoint [$CurrentCamera GetPosition]
 415         set PPoint0 [lindex $PPoint 0]
 416         set PPoint1 [lindex $PPoint 1]
 417         set PPoint2 [lindex $PPoint 2]
 418
 419     $CurrentRenderer SetWorldPoint $FPoint0 $FPoint1 $FPoint2 1.0
 420     $CurrentRenderer WorldToDisplay
 421     set DPoint [$CurrentRenderer GetDisplayPoint]
 422     set focalDepth [lindex $DPoint 2]
 423
 424     set APoint0 [expr $WindowCenterX + ($x - $LastX)]
 425     set APoint1 [expr $WindowCenterY - ($y - $LastY)]
 426
 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]
 438     }
 439
 440     $CurrentCamera SetFocalPoint \
 441       [expr ($FPoint0 - $RPoint0)/2.0 + $FPoint0] \
 442       [expr ($FPoint1 - $RPoint1)/2.0 + $FPoint1] \
 443       [expr ($FPoint2 - $RPoint2)/2.0 + $FPoint2]
 444
 445     $CurrentCamera SetPosition \
 446       [expr ($FPoint0 - $RPoint0)/2.0 + $PPoint0] \
 447       [expr ($FPoint1 - $RPoint1)/2.0 + $PPoint1] \
 448       [expr ($FPoint2 - $RPoint2)/2.0 + $PPoint2]
 449
 450     set LastX $x
 451     set LastY $y
 452
 453     Render $widget
 454 }
 455
 456 proc Zoom {widget x y} {
 457     global CurrentCamera CurrentRenderer
 458     global LastX LastY
 459     global RendererFound
 460
 461     if { ! $RendererFound } { return }
 462
 463     set zoomFactor [expr pow(1.02,(0.5*($y - $LastY)))]
 464
 465     if {[$CurrentCamera GetParallelProjection]} {
 466         set parallelScale [expr [$CurrentCamera GetParallelScale] * $zoomFactor];
 467         $CurrentCamera SetParallelScale $parallelScale;
 468     } else {
 469         $CurrentCamera Dolly $zoomFactor
 470         $CurrentRenderer ResetCameraClippingRange
 471     }
 472
 473     set LastX $x
 474     set LastY $y
 475
 476     Render $widget
 477 }
 478
 479 proc Reset {widget x y} {
 480     global CurrentRenderWindow
 481     global RendererFound
 482     global CurrentRenderer
 483
 484     # Get the renderer window dimensions
 485     set WindowX [lindex [$widget configure -width] 4]
 486     set WindowY [lindex [$widget configure -height] 4]
 487
 488     # Find which renderer event has occurred in
 489     set CurrentRenderWindow [$widget GetRenderWindow]
 490     set renderers [$CurrentRenderWindow GetRenderers]
 491     set numRenderers [$renderers GetNumberOfItems]
 492
 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]
 498
 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} {
 506             set RendererFound 1
 507             break
 508         }
 509     }
 510
 511     if { $RendererFound } {$CurrentRenderer ResetCamera}
 512
 513     Render $widget
 514 }
 515
 516 proc Wireframe {widget} {
 517     global CurrentRenderer
 518
 519     set actors [$CurrentRenderer GetActors]
 520
 521     $actors InitTraversal
 522     set actor [$actors GetNextItem]
 523     while { $actor != "" } {
 524         [$actor GetProperty] SetRepresentationToWireframe
 525         set actor [$actors GetNextItem]
 526     }
 527
 528     Render $widget
 529 }
 530
 531 proc Surface {widget} {
 532     global CurrentRenderer
 533
 534     set actors [$CurrentRenderer GetActors]
 535
 536     $actors InitTraversal
 537     set actor [$actors GetNextItem]
 538     while { $actor != "" } {
 539         [$actor GetProperty] SetRepresentationToSurface
 540         set actor [$actors GetNextItem]
 541     }
 542
 543     Render $widget
 544 }
 545
 546 # Used to support picking operations
 547 #
 548 set PickedAssembly ""
 549 vtkCellPicker ActorPicker
 550 vtkProperty PickedProperty
 551     PickedProperty SetColor 1 0 0
 552 set PrePickedProperty ""
 553
 554 proc PickActor {widget x y} {
 555     global CurrentRenderer RendererFound
 556     global PickedAssembly PrePickedProperty WindowY
 557
 558     set WindowY [lindex [$widget configure -height] 4]
 559
 560     if { ! $RendererFound } { return }
 561     ActorPicker Pick $x [expr $WindowY - $y - 1] 0.0 $CurrentRenderer
 562     set assembly [ActorPicker GetAssembly]
 563
 564     if { $PickedAssembly != "" && $PrePickedProperty != "" } {
 565         $PickedAssembly SetProperty $PrePickedProperty
 566         # release hold on the property
 567         $PrePickedProperty UnRegister $PrePickedProperty
 568         set PrePickedProperty ""
 569     }
 570
 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
 577     }
 578
 579     Render $widget
 580 }