lib/maracasVisuLib/src/interface/tcl/windows/u_mpr.tcl

   1 namespace eval u_mpr {
   2
   3     # public interface
   4     namespace export        \
   5         create              \
   6         positionate         \
   7         forget
   8
   9     # variables
  10     variable widgets
  11
  12     variable reference_actor
  13     variable mpr_data
  14     variable actual_plane -1
  15     variable bounds
  16     variable intRange
  17     variable stPoint
  18
  19     variable initX
  20     variable initY
  21     variable initWindow
  22     variable initLevel
  23     variable select_first
  24
  25 }
  26
  27 proc u_mpr::reset { parent } {
  28
  29     # For programming facilities
  30     upvar u_mpr::widgets widgets
  31
  32     set widgets(base)       "$parent"
  33     set widgets(work3D)     "$parent\.mpr"
  34     set widgets(controls)   "$parent\.mprControls"
  35     set widgets(type)       "$parent\.mprControls.type"
  36     set widgets(btnSagital) "$parent\.mprControls.type.btnSagital"
  37     set widgets(btnAxial)   "$parent\.mprControls.type.btnAxial"
  38     set widgets(btnCoronal) "$parent\.mprControls.type.btnCoronal"
  39     set widgets(lbl001)     "$parent\.mprControls.lbl001"
  40     set widgets(lbl002)     "$parent\.mprControls.lbl002"
  41     set widgets(sclMPR)     "$parent\.mprControls.sclMPR"
  42     set widgets(frMeasure)  "$parent\.mprControls.frMeasure"
  43     set widgets(lblMeasure) "$parent\.mprControls.frMeasure.01"
  44     set widgets(edtMeasure) "$parent\.mprControls.frMeasure.02"
  45
  46 }
  47
  48 proc u_mpr::create { parent } {
  49
  50     # For programming facilities
  51     upvar u_mpr::widgets widgets
  52     upvar u_mpr::select_first select_first
  53
  54     u_mpr::reset $parent
  55
  56     # frames
  57     frame $widgets(controls)  -borderwidth 1 -height 75 -relief groove -width 191
  58     frame $widgets(type)      -borderwidth 2 -height 75 -relief groove -width 125
  59     frame $widgets(frMeasure) -height 30 -width 30
  60
  61     # entries
  62     entry $widgets(edtMeasure) -cursor {}
  63
  64     # buttons
  65     radiobutton $widgets(btnSagital) -text $string_table::str_sagital -variable show_type -value 1 -command { u_mpr::set_probe $show_type #ff0000 }
  66     radiobutton $widgets(btnAxial)   -text $string_table::str_axial   -variable show_type -value 2 -command { u_mpr::set_probe $show_type #00ff00 }
  67     radiobutton $widgets(btnCoronal) -text $string_table::str_coronal -variable show_type -value 3 -command { u_mpr::set_probe $show_type #0000ff }
  68
  69     # labels
  70     label $widgets(lbl001)     -borderwidth 0 -text $string_table::str_mpr_controls
  71     label $widgets(lbl002)     -borderwidth 0 -text $string_table::str_mpr_type
  72     label $widgets(lblMeasure) -anchor w -borderwidth 0 -text $string_table::str_distance
  73
  74     scale $widgets(sclMPR) -label $string_table::str_slices -orient horizontal
  75
  76 }
  77
  78 proc u_mpr::positionate { } {
  79
  80     # For programming facilities
  81     upvar u_mpr::widgets widgets
  82
  83     pack  $widgets(work3D)     -anchor nw -expand 1 -fill both -side left
  84     pack  $widgets(controls)   -anchor nw -expand 0 -fill both -side left
  85     place $widgets(type)       -x 10 -y 80 -width 175 -height 100 -anchor nw -bordermode ignore
  86     place $widgets(btnSagital) -x 5 -y 5 -anchor nw -bordermode ignore
  87     place $widgets(btnAxial)   -x 5 -y 35 -anchor nw -bordermode ignore
  88     place $widgets(btnCoronal) -x 5 -y 65 -anchor nw -bordermode ignore
  89     place $widgets(lbl001)     -x 55 -y 25 -anchor nw -bordermode ignore
  90     place $widgets(lbl002)     -x 15 -y 70 -anchor nw -bordermode ignore
  91     place $widgets(sclMPR)     -x 5 -y 245 -width 178 -height 59 -anchor nw -bordermode ignore
  92     place $widgets(frMeasure)  -x 5 -y 430 -width 180 -height 25 -anchor nw -bordermode ignore
  93     pack  $widgets(lblMeasure) -anchor center -expand 0 -fill none -padx 2 -pady 2 -side left
  94     pack  $widgets(edtMeasure) -anchor center -expand 1 -fill x -padx 2 -pady 2 -side right
  95
  96 }
  97
  98 proc u_mpr::forget { } {
  99
 100     # For programming facilities
 101     upvar u_mpr::widgets widgets
 102
 103     pack  forget $widgets(edtMeasure)
 104     pack  forget $widgets(lblMeasure)
 105     place forget $widgets(frMeasure)
 106     place forget $widgets(sclMPR)
 107     place forget $widgets(lbl002)
 108     place forget $widgets(lbl001)
 109     place forget $widgets(btnCoronal)
 110     place forget $widgets(btnAxial)
 111     place forget $widgets(btnSagital)
 112     place forget $widgets(type)
 113     pack  forget $widgets(controls)
 114     pack  forget $widgets(work3D)
 115
 116 }
 117
 118 proc u_mpr::set_data { } {
 119
 120     # For programming facilities
 121     upvar u_mpr::widgets widgets
 122     upvar u_mpr::reference_actor reference_actor
 123     upvar u_mpr::mpr_data        mpr_data
 124     upvar u_mpr::actual_plane    actual_plane
 125     upvar u_mpr::bounds          bounds
 126     upvar u_mpr::intRange        intRange
 127     upvar u_mpr::select_first    select_first
 128
 129     set resample [ GetVTKVolume_dll ]
 130     set bounds   [ $resample GetBounds ]
 131
 132     # 3D outline
 133     catch { renderer_$widgets(work3D) RemoveActor outlineActor_$widgets(work3D) }
 134     catch { outlineActor_$widgets(work3D)  Delete }
 135     catch { outlineMapper_$widgets(work3D) Delete }
 136     catch { outlineSource_$widgets(work3D) Delete }
 137     catch { lookup_$widgets(work3D)        Delete }
 138
 139     # render widget
 140     destroy $widgets(work3D)
 141     vtkTkRenderWidget $widgets(work3D) -width 30 -height 30
 142
 143     # TODO: change
 144     bindBasicEvents $widgets(work3D)
 145
 146     set select_first 1
 147     bind $widgets(work3D) <Double-Button-1> "u_mpr::ev_dbl_select_st_point %x %y"
 148     bind $widgets(work3D) <Double-Button-3> "u_mpr::ev_dbl_select_point %x %y"
 149     $widgets(edtMeasure) delete 0 end
 150
 151     catch { renderer_$widgets(work3D) Delete }
 152     vtkRenderer renderer_$widgets(work3D)
 153     renderer_$widgets(work3D) SetBackground 0 0 0
 154     #renderer_$widgets(work3D) SetBackground 1 1 1
 155     set render [ $widgets(work3D) GetRenderWindow ]
 156     $render AddRenderer renderer_$widgets(work3D)
 157     $render SetSize 1 1
 158
 159     set u_mpr::stPoint {}
 160
 161     for { set i 0 } { $i < 3 } { incr i } {
 162
 163         catch { renderer_$widgets(work3D) RemoveActor outline_actor_{$widgets(work3D)}_{$i} }
 164         catch { renderer_$widgets(work3D) RemoveActor plane_{$widgets(work3D)}_{$i} }
 165         catch { plane_{$widgets(work3D)}_{$i}          Delete }
 166         catch { mapper_{$widgets(work3D)}_{$i}         Delete }
 167         catch { strip_{$widgets(work3D)}_{$i}          Delete }
 168         catch { triangle_{$widgets(work3D)}_{$i}       Delete }
 169         catch { cast_{$widgets(work3D)}_{$i}           Delete }
 170         catch { probe_filter_{$widgets(work3D)}_{$i}   Delete }
 171         catch { outline_actor_{$widgets(work3D)}_{$i}  Delete }
 172         catch { outline_mapper_{$widgets(work3D)}_{$i} Delete }
 173         catch { outline_filter_{$widgets(work3D)}_{$i} Delete }
 174         catch { trans_filter_{$widgets(work3D)}_{$i}   Delete }
 175         catch { transform_{$widgets(work3D)}_{$i}      Delete }
 176         catch { source_{$widgets(work3D)}_{$i}         Delete }
 177
 178     }
 179
 180     vtkCubeSource outlineSource_$widgets(work3D)
 181         outlineSource_$widgets(work3D) SetXLength [ expr [ lindex $bounds 1 ] - [ lindex $bounds 0 ] ]
 182         outlineSource_$widgets(work3D) SetYLength [ expr [ lindex $bounds 3 ] - [ lindex $bounds 2 ] ]
 183         outlineSource_$widgets(work3D) SetZLength [ expr [ lindex $bounds 5 ] - [ lindex $bounds 4 ] ]
 184         outlineSource_$widgets(work3D) SetCenter  \
 185             [ expr ( [ lindex $bounds 0 ] + [ lindex $bounds 1 ] ) / 2 ] \
 186             [ expr ( [ lindex $bounds 2 ] + [ lindex $bounds 3 ] ) / 2 ] \
 187             [ expr ( [ lindex $bounds 4 ] + [ lindex $bounds 5 ] ) / 2 ]
 188
 189     vtkPolyDataMapper outlineMapper_$widgets(work3D)
 190         outlineMapper_$widgets(work3D) SetInput [ outlineSource_$widgets(work3D) GetOutput ]
 191         outlineMapper_$widgets(work3D) ImmediateModeRenderingOn
 192
 193     vtkActor outlineActor_$widgets(work3D)
 194         outlineActor_$widgets(work3D) SetMapper outlineMapper_$widgets(work3D)
 195         [ outlineActor_$widgets(work3D) GetProperty ] SetRepresentationToWireframe
 196         [ outlineActor_$widgets(work3D) GetProperty ] SetColor    0.7 0.0 0.9
 197         [ outlineActor_$widgets(work3D) GetProperty ] SetAmbient  1
 198         [ outlineActor_$widgets(work3D) GetProperty ] SetDiffuse  0
 199         [ outlineActor_$widgets(work3D) GetProperty ] SetSpecular 0
 200
 201     renderer_$widgets(work3D) AddActor outlineActor_$widgets(work3D)
 202
 203     # Probe planes
 204     set range    [ GetImageRange_dll ]
 205     set xdiff    [ lindex [ split [ expr [ lindex $bounds 1 ] - [ lindex $bounds 0 ] ] . ] 0 ]
 206     set ydiff    [ lindex [ split [ expr [ lindex $bounds 3 ] - [ lindex $bounds 2 ] ] . ] 0 ]
 207     set zdiff    [ lindex [ split [ expr [ lindex $bounds 5 ] - [ lindex $bounds 4 ] ] . ] 0 ]
 208
 209     vtkWindowLevelLookupTable lookup_$widgets(work3D)
 210         lookup_$widgets(work3D) SetHueRange 0.0 1.0
 211         lookup_$widgets(work3D) SetNumberOfColors [ lindex [ split [ expr [ lindex $range 1 ] - [ lindex $range 0 ] + 1 ] . ] 0 ]
 212         lookup_$widgets(work3D) SetTableRange [ lindex $range 0 ] [ lindex $range 1 ]
 213         lookup_$widgets(work3D) SetSaturationRange 0 0
 214         lookup_$widgets(work3D) SetValueRange 0 1
 215         lookup_$widgets(work3D) SetAlphaRange 1 1
 216         lookup_$widgets(work3D) Build
 217
 218     for { set i 0 } { $i < 3 } { incr i } {
 219
 220         vtkPlaneSource source_{$widgets(work3D)}_{$i}
 221             source_{$widgets(work3D)}_{$i} SetResolution [ expr ( $i == 0 )? $zdiff: $xdiff ] [ expr ( $i == 1 )? $zdiff: $ydiff ]
 222
 223         vtkTransform transform_{$widgets(work3D)}_{$i}
 224             transform_{$widgets(work3D)}_{$i} Identity
 225             transform_{$widgets(work3D)}_{$i} Translate \
 226                 [ expr ( $xdiff / 2 ) + [ lindex $bounds 0 ] ] \
 227                 [ expr ( $ydiff / 2 ) + [ lindex $bounds 2 ] ] \
 228                 [ expr ( $zdiff / 2 ) + [ lindex $bounds 4 ] ]
 229             transform_{$widgets(work3D)}_{$i} Scale $xdiff $ydiff $zdiff
 230             if { $i == 0 } { transform_{$widgets(work3D)}_{$i} RotateY 90 }
 231             if { $i == 1 } { transform_{$widgets(work3D)}_{$i} RotateX 90 }
 232
 233         vtkTransformPolyDataFilter trans_filter_{$widgets(work3D)}_{$i}
 234             trans_filter_{$widgets(work3D)}_{$i} SetInput [ source_{$widgets(work3D)}_{$i} GetOutput ]
 235             trans_filter_{$widgets(work3D)}_{$i} SetTransform transform_{$widgets(work3D)}_{$i}
 236
 237         vtkOutlineFilter outline_filter_{$widgets(work3D)}_{$i}
 238             outline_filter_{$widgets(work3D)}_{$i} SetInput [ trans_filter_{$widgets(work3D)}_{$i} GetOutput ]
 239
 240         vtkPolyDataMapper outline_mapper_{$widgets(work3D)}_{$i}
 241             outline_mapper_{$widgets(work3D)}_{$i} SetInput [ outline_filter_{$widgets(work3D)}_{$i} GetOutput ]
 242
 243         vtkActor outline_actor_{$widgets(work3D)}_{$i}
 244             outline_actor_{$widgets(work3D)}_{$i} SetMapper outline_mapper_{$widgets(work3D)}_{$i}
 245             [ outline_actor_{$widgets(work3D)}_{$i} GetProperty ] SetRepresentationToWireframe
 246             [ outline_actor_{$widgets(work3D)}_{$i} GetProperty ] SetColor    0.7 0.0 0.9
 247             [ outline_actor_{$widgets(work3D)}_{$i} GetProperty ] SetAmbient  1
 248             [ outline_actor_{$widgets(work3D)}_{$i} GetProperty ] SetDiffuse  0
 249             [ outline_actor_{$widgets(work3D)}_{$i} GetProperty ] SetSpecular 0
 250
 251         vtkProbeFilter probe_filter_{$widgets(work3D)}_{$i}
 252             probe_filter_{$widgets(work3D)}_{$i} SetInput [ trans_filter_{$widgets(work3D)}_{$i} GetOutput ]
 253             probe_filter_{$widgets(work3D)}_{$i} SetSource $resample
 254
 255         vtkCastToConcrete cast_{$widgets(work3D)}_{$i}
 256             cast_{$widgets(work3D)}_{$i} SetInput [ probe_filter_{$widgets(work3D)}_{$i} GetOutput ]
 257
 258         vtkTriangleFilter triangle_{$widgets(work3D)}_{$i}
 259             triangle_{$widgets(work3D)}_{$i} SetInput [ cast_{$widgets(work3D)}_{$i} GetPolyDataOutput ]
 260
 261         vtkStripper strip_{$widgets(work3D)}_{$i}
 262             strip_{$widgets(work3D)}_{$i} SetInput [ triangle_{$widgets(work3D)}_{$i} GetOutput ]
 263
 264         vtkPolyDataMapper mapper_{$widgets(work3D)}_{$i}
 265         mapper_{$widgets(work3D)}_{$i} SetInput [ strip_{$widgets(work3D)}_{$i} GetOutput ]
 266         mapper_{$widgets(work3D)}_{$i} SetLookupTable lookup_$widgets(work3D)
 267         mapper_{$widgets(work3D)}_{$i} SetScalarRange [ lindex $range 0 ] [ lindex $range 1 ]
 268         mapper_{$widgets(work3D)}_{$i} ImmediateModeRenderingOn
 269
 270         vtkActor plane_{$widgets(work3D)}_{$i}
 271             plane_{$widgets(work3D)}_{$i} SetMapper mapper_{$widgets(work3D)}_{$i}
 272             [ plane_{$widgets(work3D)}_{$i} GetProperty ] SetOpacity 1.0
 273
 274     }
 275
 276     [ $widgets(work3D) GetRenderWindow ] Render
 277
 278     $widgets(btnSagital) deselect
 279     $widgets(btnAxial)   deselect
 280     $widgets(btnCoronal) deselect
 281
 282     $widgets(btnCoronal) invoke
 283
 284     global_window::active_controls [ expr \
 285         $global_window::en_open   | \
 286         $global_window::en_load   | \
 287         $global_window::en_params | \
 288         $global_window::en_rotate |  \
 289         $global_window::en_pan    |  \
 290         $global_window::en_bright |  \
 291         $global_window::en_zoom      \
 292     ]
 293
 294 }
 295
 296 proc u_mpr::set_probe { typ col } {
 297
 298     # For programming facilities
 299     upvar u_mpr::widgets widgets
 300     upvar u_mpr::reference_actor reference_actor
 301     upvar u_mpr::mpr_data        mpr_data
 302     upvar u_mpr::actual_plane    actual_plane
 303     upvar u_mpr::bounds          bounds
 304     upvar u_mpr::intRange        intRange
 305
 306     catch { renderer_$widgets(work3D) RemoveActor outline_actor_{$widgets(work3D)}_{$actual_plane} }
 307     catch { renderer_$widgets(work3D) RemoveActor plane_{$widgets(work3D)}_{$actual_plane} }
 308     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_1_$widgets(work3D) ] }
 309     DeleteSphere sphere_1_$widgets(work3D)
 310     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_2_$widgets(work3D) ] }
 311     DeleteSphere sphere_2_$widgets(work3D)
 312     catch { renderer_$widgets(work3D) RemoveActor textActor_$widgets(work3D) }
 313     catch { textActor_$widgets(work3D) Delete }
 314     catch { textMapper_$widgets(work3D) Delete }
 315     catch { textSource_$widgets(work3D) Delete }
 316     catch { tmp_picker_$widgets(work3D) Delete }
 317
 318     if { $actual_plane == 1 } {
 319
 320         [ renderer_$widgets(work3D) GetActiveCamera ] Elevation -90.0
 321         [ renderer_$widgets(work3D) GetActiveCamera ] OrthogonalizeViewUp
 322
 323     }
 324     if { $actual_plane == 0 } {
 325
 326             [ renderer_$widgets(work3D) GetActiveCamera ] Azimuth -90.0
 327             [ renderer_$widgets(work3D) GetActiveCamera ] OrthogonalizeViewUp
 328
 329     }
 330     [ $widgets(work3D) GetRenderWindow ] Render
 331     set actual_plane [ expr $typ - 1 ]
 332     if { $actual_plane == 0 || $actual_plane == 1 || $actual_plane == 2 } {
 333
 334         set r [ expr "0x[ string index $col 1 ][ string index $col 2 ]" / 255.0 ]
 335         set g [ expr "0x[ string index $col 3 ][ string index $col 4 ]" / 255.0 ]
 336         set b [ expr "0x[ string index $col 5 ][ string index $col 6 ]" / 255.0 ]
 337         [ outline_actor_{$widgets(work3D)}_{$actual_plane} GetProperty ] SetColor $r $g $b
 338         renderer_$widgets(work3D) AddActor outline_actor_{$widgets(work3D)}_{$actual_plane}
 339         renderer_$widgets(work3D) AddActor plane_{$widgets(work3D)}_{$actual_plane}
 340
 341         [ $widgets(work3D) GetRenderWindow ] Render
 342
 343         set resample [ GetVTKVolume_dll ]
 344         set bounds   [ $resample GetBounds ]
 345         $widgets(sclMPR) configure \
 346             -from [ lindex $bounds [ expr ( $actual_plane == 0 )? 0: ( $actual_plane == 1 )? 2: 4 ] ] \
 347             -to   [ lindex $bounds [ expr ( $actual_plane == 0 )? 1: ( $actual_plane == 1 )? 3: 5 ] ] \
 348             -fg $col \
 349             -resolution 0.5
 350
 351         bind $widgets(sclMPR) <Any-ButtonRelease>
 352         bind $widgets(sclMPR) <Any-ButtonRelease> "u_mpr::ev_change_slice 0"
 353         u_mpr::ev_change_slice 1
 354
 355         [ $widgets(work3D) GetRenderWindow ] Render
 356
 357         set xc [ expr ( [ lindex $bounds 1 ] + [ lindex $bounds 0 ] ) / 2 ]
 358         set yc [ expr ( [ lindex $bounds 3 ] + [ lindex $bounds 2 ] ) / 2 ]
 359         set zc [ expr ( [ lindex $bounds 5 ] + [ lindex $bounds 4 ] ) / 2 ]
 360         set xf $xc
 361         set yf $yc
 362         set zf $zc
 363         set zc [ expr $zc + 15 * [ expr [ lindex $bounds 5 ] - [ lindex $bounds 4 ] ] ]
 364         #[ renderer_$widgets(work3D) GetActiveCamera ] SetFocalPoint $xf $yf $zf
 365         #[ renderer_$widgets(work3D) GetActiveCamera ] SetPosition   $xc $yc $zc
 366
 367         if { $actual_plane == 0 } {
 368
 369             [ renderer_$widgets(work3D) GetActiveCamera ] Azimuth   90.0
 370             [ renderer_$widgets(work3D) GetActiveCamera ] OrthogonalizeViewUp
 371
 372         } elseif { $actual_plane == 1 } {
 373
 374             [ renderer_$widgets(work3D) GetActiveCamera ] Elevation 90.0
 375             [ renderer_$widgets(work3D) GetActiveCamera ] OrthogonalizeViewUp
 376
 377         }
 378
 379         [ $widgets(work3D) GetRenderWindow ] Render
 380
 381     }
 382
 383 }
 384
 385 proc u_mpr::ev_change_slice { typ } {
 386
 387     # For programming facilities
 388     upvar u_mpr::widgets widgets
 389     upvar u_mpr::reference_actor reference_actor
 390     upvar u_mpr::mpr_data        mpr_data
 391     upvar u_mpr::actual_plane    actual_plane
 392     upvar u_mpr::bounds          bounds
 393     upvar u_mpr::intRange        intRange
 394
 395     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_1_$widgets(work3D) ] }
 396     DeleteSphere sphere_1_$widgets(work3D)
 397     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_2_$widgets(work3D) ] }
 398     DeleteSphere sphere_2_$widgets(work3D)
 399     catch { renderer_$widgets(work3D) RemoveActor textActor_$widgets(work3D) }
 400     catch { textActor_$widgets(work3D) Delete }
 401     catch { textMapper_$widgets(work3D) Delete }
 402     catch { textSource_$widgets(work3D) Delete }
 403     catch { tmp_picker_$widgets(work3D) Delete }
 404     if { $actual_plane == 0 || $actual_plane == 1 || $actual_plane == 2 } {
 405
 406         if { $typ == 1 } {
 407
 408             set slc [ expr ( [ $widgets(sclMPR) cget -to ] + [ $widgets(sclMPR) cget -from ] ) / 2 ]
 409             $widgets(sclMPR) set $slc
 410
 411         } else { set slc [ $widgets(sclMPR) get ] }
 412
 413         set resample [ GetVTKVolume_dll ]
 414         set bounds   [ $resample GetBounds ]
 415         set xdiff [ expr [ lindex $bounds 1 ] - [ lindex $bounds 0 ] ];
 416         set ydiff [ expr [ lindex $bounds 3 ] - [ lindex $bounds 2 ] ];
 417         set zdiff [ expr [ lindex $bounds 5 ] - [ lindex $bounds 4 ] ];
 418
 419         transform_{$widgets(work3D)}_{$actual_plane} Identity
 420         transform_{$widgets(work3D)}_{$actual_plane} Translate \
 421             [ expr ( $actual_plane == 0 )? $slc: ( $xdiff / 2 ) + [ lindex $bounds 0 ] ] \
 422             [ expr ( $actual_plane == 1 )? $slc: ( $ydiff / 2 ) + [ lindex $bounds 2 ] ] \
 423             [ expr ( $actual_plane == 2 )? $slc: ( $zdiff / 2 ) + [ lindex $bounds 4 ] ]
 424         transform_{$widgets(work3D)}_{$actual_plane} Scale $xdiff $ydiff $zdiff
 425         if { $actual_plane == 0 } { transform_{$widgets(work3D)}_{$actual_plane} RotateY 90 }
 426         if { $actual_plane == 1 } { transform_{$widgets(work3D)}_{$actual_plane} RotateX 90 }
 427         [ $widgets(work3D) GetRenderWindow ] Render
 428
 429     }
 430
 431 }
 432
 433 proc u_mpr::set_mouse_events { bright_type } {
 434
 435     # For programming facilities
 436     upvar u_mpr::widgets widgets
 437     upvar u_mpr::reference_actor reference_actor
 438     upvar u_mpr::mpr_data        mpr_data
 439     upvar u_mpr::actual_plane    actual_plane
 440     upvar u_mpr::bounds          bounds
 441     upvar u_mpr::intRange        intRange
 442
 443     if { $bright_type == 0 } {
 444
 445         bind $widgets(work3D) <Any-ButtonPress>
 446         bind $widgets(work3D) <B1-Motion>
 447
 448         # TODO: change
 449         bindBasicEvents $widgets(work3D)
 450         bindZoomEvents $widgets(work3D) 0
 451
 452     } else {
 453
 454         bind $widgets(work3D) <Any-ButtonPress>
 455         bind $widgets(work3D) <B1-Motion>
 456
 457     }
 458
 459 }
 460
 461 proc u_mpr::ev_start_window_level { x y } {
 462
 463     # For programming facilities
 464     upvar u_mpr::widgets widgets
 465     upvar u_mpr::reference_actor reference_actor
 466     upvar u_mpr::mpr_data        mpr_data
 467     upvar u_mpr::actual_plane    actual_plane
 468     upvar u_mpr::bounds          bounds
 469     upvar u_mpr::intRange        intRange
 470     upvar u_mpr::initX           initX
 471     upvar u_mpr::initY           initY
 472     upvar u_mpr::initWindow      initWindow
 473     upvar u_mpr::initLevel       initLevel
 474
 475     set initX $x
 476     set initY $y
 477
 478     set initWindow [ lookup_$widgets(work3D) GetWindow ]
 479     set initLevel  [ lookup_$widgets(work3D) GetLevel  ]
 480
 481 }
 482
 483 proc u_mpr::ev_window_level { x y } {
 484
 485     # For programming facilities
 486     upvar u_mpr::widgets widgets
 487     upvar u_mpr::reference_actor reference_actor
 488     upvar u_mpr::mpr_data        mpr_data
 489     upvar u_mpr::actual_plane    actual_plane
 490     upvar u_mpr::bounds          bounds
 491     upvar u_mpr::intRange        intRange
 492     upvar u_mpr::initX           initX
 493     upvar u_mpr::initY           initY
 494     upvar u_mpr::initWindow      initWindow
 495     upvar u_mpr::initLevel       initLevel
 496
 497     # get the widgets dimensions
 498     set width  [ lindex [ $widgets(work3D) configure -width ] 4 ]
 499     set height [ lindex [ $widgets(work3D) configure -height ] 4 ]
 500
 501     # compute normalized delta
 502     set dx [ expr 4.0 * ( $x - $initX ) / $width  ]
 503     set dy [ expr 4.0 * ( $initY - $y ) / $height ]
 504
 505     # scale by current values
 506     set dx [ expr $dx * $initWindow ]
 507     set dy [ expr $dy * $initLevel  ]
 508
 509     # abs so that direction does not flip
 510     if { $initWindow < 0.0 } { set dx [ expr 0 - $dx ] }
 511     if { $initLevel < 0.0  } { set dy [ expr 0 - $dy ] }
 512
 513     # compute new window level
 514     set window [ expr $dx + $initWindow ]
 515     if {$window < 0.0} {
 516     set level [ expr $dy + $initLevel ]
 517     } else {
 518     set level [ expr $initLevel - $dy ]
 519     }
 520
 521     if { $window < 0.0 } { set dy [ expr 0 - $dy ] }
 522
 523     lookup_$widgets(work3D) SetWindow $window
 524     lookup_$widgets(work3D) SetLevel  $level
 525
 526     [ $widgets(work3D) GetRenderWindow ] Render
 527
 528 }
 529
 530 proc u_mpr::ev_dbl_select_point { x y } {
 531
 532     # For programming facilities
 533     upvar u_mpr::widgets widgets
 534     upvar u_mpr::actual_plane actual_plane
 535     upvar u_mpr::select_first select_first
 536
 537     set y [ expr [ lindex [ $widgets(work3D) configure -height ] 4 ] - $y - 1 ]
 538
 539     if { $select_first == 1 } {
 540
 541         catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_1_$widgets(work3D) ] }
 542         DeleteSphere sphere_1_$widgets(work3D)
 543         catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_2_$widgets(work3D) ] }
 544         DeleteSphere sphere_2_$widgets(work3D)
 545         catch { tmp_picker_$widgets(work3D) Delete }
 546
 547         vtkWorldPointPicker tmp_picker_$widgets(work3D)
 548         set pickWP    [ tmp_picker_$widgets(work3D) Pick $x $y 0 renderer_$widgets(work3D) ]
 549         set pickWPPos [ tmp_picker_$widgets(work3D) GetPickPosition ]
 550
 551         set xc [ lindex $pickWPPos 0 ]
 552         set yc [ lindex $pickWPPos 1 ]
 553         set zc [ lindex $pickWPPos 2 ]
 554         set resample [ GetVTKVolume_dll ]
 555
 556         set indP [ [ probe_filter_{$widgets(work3D)}_{$actual_plane} GetOutput ] FindPoint $xc $yc $zc ]
 557         set coordsP [ [ probe_filter_{$widgets(work3D)}_{$actual_plane} GetOutput ] GetPoint $indP ]
 558
 559         renderer_$widgets(work3D) AddActor [ \
 560             DrawSphere \
 561                 sphere_1_$widgets(work3D) \
 562                 0.5 \
 563                 [ lindex $coordsP 0 ] [ lindex $coordsP 1 ] [ lindex $coordsP 2 ] \
 564                 1.0 0.5 0.5
 565         ]
 566
 567         set select_first 0
 568
 569     } else {
 570
 571         catch { tmp_picker_$widgets(work3D) Delete }
 572
 573         vtkWorldPointPicker tmp_picker_$widgets(work3D)
 574         set pickWP    [ tmp_picker_$widgets(work3D) Pick $x $y 0 renderer_$widgets(work3D) ]
 575         set pickWPPos [ tmp_picker_$widgets(work3D) GetPickPosition ]
 576
 577         set xc [ lindex $pickWPPos 0 ]
 578         set yc [ lindex $pickWPPos 1 ]
 579         set zc [ lindex $pickWPPos 2 ]
 580         set resample [ GetVTKVolume_dll ]
 581
 582         set indP [ [ probe_filter_{$widgets(work3D)}_{$actual_plane} GetOutput ] FindPoint $xc $yc $zc ]
 583         set coordsP [ [ probe_filter_{$widgets(work3D)}_{$actual_plane} GetOutput ] GetPoint $indP ]
 584
 585         renderer_$widgets(work3D) AddActor [ \
 586             DrawSphere \
 587                 sphere_2_$widgets(work3D) \
 588                 0.5 \
 589                 [ lindex $coordsP 0 ] [ lindex $coordsP 1 ] [ lindex $coordsP 2 ] \
 590                 1.0 0.5 0.5
 591         ]
 592
 593         set select_first 1
 594
 595         set c1 [ sphere_1_$widgets(work3D) GetCenter ]
 596         set c2 [ sphere_2_$widgets(work3D) GetCenter ]
 597         set dist [ DistPoints \
 598             [ lindex $c1 0 ] \
 599             [ lindex $c1 1 ] \
 600             [ lindex $c1 2 ] \
 601             [ lindex $c2 0 ] \
 602             [ lindex $c2 1 ] \
 603             [ lindex $c2 2 ] \
 604         ]
 605
 606         $widgets(edtMeasure) delete 0 end
 607         $widgets(edtMeasure) insert 0 "$dist"
 608
 609     }
 610     [ $widgets(work3D) GetRenderWindow ] Render
 611
 612 }
 613
 614 proc u_mpr::ev_dbl_select_st_point { x y } {
 615
 616     # For programming facilities
 617     upvar u_mpr::widgets widgets
 618     upvar u_mpr::actual_plane actual_plane
 619     upvar u_mpr::select_first select_first
 620
 621     set y [ expr [ lindex [ $widgets(work3D) configure -height ] 4 ] - $y - 1 ]
 622
 623     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_st_$widgets(work3D) ] }
 624     DeleteSphere sphere_st_$widgets(work3D)
 625     catch { tmp_picker_$widgets(work3D) Delete }
 626
 627     vtkWorldPointPicker tmp_picker_$widgets(work3D)
 628     set pickWP    [ tmp_picker_$widgets(work3D) Pick $x $y 0 renderer_$widgets(work3D) ]
 629     set pickWPPos [ tmp_picker_$widgets(work3D) GetPickPosition ]
 630
 631     set xc [ lindex $pickWPPos 0 ]
 632     set yc [ lindex $pickWPPos 1 ]
 633     set zc [ lindex $pickWPPos 2 ]
 634     set resample [ GetVTKVolume_dll ]
 635
 636     set indP [ [ probe_filter_{$widgets(work3D)}_{$actual_plane} GetOutput ] FindPoint $xc $yc $zc ]
 637     set coordsP [ [ probe_filter_{$widgets(work3D)}_{$actual_plane} GetOutput ] GetPoint $indP ]
 638
 639     renderer_$widgets(work3D) AddActor [ \
 640         DrawSphere \
 641             sphere_st_$widgets(work3D) \
 642             1.0 \
 643             [ lindex $coordsP 0 ] [ lindex $coordsP 1 ] [ lindex $coordsP 2 ] \
 644             0.0 0.0 1.0
 645     ]
 646     set u_mpr::stPoint "[ lindex $coordsP 0 ] [ lindex $coordsP 1 ] [ lindex $coordsP 2 ]"
 647
 648     [ $widgets(work3D) GetRenderWindow ] Render
 649
 650 }
 651
 652 proc u_mpr::set_mouse_left_events { mask } {
 653
 654     # For programming facilities
 655     upvar u_mpr::widgets widgets
 656
 657     # TODO : change
 658     catch { bind $widgets(work3D) <Any-ButtonPress>   { ev_startMotion %W %x %y } }
 659     catch { bind $widgets(work3D) <Any-ButtonRelease> { ev_endMotion %W %x %y } }
 660
 661     catch { bind $widgets(work3D) <B1-Motion> { evz_pan %W %x %y } }
 662
 663 }
 664
 665 proc u_mpr::set_mouse_right_events { mask } {
 666
 667     # For programming facilities
 668     upvar u_mpr::widgets widgets
 669
 670     if { [ expr $mask & 0x4 ] == 0x4 } {
 671
 672         catch { bind $widgets(work3D) <ButtonPress-3>   { ev_startMotion %W %x %y } }
 673         catch { bind $widgets(work3D) <ButtonRelease-3> { ev_endMotion %W %x %y } }
 674         catch { bind $widgets(work3D) <B3-Motion>       { evz_zoom %W %x %y } }
 675
 676     }
 677     if { [ expr $mask & 0x8 ] == 0x8 } {
 678
 679         catch { bind $widgets(work3D) <ButtonPress-3>   { u_mpr::ev_start_window_level %x %y } }
 680         catch { bind $widgets(work3D) <ButtonRelease-3> { } }
 681         catch { bind $widgets(work3D) <B3-Motion>       { u_mpr::ev_window_level %x %y } }
 682
 683     }
 684
 685 }
 686
 687 # EOF - u_mpr.tcl