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

   1 package require BLT
   2 package require combobox
   3 catch { namespace import blt::* }
   4 catch { namespace import combobox::* }
   5
   6 namespace eval u_surf {
   7
   8     # public interface
   9     namespace export        \
  10         create              \
  11         positionate         \
  12         forget
  13
  14     # variables
  15     variable widgets
  16
  17     variable reference_actor
  18     variable actual_actor
  19     variable surf_data
  20     variable bounds
  21     variable intRange
  22     variable axis_index -1
  23     variable indexes
  24
  25 }
  26
  27 proc u_surf::reset { parent } {
  28
  29     # For programming facilities
  30     upvar u_surf::widgets widgets
  31
  32     set widgets(base)            "$parent"
  33     set widgets(work3D)          "$parent\.surf"
  34     set widgets(controls)        "$parent\.surfControls"
  35     set widgets(frButtons)       "$parent\.surfControls.frButtons"
  36     set widgets(btnExtract)      "$parent\.surfControls.frButtons.btnExtract"
  37     set widgets(btnErase)        "$parent\.surfControls.frButtons.btnErase"
  38     set widgets(btnAdd)          "$parent\.surfControls.frButtons.btnAdd"
  39     set widgets(btnContinue)     "$parent\.surfControls.frButtons.btnContinue"
  40     set widgets(frOther)         "$parent\.surfControls.frOther"
  41     set widgets(frSurface)       "$parent\.surfControls.frOther.frSurface"
  42     set widgets(btnOpaque)       "$parent\.surfControls.frOther.frSurface.btnOpaque"
  43     set widgets(btnTransparent)  "$parent\.surfControls.frOther.frSurface.btnTransparent"
  44     set widgets(btnEdgePoints)   "$parent\.surfControls.frOther.frSurface.btnEdgePoints"
  45     set widgets(frSurfaceValues) "$parent\.surfControls.frOther.frSurfaceValues"
  46     set widgets(sclIso)          "$parent\.surfControls.frOther.frSurfaceValues.sclIso"
  47     set widgets(sclOpacity)      "$parent\.surfControls.frOther.frSurfaceValues.sclOpacity"
  48     set widgets(btnColor)        "$parent\.surfControls.frOther.btnColor"
  49     set widgets(lbl001)          "$parent\.surfControls.frOther.lbl001"
  50     set widgets(lbl002)          "$parent\.surfControls.frOther.lbl002"
  51     set widgets(lbl003)          "$parent\.surfControls.frOther.lbl003"
  52     set widgets(frChooseAxis)    "$parent\.surfControls.frOther.frChooseAxis"
  53     set widgets(lblChooseAxis)   "$parent\.surfControls.frOther.frChooseAxis.01"
  54     set widgets(edtChooseAxis)   "$parent\.surfControls.frOther.frChooseAxis.02"
  55     set widgets(btnSaveAsVtk)   "$parent\.surfControls.frOther.btnSaveAsVtk"
  56
  57 }
  58
  59 proc u_surf::create { parent } {
  60
  61     # For programming facilities
  62     upvar u_surf::widgets widgets
  63
  64     u_surf::reset $parent
  65
  66     # frames
  67     frame $widgets(controls)        -borderwidth 2 -height 75 -relief groove -width 125
  68     frame $widgets(frButtons)       -borderwidth 2 -height 75 -relief groove -width 125
  69     frame $widgets(frOther)         -borderwidth 2 -height 75 -relief groove -width 125
  70     frame $widgets(frSurface)       -borderwidth 2 -height 75 -relief groove -width 125
  71     frame $widgets(frSurfaceValues) -borderwidth 2 -height 75 -relief groove -width 125
  72     frame $widgets(frChooseAxis)    -height 30 -width 30
  73
  74     # buttons
  75     button $widgets(btnExtract)  -relief flat -image $global_window::images(extract)  -command "u_surf::extract_axis"
  76     button $widgets(btnErase)    -relief flat -image $global_window::images(del_axis) -command "u_surf::remove_axis"
  77     button $widgets(btnAdd)      -relief flat -image $global_window::images(add)      -command "u_surf::add_axis"
  78     button $widgets(btnContinue) -relief flat -image $global_window::images(continue) -command "u_surf::continue_axis"
  79     button $widgets(btnColor)    -command "u_surf::change_color"
  80     button $widgets(btnSaveAsVtk) -text "Save as VTK..." -command "u_surf::saveasvtk"
  81
  82     bind $widgets(btnExtract)  <Enter> { if { [ string compare [ %W cget -state ] "normal" ] == 0 } { %W configure -relief raised } }
  83     bind $widgets(btnErase)    <Enter> { if { [ string compare [ %W cget -state ] "normal" ] == 0 } { %W configure -relief raised } }
  84     bind $widgets(btnAdd)      <Enter> { if { [ string compare [ %W cget -state ] "normal" ] == 0 } { %W configure -relief raised } }
  85     bind $widgets(btnContinue) <Enter> { if { [ string compare [ %W cget -state ] "normal" ] == 0 } { %W configure -relief raised } }
  86
  87     bind $widgets(btnExtract)  <Leave> { %W configure -relief flat }
  88     bind $widgets(btnErase)    <Leave> { %W configure -relief flat }
  89     bind $widgets(btnAdd)      <Leave> { %W configure -relief flat }
  90     bind $widgets(btnContinue) <Leave> { %W configure -relief flat }
  91
  92     # radiobuttons
  93     radiobutton $widgets(btnOpaque)      -text $string_table::str_opaque      -variable surf_type  -value 1 -command { u_surf::set_IsoActor $surf_type }
  94     radiobutton $widgets(btnTransparent) -text $string_table::str_transparent -variable surf_type  -value 2 -command { u_surf::set_IsoActor $surf_type }
  95     radiobutton $widgets(btnEdgePoints)  -text $string_table::str_edge_points -variable surf_type  -value 3 -command { u_surf::set_IsoActor $surf_type }
  96
  97     # scales
  98     scale $widgets(sclIso)     -label $string_table::str_isovalue -orient horizontal
  99     scale $widgets(sclOpacity) -label $string_table::str_opacity -orient horizontal -from 0.0 -to 1.0 -resolution 0.01
 100
 101     # labels
 102     label $widgets(lbl001)        -borderwidth 0 -text $string_table::str_surface
 103     label $widgets(lbl002)        -borderwidth 0 -text $string_table::str_surface_values
 104     label $widgets(lbl003)        -borderwidth 0 -text $string_table::str_surface_color
 105     label $widgets(lblChooseAxis) -anchor w -borderwidth 0 -text $string_table::str_axis
 106
 107     # comboboxes
 108     combobox $widgets(edtChooseAxis) \
 109         -editable true      \
 110         -command  "u_surf::select_axis"
 111
 112 }
 113
 114 proc u_surf::positionate { } {
 115
 116     # For programming facilities
 117     upvar u_surf::widgets widgets
 118
 119     set global_window::show_params 0
 120
 121     pack  $widgets(work3D)          -anchor nw -expand 1 -fill both -side left
 122     pack  $widgets(controls)        -anchor nw -expand 0 -fill both -side left
 123     pack  $widgets(frButtons)       -anchor center -expand 0 -fill none -side top
 124     pack  $widgets(btnExtract)      -anchor nw -expand 0 -fill none -side left
 125     pack  $widgets(btnErase)        -anchor nw -expand 0 -fill none -side left
 126     pack  $widgets(btnAdd)          -anchor nw -expand 0 -fill none -side left
 127     pack  $widgets(btnContinue)     -anchor nw -expand 0 -fill none -side left
 128     pack  $widgets(frOther)         -anchor center -expand 1 -fill both -side top
 129     place $widgets(frSurface)       -x 10 -y 55 -width 165 -height 80 -anchor nw -bordermode ignore
 130     place $widgets(btnOpaque)       -x 15 -y 10 -anchor nw -bordermode ignore
 131     place $widgets(btnTransparent)  -x 15 -y 30 -anchor nw -bordermode ignore
 132     place $widgets(btnEdgePoints)   -x 15 -y 50 -anchor nw -bordermode ignore
 133     place $widgets(frSurfaceValues) -x 10 -y 155 -width 165 -height 140 -anchor nw -bordermode ignore
 134     place $widgets(sclIso)          -x 5 -y 10 -width 153 -height 59 -anchor nw -bordermode ignore
 135     place $widgets(sclOpacity)      -x 5 -y 70 -width 153 -height 59 -anchor nw -bordermode ignore
 136     place $widgets(btnColor)        -x 10 -y 320 -width 165 -height 48 -anchor nw -bordermode ignore
 137     place $widgets(lbl001)          -x 15 -y 45 -anchor nw -bordermode ignore
 138     place $widgets(lbl002)          -x 15 -y 145 -anchor nw -bordermode ignore
 139     place $widgets(lbl003)          -x 10 -y 300 -anchor nw -bordermode ignore
 140     place $widgets(frChooseAxis)    -x 5 -y 10 -width 170 -height 25 -anchor nw -bordermode ignore
 141     #place $widgets(btnSaveAsVtk)    -x 15 -y 400 -width 150 -height 25 -anchor nw -bordermode ignore
 142     pack  $widgets(lblChooseAxis)   -anchor center -expand 0 -fill none -padx 2 -pady 2 -side left
 143     pack  $widgets(edtChooseAxis)   -anchor center -expand 1 -fill x -padx 2 -pady 2 -side right
 144
 145     if { $u_mpr::stPoint != "" } {
 146
 147         u_surf::select_initial_2 [ lindex $u_mpr::stPoint 0 ] [ lindex $u_mpr::stPoint 1 ] [ lindex $u_mpr::stPoint 2 ]
 148
 149     }
 150
 151 }
 152
 153 proc u_surf::forget { } {
 154
 155     # For programming facilities
 156     upvar u_surf::widgets widgets
 157
 158     pack  forget $widgets(edtChooseAxis)
 159     pack  forget $widgets(lblChooseAxis)
 160     place forget $widgets(btnSaveAsVtk)
 161     place forget $widgets(frChooseAxis)
 162     place forget $widgets(lbl003)
 163     place forget $widgets(lbl002)
 164     place forget $widgets(lbl001)
 165     place forget $widgets(btnColor)
 166     place forget $widgets(sclOpacity)
 167     place forget $widgets(sclIso)
 168     place forget $widgets(frSurfaceValues)
 169     place forget $widgets(btnEdgePoints)
 170     place forget $widgets(btnTransparent)
 171     place forget $widgets(btnOpaque)
 172     place forget $widgets(frSurface)
 173     pack  forget $widgets(frOther)
 174     pack  forget $widgets(btnContinue)
 175     pack  forget $widgets(btnAdd)
 176     pack  forget $widgets(btnErase)
 177     pack  forget $widgets(btnExtract)
 178     pack  forget $widgets(frButtons)
 179     pack  forget $widgets(controls)
 180     pack  forget $widgets(work3D)
 181
 182 }
 183
 184 proc u_surf::set_data { } {
 185
 186     # For programming facilities
 187     upvar u_surf::widgets widgets
 188     upvar u_surf::axis_index      axis_index
 189
 190     set axis_index 0
 191
 192     $widgets(edtChooseAxis) list delete 0 end
 193     $widgets(edtChooseAxis) delete 0 end
 194
 195     # render widget
 196     destroy $widgets(work3D)
 197     vtkTkRenderWidget $widgets(work3D) -width 30 -height 30
 198
 199     # TODO: change
 200     bindBasicEvents $widgets(work3D)
 201
 202     bind $widgets(work3D) <Double-Button-1> "u_surf::select_initial %x %y"
 203     bind $widgets(work3D) <Double-Button-3> "u_surf::select_axis_point %x %y"
 204
 205     catch { renderer_$widgets(work3D) Delete }
 206     vtkRenderer renderer_$widgets(work3D)
 207     set render [ $widgets(work3D) GetRenderWindow ]
 208     renderer_$widgets(work3D) SetBackground 1 1 1
 209     #renderer_$widgets(work3D) SetBackground 0.023 0.239 0.909
 210     #renderer_$widgets(work3D) SetBackground 0 0 0.627
 211     $render AddRenderer renderer_$widgets(work3D)
 212     $render SetSize 1 1
 213
 214     set range    [ GetImageRange_dll ]
 215     set resample [ GetVTKVolume_dll ]
 216     set bounds   [ $resample GetBounds ]
 217     $widgets(btnColor) configure -background #faebd6
 218     set r 0.9803
 219     set g 0.9215
 220     set b 0.8392
 221
 222     catch { renderer_$widgets(work3D) RemoveActor outlineActor_$widgets(work3D) }
 223     catch { renderer_$widgets(work3D) RemoveActor isoActor_$widgets(work3D) }
 224     catch { renderer_$widgets(work3D) RemoveActor edgeActor_$widgets(work3D) }
 225     catch { renderer_$widgets(work3D) RemoveVolume opaqueVol_$widgets(work3D) }
 226     catch { outlineActor_$widgets(work3D)  Delete }
 227     catch { outlineMapper_$widgets(work3D) Delete }
 228     catch { outlineSource_$widgets(work3D) Delete }
 229     catch { opaqueVol_$widgets(work3D)     Delete }
 230     catch { isoCast_$widgets(work3D)       Delete }
 231     catch { isoFunc_$widgets(work3D)       Delete }
 232     catch { opaqueProp_$widgets(work3D)    Delete }
 233     catch { colorFunc_$widgets(work3D)     Delete }
 234     catch { constFunc_$widgets(work3D)     Delete }
 235     catch { edgeActor_$widgets(work3D)     Delete }
 236     catch { edgeMapper_$widgets(work3D)    Delete }
 237     catch { edgePoints_$widgets(work3D)    Delete }
 238     catch { isoActor_$widgets(work3D)      Delete }
 239     catch { isoMapper_$widgets(work3D)     Delete }
 240     catch { cubes_$widgets(work3D)         Delete }
 241     catch { struct_$widgets(work3D)        Delete }
 242
 243     # 3D outline
 244     vtkCubeSource outlineSource_$widgets(work3D)
 245         outlineSource_$widgets(work3D) SetXLength [ expr [ lindex $bounds 1 ] - [ lindex $bounds 0 ] ]
 246         outlineSource_$widgets(work3D) SetYLength [ expr [ lindex $bounds 3 ] - [ lindex $bounds 2 ] ]
 247         outlineSource_$widgets(work3D) SetZLength [ expr [ lindex $bounds 5 ] - [ lindex $bounds 4 ] ]
 248         outlineSource_$widgets(work3D) SetCenter  \
 249             [ expr ( [ lindex $bounds 0 ] + [ lindex $bounds 1 ] ) / 2 ] \
 250             [ expr ( [ lindex $bounds 2 ] + [ lindex $bounds 3 ] ) / 2 ] \
 251             [ expr ( [ lindex $bounds 4 ] + [ lindex $bounds 5 ] ) / 2 ]
 252
 253     vtkPolyDataMapper outlineMapper_$widgets(work3D)
 254         outlineMapper_$widgets(work3D) SetInput [ outlineSource_$widgets(work3D) GetOutput ]
 255         outlineMapper_$widgets(work3D) ImmediateModeRenderingOn
 256
 257     vtkActor outlineActor_$widgets(work3D)
 258         outlineActor_$widgets(work3D) SetMapper outlineMapper_$widgets(work3D)
 259         [ outlineActor_$widgets(work3D) GetProperty ] SetRepresentationToWireframe
 260         [ outlineActor_$widgets(work3D) GetProperty ] SetColor    0.7 0.0 0.9
 261         [ outlineActor_$widgets(work3D) GetProperty ] SetAmbient  1
 262         [ outlineActor_$widgets(work3D) GetProperty ] SetDiffuse  0
 263         [ outlineActor_$widgets(work3D) GetProperty ] SetSpecular 0
 264
 265     renderer_$widgets(work3D) AddActor outlineActor_$widgets(work3D)
 266
 267     # Surface
 268     vtkImageToStructuredPoints struct_$widgets(work3D)
 269         struct_$widgets(work3D) SetInput $resample
 270         struct_$widgets(work3D) Update
 271
 272     vtkMarchingCubes cubes_$widgets(work3D)
 273         cubes_$widgets(work3D) SetInput [ struct_$widgets(work3D) GetOutput ]
 274         cubes_$widgets(work3D) SetValue 0 [ expr [ lindex $range 1 ] / 4 ]
 275
 276     vtkPolyDataMapper isoMapper_$widgets(work3D)
 277         isoMapper_$widgets(work3D) SetInput [ cubes_$widgets(work3D) GetOutput ]
 278         isoMapper_$widgets(work3D) ScalarVisibilityOff
 279         isoMapper_$widgets(work3D) ImmediateModeRenderingOn
 280
 281     vtkActor isoActor_$widgets(work3D)
 282         isoActor_$widgets(work3D) SetMapper isoMapper_$widgets(work3D)
 283         eval [ isoActor_$widgets(work3D) GetProperty ] SetColor $r $g $b
 284         eval [ isoActor_$widgets(work3D) GetProperty ] SetOpacity 0.5
 285
 286     # Edge points
 287     vtkEdgePoints edgePoints_$widgets(work3D)
 288         edgePoints_$widgets(work3D) SetInput $resample
 289         edgePoints_$widgets(work3D) SetValue [ expr [ lindex $range 1 ] / 4 ]
 290
 291     vtkDataSetMapper edgeMapper_$widgets(work3D)
 292         edgeMapper_$widgets(work3D) SetInput [ edgePoints_$widgets(work3D) GetOutput ]
 293         edgeMapper_$widgets(work3D) ScalarVisibilityOff
 294         edgeMapper_$widgets(work3D) ImmediateModeRenderingOn
 295
 296     vtkActor edgeActor_$widgets(work3D)
 297         edgeActor_$widgets(work3D) SetMapper edgeMapper_$widgets(work3D)
 298         eval [ edgeActor_$widgets(work3D) GetProperty ] SetColor $r $g $b
 299
 300     # Opaque
 301     vtkPiecewiseFunction constFunc_$widgets(work3D)
 302         constFunc_$widgets(work3D) AddPoint  0                  1.0
 303         constFunc_$widgets(work3D) AddPoint  [ lindex $range 1 ]  1.0
 304
 305     vtkColorTransferFunction colorFunc_$widgets(work3D)
 306         colorFunc_$widgets(work3D) AddRGBPoint 0.0                 1.0 1.0 1.0
 307         colorFunc_$widgets(work3D) AddRGBPoint [ lindex $range 1 ] 1.0 1.0 1.0
 308
 309     vtkVolumeProperty opaqueProp_$widgets(work3D)
 310         opaqueProp_$widgets(work3D) SetColor colorFunc_$widgets(work3D)
 311         opaqueProp_$widgets(work3D) SetScalarOpacity constFunc_$widgets(work3D)
 312         opaqueProp_$widgets(work3D) ShadeOn
 313         opaqueProp_$widgets(work3D) SetInterpolationTypeToLinear
 314
 315     vtkVolumeRayCastIsosurfaceFunction isoFunc_$widgets(work3D)
 316         isoFunc_$widgets(work3D) SetIsoValue [ expr [ lindex $range 1 ] / 4 ]
 317
 318     vtkVolumeRayCastMapper isoCast_$widgets(work3D)
 319         isoCast_$widgets(work3D) SetInput $resample
 320         isoCast_$widgets(work3D) SetVolumeRayCastFunction isoFunc_$widgets(work3D)
 321
 322     vtkVolume opaqueVol_$widgets(work3D)
 323         opaqueVol_$widgets(work3D) SetMapper isoCast_$widgets(work3D)
 324         opaqueVol_$widgets(work3D) SetProperty opaqueProp_$widgets(work3D)
 325
 326     $widgets(sclIso) configure \
 327         -from [ lindex $range 0 ] \
 328         -to   [ lindex $range 1 ] \
 329         -resolution 1.0
 330
 331     $widgets(sclOpacity) configure \
 332         -from 0.0 \
 333         -to   1.0 \
 334         -resolution 0.01
 335
 336     bind $widgets(sclIso) <Any-ButtonRelease>
 337     bind $widgets(sclIso) <Any-ButtonRelease> "u_surf::change_intensity 0"
 338
 339     bind $widgets(sclOpacity) <Any-ButtonRelease>
 340     bind $widgets(sclOpacity) <Any-ButtonRelease> "u_surf::change_opacity 0"
 341
 342     u_surf::change_intensity 1
 343     u_surf::change_opacity 1
 344
 345     $widgets(btnOpaque)      deselect
 346     $widgets(btnTransparent) deselect
 347     $widgets(btnEdgePoints)  deselect
 348     $widgets(btnTransparent) invoke
 349
 350     [ $widgets(work3D) GetRenderWindow ] Render
 351     u_3D::controls 0
 352
 353 }
 354
 355 proc u_surf::set_IsoActor { typ } {
 356
 357     # For programming facilities
 358     upvar u_surf::widgets widgets
 359     upvar u_surf::actual_actor   actual_actor
 360
 361     catch { renderer_$widgets(work3D) RemoveActor isoActor_$widgets(work3D) }
 362     catch { renderer_$widgets(work3D) RemoveActor edgeActor_$widgets(work3D) }
 363     catch { renderer_$widgets(work3D) RemoveVolume opaqueVol_$widgets(work3D) }
 364
 365     set actual_actor $typ
 366
 367     if { $actual_actor == 1 } {
 368
 369         renderer_$widgets(work3D) AddVolume opaqueVol_$widgets(work3D)
 370
 371     } elseif { $actual_actor == 2 } {
 372
 373         renderer_$widgets(work3D) AddActor isoActor_$widgets(work3D)
 374
 375     } elseif { $actual_actor == 3 } {
 376
 377         renderer_$widgets(work3D) AddActor edgeActor_$widgets(work3D)
 378
 379     }
 380     [ $widgets(work3D) GetRenderWindow ] Render
 381
 382 }
 383
 384 proc u_surf::change_color { } {
 385
 386     # For programming facilities
 387     upvar u_surf::widgets widgets
 388     upvar u_surf::reference_actor reference_actor
 389     upvar u_surf::actual_actor    actual_actor
 390     upvar u_surf::surf_data       surf_data
 391     upvar u_surf::bounds          bounds
 392     upvar u_surf::intRange        intRange
 393
 394     set col [ $widgets(btnColor) cget -background ]
 395     set col [ \
 396      tk_chooseColor \
 397          -initialcolor $col \
 398          -parent $widgets(btnColor) \
 399          -title "Choose a color..."
 400     ]
 401     if { $col != "" } {
 402
 403         $widgets(btnColor) configure -background $col
 404         set r [ expr "0x[ string index $col 1 ][ string index $col 2 ]" / 255.0 ]
 405         set g [ expr "0x[ string index $col 3 ][ string index $col 4 ]" / 255.0 ]
 406         set b [ expr "0x[ string index $col 5 ][ string index $col 6 ]" / 255.0 ]
 407         [ isoActor_$widgets(work3D) GetProperty ] SetColor $r $g $b
 408         [ edgeActor_$widgets(work3D) GetProperty ] SetColor $r $g $b
 409
 410         [ $widgets(work3D) GetRenderWindow ] Render
 411
 412     }
 413
 414 }
 415
 416 proc u_surf::intersectionSurface { data p n o dir extent distance } {
 417
 418     # For programming facilities
 419     upvar u_surf::widgets widgets
 420
 421     vtkCellLocator locator_tmp_$widgets(work3D)
 422         locator_tmp_$widgets(work3D) SetDataSet $data
 423         locator_tmp_$widgets(work3D) Initialize
 424
 425     set p1x [ expr ( $dir == 0 )? [ lindex $p 0 ] - [ lindex $n 0 ]: [ lindex $p 0 ] + [ lindex $n 0 ] ]
 426     set p1y [ expr ( $dir == 0 )? [ lindex $p 1 ] - [ lindex $n 1 ]: [ lindex $p 1 ] + [ lindex $n 1 ] ]
 427     set p1z [ expr ( $dir == 0 )? [ lindex $p 2 ] - [ lindex $n 2 ]: [ lindex $p 2 ] + [ lindex $n 2 ] ]
 428
 429     set iter 1
 430     set i 0
 431     while { $iter == 1 } {
 432
 433         set p2x [ expr ( $dir == 0 )? [ expr $p1x - [ lindex $n 0 ] * $i ]: [ expr $p1x + [ lindex $n 0 ] * $i ] ]
 434         set p2y [ expr ( $dir == 0 )? [ expr $p1y - [ lindex $n 1 ] * $i ]: [ expr $p1y + [ lindex $n 1 ] * $i ] ]
 435         set p2z [ expr ( $dir == 0 )? [ expr $p1z - [ lindex $n 2 ] * $i ]: [ expr $p1z + [ lindex $n 2 ] * $i ] ]
 436         incr i
 437
 438         set index [ $data FindPoint $p2x $p2y $p2z ]
 439         set voxx [ lindex [ split [ expr $p2x - [ lindex $o 0 ] ] . ] 0 ]
 440         set voxy [ lindex [ split [ expr $p2y - [ lindex $o 1 ] ] . ] 0 ]
 441         set voxz [ lindex [ split [ expr $p2z - [ lindex $o 2 ] ] . ] 0 ]
 442
 443         if {
 444             $voxx >= 0 && $voxx <= [ lindex $extent 1 ] - [ lindex $extent 0 ] &&
 445             $voxy >= 0 && $voxy <= [ lindex $extent 3 ] - [ lindex $extent 2 ] &&
 446             $voxz >= 0 && $voxz <= [ lindex $extent 5 ] - [ lindex $extent 4 ]
 447         } {
 448
 449             locator_tmp_$widgets(work3D) Update
 450             set res [ IntersectWithLine_dll locator_tmp_$widgets(work3D)  $p1x $p1y $p1z $p2x $p2y $p2z 0.001 ]
 451             if { [ lindex $res 0 ] == 1 } {
 452
 453                 set ret [ list        \
 454                     1                 \
 455                     [ lindex $res 1 ] \
 456                     [ lindex $res 2 ] \
 457                     [ lindex $res 3 ] \
 458                     $i                \
 459                 ]
 460                 set iter 0
 461
 462             } elseif { $i >= $distance } { set iter 0; set ret [ list 0 ] }
 463
 464
 465         } else { set iter 0; set ret [ list 0 ] }
 466
 467     }
 468     catch { locator_tmp_$widgets(work3D) Delete }
 469     return $ret
 470
 471 }
 472
 473 proc u_surf::select_initial { x y } {
 474
 475     # For programming facilities
 476     upvar u_surf::widgets widgets
 477
 478     busy hold .
 479     update
 480
 481     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_1_$widgets(work3D) ] }
 482     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_2_$widgets(work3D) ] }
 483     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_3_$widgets(work3D) ] }
 484     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_4_$widgets(work3D) ] }
 485     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_5_$widgets(work3D) ] }
 486     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_ROI_$widgets(work3D) ] }
 487     catch { renderer_$widgets(work3D) RemoveActor line_actor_1_$widgets(work3D) }
 488     catch { renderer_$widgets(work3D) RemoveActor line_actor_2_$widgets(work3D) }
 489     DeleteSphere sphere_1_$widgets(work3D)
 490     DeleteSphere sphere_2_$widgets(work3D)
 491     DeleteSphere sphere_3_$widgets(work3D)
 492     DeleteSphere sphere_4_$widgets(work3D)
 493     DeleteSphere sphere_5_$widgets(work3D)
 494     DeleteSphere sphere_ROI_$widgets(work3D)
 495     catch { line_actor_1_$widgets(work3D)  Delete }
 496     catch { line_mapper_1_$widgets(work3D) Delete }
 497     catch { tube_normal_1_$widgets(work3D) Delete }
 498     catch { poly_normal_1_$widgets(work3D) Delete }
 499     catch { line_1_$widgets(work3D)        Delete }
 500     catch { points_1_$widgets(work3D)      Delete }
 501     catch { line_actor_2_$widgets(work3D)  Delete }
 502     catch { line_mapper_2_$widgets(work3D) Delete }
 503     catch { tube_normal_2_$widgets(work3D) Delete }
 504     catch { poly_normal_2_$widgets(work3D) Delete }
 505     catch { line_2_$widgets(work3D)        Delete }
 506     catch { points_2_$widgets(work3D)      Delete }
 507
 508     set resample [ GetVTKVolume_dll ]
 509     set bounds   [ $resample GetBounds ]
 510
 511     renderer_$widgets(work3D) IsInViewport 0 0
 512     set y [ expr [ lindex [ $widgets(work3D) configure -height ] 4 ] - $y - 1 ]
 513
 514     set surfPD [ cubes_$widgets(work3D) GetOutput ]
 515     $surfPD ComputeBounds
 516
 517     set pointData    [ $surfPD GetPointData ]
 518     set normalsSurf  [ $pointData GetNormals ]
 519
 520     [ $widgets(work3D) GetRenderWindow ] Render
 521
 522     set pickWPPos [ pick_point_local_actor $x $y renderer_$widgets(work3D) isoActor_$widgets(work3D) 0.001 ]
 523
 524     set xc [ lindex $pickWPPos 0 ]; set yc [ lindex $pickWPPos 1 ]; set zc [ lindex $pickWPPos 2 ]
 525
 526     set indP    [ $surfPD FindPoint $xc $yc $zc ]
 527     set coordsP [ $surfPD GetPoint $indP ]
 528
 529     set xc [ lindex $coordsP 0 ]; set yc [ lindex $coordsP 1 ]; set zc [ lindex $coordsP 2 ]
 530     set x1 $xc; set y1 $yc; set z1 $zc
 531
 532     renderer_$widgets(work3D) AddActor [ DrawSphere sphere_1_$widgets(work3D) 0.5 $xc $yc $zc 1.0 0.0 0.0 ]
 533
 534     set normalP [ $normalsSurf GetTuple3 $indP ]
 535     set xN [ lindex $normalP 0 ]; set yN [ lindex $normalP 1 ]; set zN [ lindex $normalP 2 ]
 536     set xO [ lindex [ split [ lindex [ [ struct_$widgets(work3D) GetOutput ] GetOrigin ] 0 ] . ] 0 ]
 537     set yO [ lindex [ split [ lindex [ [ struct_$widgets(work3D) GetOutput ] GetOrigin ] 1 ] . ] 0 ]
 538     set zO [ lindex [ split [ lindex [ [ struct_$widgets(work3D) GetOutput ] GetOrigin ] 2 ] . ] 0 ]
 539
 540     set largmax 30
 541
 542     set resInt [ u_surf::intersectionSurface \
 543         $surfPD                              \
 544         $coordsP                             \
 545         $normalP                             \
 546         [ list $xO $yO $zO ]                 \
 547         0                                    \
 548         $bounds                              \
 549         $largmax                             \
 550     ]
 551
 552     set trouve [ lindex $resInt 0 ]
 553     set xI     [ lindex $resInt 1 ]
 554     set yI     [ lindex $resInt 2 ]
 555     set zI     [ lindex $resInt 3 ]
 556     set i      [ lindex $resInt 4 ]
 557
 558     if { $trouve == 0 } {
 559
 560         tk_messageBox \
 561             -icon error \
 562             -message "$string_table::str_please_select_a_different_point" \
 563             -title "ERROR"
 564
 565     } else {
 566
 567         renderer_$widgets(work3D) AddActor [ DrawSphere sphere_2_$widgets(work3D) 0.5 $xI $yI $zI 1.0 0.0 0.0 ]
 568
 569         vtkPoints points_1_$widgets(work3D)
 570             points_1_$widgets(work3D) InsertPoint 0 $xI $yI $zI
 571             points_1_$widgets(work3D) InsertPoint 1 $xc $yc $zc
 572
 573         vtkCellArray line_1_$widgets(work3D)
 574             line_1_$widgets(work3D) InsertNextCell 2
 575         for { set j 0 } { $j < 2 } { incr j } { line_1_$widgets(work3D) InsertCellPoint $j }
 576
 577         vtkPolyData poly_normal_1_$widgets(work3D)
 578             poly_normal_1_$widgets(work3D) SetPoints points_1_$widgets(work3D)
 579             poly_normal_1_$widgets(work3D) SetLines line_1_$widgets(work3D)
 580
 581         vtkTubeFilter tube_normal_1_$widgets(work3D)
 582             tube_normal_1_$widgets(work3D) SetInput poly_normal_1_$widgets(work3D)
 583             tube_normal_1_$widgets(work3D) SetRadius 0.25
 584
 585         vtkPolyDataMapper line_mapper_1_$widgets(work3D)
 586             line_mapper_1_$widgets(work3D) SetInput [ tube_normal_1_$widgets(work3D) GetOutput ]
 587             line_mapper_1_$widgets(work3D) ImmediateModeRenderingOn
 588
 589         vtkActor line_actor_1_$widgets(work3D)
 590             line_actor_1_$widgets(work3D) SetMapper line_mapper_1_$widgets(work3D)
 591             [ line_actor_1_$widgets(work3D) GetProperty ] SetColor 1 0 0
 592             [ line_actor_1_$widgets(work3D) GetProperty ] BackfaceCullingOff
 593
 594         renderer_$widgets(work3D) AddActor line_actor_1_$widgets(work3D)
 595
 596         set distPoints $i
 597         set largVaisseau1 [ DistPoints $xc $yc $zc $xI $yI $zI ]
 598         set vox_size [ GetActualVoxelSize_dll ]
 599         set coordVoxelPc  [ VoxelCoord $xc $yc $zc $xO $yO $zO $vox_size $vox_size $vox_size ]
 600         set xcvol         [ lindex $coordVoxelPc 0 ]
 601         set ycvol         [ lindex $coordVoxelPc 1 ]
 602         set zcvol         [ lindex $coordVoxelPc 2 ]
 603         set coordVoxelPI [ VoxelCoord $xI $yI $zI $xO $yO $zO $vox_size $vox_size $vox_size ]
 604         set xIvol        [ lindex $coordVoxelPI 0 ]
 605         set yIvol        [ lindex $coordVoxelPI 1 ]
 606         set zIvol        [ lindex $coordVoxelPI 2 ]
 607         set distPointsVol1 [ DistPoints $xcvol $ycvol $zcvol $xIvol $yIvol $zIvol ]
 608
 609         set xc [ expr ( $xc - ( $xN * ( $largVaisseau1 / 2 ) ) ) ]
 610         set yc [ expr ( $yc - ( $yN * ( $largVaisseau1 / 2 ) ) ) ]
 611         set zc [ expr ( $zc - ( $zN * ( $largVaisseau1 / 2 ) ) ) ]
 612
 613         renderer_$widgets(work3D) AddActor [ DrawSphere sphere_3_$widgets(work3D) 0.5 $xc $yc $zc 1.0 0.0 0.0 ]
 614
 615         set vectsPerp [ TclPerpendiculars_dll $xN $yN $zN 0 ]
 616         set xP1 [ lindex $vectsPerp 0 ]; set yP1 [ lindex $vectsPerp 1 ]; set zP1 [ lindex $vectsPerp 2 ];
 617         set xP2 [ lindex $vectsPerp 3 ]; set yP2 [ lindex $vectsPerp 4 ]; set zP2 [ lindex $vectsPerp 5 ];
 618
 619         set resIntP11 [ u_surf::intersectionSurface \
 620             [ cubes_$widgets(work3D) GetOutput ]          \
 621             [ list $xc $yc $zc ]                 \
 622             [ list $xP1 $yP1 $zP1 ]              \
 623             [ list $xO $yO $zO ]                 \
 624             0                                    \
 625             $bounds                              \
 626             [ expr $largmax / 2 ]                \
 627         ]
 628         set trouveP11 [ lindex $resIntP11 0 ]
 629         set xP11      [ lindex $resIntP11 1 ]
 630         set yP11      [ lindex $resIntP11 2 ]
 631         set zP11      [ lindex $resIntP11 3 ]
 632         set i         [ lindex $resIntP11 4 ]
 633
 634         set resIntP12 [ u_surf::intersectionSurface \
 635             [ cubes_$widgets(work3D) GetOutput ]          \
 636             [ list $xc $yc $zc ]                 \
 637             [ list $xP1 $yP1 $zP1 ]              \
 638             [ list $xO $yO $zO ]                 \
 639             1                                    \
 640             $bounds                              \
 641             [ expr $largmax / 2 ]                \
 642         ]
 643         set trouveP12 [ lindex $resIntP12 0 ]
 644         set xP12      [ lindex $resIntP12 1 ]
 645         set yP12      [ lindex $resIntP12 2 ]
 646         set zP12      [ lindex $resIntP12 3 ]
 647         set i         [ lindex $resIntP12 4 ]
 648
 649         if { ( $trouveP11 == 1 ) && ( $trouveP12 == 1 ) } {
 650             set largP1 [ DistPoints $xP11 $yP11 $zP11 $xP12 $yP12 $zP12 ]
 651         } else { set largP1 10000 }
 652
 653         set resIntP21 [ u_surf::intersectionSurface \
 654             [ cubes_$widgets(work3D) GetOutput ]          \
 655             [ list $xc $yc $zc ]                 \
 656             [ list $xP2 $yP2 $zP2 ]              \
 657             [ list $xO $yO $zO ]                 \
 658             0                                    \
 659             $bounds                              \
 660             [ expr $largmax / 2 ]                \
 661         ]
 662         set trouveP21 [ lindex $resIntP21 0 ]
 663         set xP21      [ lindex $resIntP21 1 ]
 664         set yP21      [ lindex $resIntP21 2 ]
 665         set zP21      [ lindex $resIntP21 3 ]
 666         set i         [ lindex $resIntP21 4 ]
 667
 668         set resIntP22 [ u_surf::intersectionSurface \
 669             [ cubes_$widgets(work3D) GetOutput ]          \
 670             [ list $xc $yc $zc ]                 \
 671             [ list $xP2 $yP2 $zP2 ]              \
 672             [ list $xO $yO $zO ]                 \
 673             1                                    \
 674             $bounds                              \
 675             [ expr $largmax / 2 ]                \
 676         ]
 677         set trouveP22 [ lindex $resIntP22 0 ]
 678         set xP22      [ lindex $resIntP22 1 ]
 679         set yP22      [ lindex $resIntP22 2 ]
 680         set zP22      [ lindex $resIntP22 3 ]
 681         set i         [ lindex $resIntP22 4 ]
 682
 683         if { ( $trouveP21 == 1 ) && ( $trouveP22 == 1 ) } {
 684             set largP2 [ DistPoints $xP21 $yP21 $zP21 $xP22 $yP22 $zP22 ]
 685         } else { set largP2 10000 }
 686
 687         if { ( $largP1 == 10000 ) && ( $largP2 == 10000 ) } {
 688
 689             set xP1 0; set yP1 0; set zP1 0
 690             set xP2 0; set yP2 0; set zP2 0
 691             set largdef 0
 692
 693         } elseif { ( $largP1 < $largP2 ) } {
 694
 695             set xP1 $xP11; set yP1 $yP11; set zP1 $zP11
 696             set xP2 $xP12; set yP2 $yP12; set zP2 $zP12
 697             set largdef $largP1
 698
 699         } elseif { ( $largP2 < $largP1 ) } {
 700
 701             set xP1 $xP21; set yP1 $yP21; set zP1 $zP21
 702             set xP2 $xP22; set yP2 $yP22; set zP2 $zP22
 703             set largdef $largP2
 704         }
 705         set largVaisseau2 $largdef
 706
 707         if { $largVaisseau2 > 0 } {
 708
 709             set largVaisseau [ expr ( $largVaisseau1 + $largVaisseau2 ) / 2 ]
 710             set vox_size [ GetActualVoxelSize_dll ]
 711             set coordVoxelP1 [ VoxelCoord $xP1 $yP1 $zP1 $xO $yO $zO $vox_size $vox_size $vox_size ]
 712             set xP1vol [ lindex $coordVoxelP1 0 ]; set yP1vol [ lindex $coordVoxelP1 1 ]; set zP1vol [ lindex $coordVoxelP1 2 ]
 713
 714             set coordVoxelP2 [VoxelCoord $xP2 $yP2 $zP2 $xO $yO $zO $vox_size $vox_size $vox_size ]
 715             set xP2vol [ lindex $coordVoxelP2 0 ]; set yP2vol [ lindex $coordVoxelP2 1 ]; set zP2vol [ lindex $coordVoxelP2 2 ]
 716             set distPointsVol2 [ DistPoints $xP1vol $yP1vol $zP1vol $xP2vol $yP2vol $zP2vol ]
 717
 718         } else {
 719
 720             set largVaisseau 0
 721             set distPointsVol2 0
 722         }
 723
 724         if { $largVaisseau2 > 0 } {
 725
 726             renderer_$widgets(work3D) AddActor [ DrawSphere sphere_4_$widgets(work3D) 0.5 $xP1 $yP1 $zP1 0.0 1.0 0.0 ]
 727             renderer_$widgets(work3D) AddActor [ DrawSphere sphere_5_$widgets(work3D) 0.5 $xP2 $yP2 $zP2 0.0 1.0 0.0 ]
 728
 729             vtkPoints points_2_$widgets(work3D)
 730                 points_2_$widgets(work3D) InsertPoint 0 $xP1 $yP1 $zP1
 731                 points_2_$widgets(work3D) InsertPoint 1 $xP2 $yP2 $zP2
 732
 733             vtkCellArray line_2_$widgets(work3D)
 734                 line_2_$widgets(work3D) InsertNextCell 2
 735             for { set j 0 } { $j < 2 } { incr j } { line_2_$widgets(work3D) InsertCellPoint $j }
 736
 737             vtkPolyData poly_normal_2_$widgets(work3D)
 738                 poly_normal_2_$widgets(work3D) SetPoints points_2_$widgets(work3D)
 739                 poly_normal_2_$widgets(work3D) SetLines line_2_$widgets(work3D)
 740
 741             vtkTubeFilter tube_normal_2_$widgets(work3D)
 742                 tube_normal_2_$widgets(work3D) SetInput poly_normal_2_$widgets(work3D)
 743                 tube_normal_2_$widgets(work3D) SetRadius 0.25
 744
 745             vtkPolyDataMapper line_mapper_2_$widgets(work3D)
 746                 line_mapper_2_$widgets(work3D) SetInput [ tube_normal_2_$widgets(work3D) GetOutput ]
 747                 line_mapper_2_$widgets(work3D) ImmediateModeRenderingOn
 748
 749             vtkActor line_actor_2_$widgets(work3D)
 750                 line_actor_2_$widgets(work3D) SetMapper line_mapper_2_$widgets(work3D)
 751                 [ line_actor_2_$widgets(work3D) GetProperty ] SetColor 0.0 1.0 0.0
 752                 [ line_actor_2_$widgets(work3D) GetProperty ] BackfaceCullingOff
 753
 754             renderer_$widgets(work3D) AddActor line_actor_2_$widgets(work3D)
 755
 756         }
 757
 758         if { $distPointsVol2 > 0 } {
 759             set distPointsVol [ expr ( $distPointsVol1 + $distPointsVol2 ) / 2 ]
 760         } else { set distPointsVol $distPointsVol1 }
 761         SetROIStep_dll $distPointsVol
 762         array set arr [ params_dll ]
 763         set act [ \
 764             DrawSphere \
 765                 sphere_ROI_$widgets(work3D) \
 766                 [ expr $arr(e_roi_dimension) / 2.0 ] \
 767                 $xc $yc $zc \
 768                 1.0 0.0 0.0 \
 769         ]
 770         [ $act GetProperty ] SetOpacity 0.2
 771         renderer_$widgets(work3D) AddActor $act
 772
 773     }
 774
 775     busy release .
 776     update
 777     [ $widgets(work3D) GetRenderWindow ] Render
 778
 779 }
 780
 781 proc u_surf::select_initial_2 { xc yc zc } {
 782
 783     # For programming facilities
 784     upvar u_surf::widgets widgets
 785
 786     busy hold .
 787     update
 788
 789     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_1_$widgets(work3D) ] }
 790     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_2_$widgets(work3D) ] }
 791     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_3_$widgets(work3D) ] }
 792     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_4_$widgets(work3D) ] }
 793     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_5_$widgets(work3D) ] }
 794     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_ROI_$widgets(work3D) ] }
 795     catch { renderer_$widgets(work3D) RemoveActor line_actor_1_$widgets(work3D) }
 796     catch { renderer_$widgets(work3D) RemoveActor line_actor_2_$widgets(work3D) }
 797     DeleteSphere sphere_1_$widgets(work3D)
 798     DeleteSphere sphere_2_$widgets(work3D)
 799     DeleteSphere sphere_3_$widgets(work3D)
 800     DeleteSphere sphere_4_$widgets(work3D)
 801     DeleteSphere sphere_5_$widgets(work3D)
 802     DeleteSphere sphere_ROI_$widgets(work3D)
 803     catch { line_actor_1_$widgets(work3D)  Delete }
 804     catch { line_mapper_1_$widgets(work3D) Delete }
 805     catch { tube_normal_1_$widgets(work3D) Delete }
 806     catch { poly_normal_1_$widgets(work3D) Delete }
 807     catch { line_1_$widgets(work3D)        Delete }
 808     catch { points_1_$widgets(work3D)      Delete }
 809     catch { line_actor_2_$widgets(work3D)  Delete }
 810     catch { line_mapper_2_$widgets(work3D) Delete }
 811     catch { tube_normal_2_$widgets(work3D) Delete }
 812     catch { poly_normal_2_$widgets(work3D) Delete }
 813     catch { line_2_$widgets(work3D)        Delete }
 814     catch { points_2_$widgets(work3D)      Delete }
 815
 816     set resample [ GetVTKVolume_dll ]
 817     set bounds   [ $resample GetBounds ]
 818
 819 #    renderer_$widgets(work3D) IsInViewport 0 0
 820 #    set y [ expr [ lindex [ $widgets(work3D) configure -height ] 4 ] - $y - 1 ]
 821 #
 822     set surfPD [ cubes_$widgets(work3D) GetOutput ]
 823     $surfPD ComputeBounds
 824 #
 825     set pointData    [ $surfPD GetPointData ]
 826     set normalsSurf  [ $pointData GetNormals ]
 827 #
 828 #    [ $widgets(work3D) GetRenderWindow ] Render
 829 #
 830 #    set pickWPPos [ pick_point_local_actor $x $y renderer_$widgets(work3D) isoActor_$widgets(work3D) 0.001 ]
 831 #
 832 #    set xc [ lindex $pickWPPos 0 ]; set yc [ lindex $pickWPPos 1 ]; set zc [ lindex $pickWPPos 2 ]
 833 #
 834     set indP    [ $surfPD FindPoint $xc $yc $zc ]
 835     set coordsP [ $surfPD GetPoint $indP ]
 836 #
 837 #    set xc [ lindex $coordsP 0 ]; set yc [ lindex $coordsP 1 ]; set zc [ lindex $coordsP 2 ]
 838     set x1 $xc; set y1 $yc; set z1 $zc
 839
 840     renderer_$widgets(work3D) AddActor [ DrawSphere sphere_1_$widgets(work3D) 0.5 $xc $yc $zc 1.0 0.0 0.0 ]
 841
 842     set normalP [ $normalsSurf GetTuple3 $indP ]
 843     set xN [ lindex $normalP 0 ]; set yN [ lindex $normalP 1 ]; set zN [ lindex $normalP 2 ]
 844     set xO [ lindex [ split [ lindex [ [ struct_$widgets(work3D) GetOutput ] GetOrigin ] 0 ] . ] 0 ]
 845     set yO [ lindex [ split [ lindex [ [ struct_$widgets(work3D) GetOutput ] GetOrigin ] 1 ] . ] 0 ]
 846     set zO [ lindex [ split [ lindex [ [ struct_$widgets(work3D) GetOutput ] GetOrigin ] 2 ] . ] 0 ]
 847
 848     set largmax 30
 849
 850     set resInt [ u_surf::intersectionSurface \
 851         $surfPD                              \
 852         $coordsP                             \
 853         $normalP                             \
 854         [ list $xO $yO $zO ]                 \
 855         0                                    \
 856         $bounds                              \
 857         $largmax                             \
 858     ]
 859
 860     set trouve [ lindex $resInt 0 ]
 861     set xI     [ lindex $resInt 1 ]
 862     set yI     [ lindex $resInt 2 ]
 863     set zI     [ lindex $resInt 3 ]
 864     set i      [ lindex $resInt 4 ]
 865
 866     if { $trouve == 0 } {
 867
 868         tk_messageBox \
 869             -icon error \
 870             -message "$string_table::str_please_select_a_different_point" \
 871             -title "ERROR"
 872
 873     } else {
 874
 875         renderer_$widgets(work3D) AddActor [ DrawSphere sphere_2_$widgets(work3D) 0.5 $xI $yI $zI 1.0 0.0 0.0 ]
 876
 877         vtkPoints points_1_$widgets(work3D)
 878             points_1_$widgets(work3D) InsertPoint 0 $xI $yI $zI
 879             points_1_$widgets(work3D) InsertPoint 1 $xc $yc $zc
 880
 881         vtkCellArray line_1_$widgets(work3D)
 882             line_1_$widgets(work3D) InsertNextCell 2
 883         for { set j 0 } { $j < 2 } { incr j } { line_1_$widgets(work3D) InsertCellPoint $j }
 884
 885         vtkPolyData poly_normal_1_$widgets(work3D)
 886             poly_normal_1_$widgets(work3D) SetPoints points_1_$widgets(work3D)
 887             poly_normal_1_$widgets(work3D) SetLines line_1_$widgets(work3D)
 888
 889         vtkTubeFilter tube_normal_1_$widgets(work3D)
 890             tube_normal_1_$widgets(work3D) SetInput poly_normal_1_$widgets(work3D)
 891             tube_normal_1_$widgets(work3D) SetRadius 0.25
 892
 893         vtkPolyDataMapper line_mapper_1_$widgets(work3D)
 894             line_mapper_1_$widgets(work3D) SetInput [ tube_normal_1_$widgets(work3D) GetOutput ]
 895             line_mapper_1_$widgets(work3D) ImmediateModeRenderingOn
 896
 897         vtkActor line_actor_1_$widgets(work3D)
 898             line_actor_1_$widgets(work3D) SetMapper line_mapper_1_$widgets(work3D)
 899             [ line_actor_1_$widgets(work3D) GetProperty ] SetColor 1 0 0
 900             [ line_actor_1_$widgets(work3D) GetProperty ] BackfaceCullingOff
 901
 902         renderer_$widgets(work3D) AddActor line_actor_1_$widgets(work3D)
 903
 904         set distPoints $i
 905         set largVaisseau1 [ DistPoints $xc $yc $zc $xI $yI $zI ]
 906         set vox_size [ GetActualVoxelSize_dll ]
 907         set coordVoxelPc  [ VoxelCoord $xc $yc $zc $xO $yO $zO $vox_size $vox_size $vox_size ]
 908         set xcvol         [ lindex $coordVoxelPc 0 ]
 909         set ycvol         [ lindex $coordVoxelPc 1 ]
 910         set zcvol         [ lindex $coordVoxelPc 2 ]
 911         set coordVoxelPI [ VoxelCoord $xI $yI $zI $xO $yO $zO $vox_size $vox_size $vox_size ]
 912         set xIvol        [ lindex $coordVoxelPI 0 ]
 913         set yIvol        [ lindex $coordVoxelPI 1 ]
 914         set zIvol        [ lindex $coordVoxelPI 2 ]
 915         set distPointsVol1 [ DistPoints $xcvol $ycvol $zcvol $xIvol $yIvol $zIvol ]
 916
 917         set xc [ expr ( $xc - ( $xN * ( $largVaisseau1 / 2 ) ) ) ]
 918         set yc [ expr ( $yc - ( $yN * ( $largVaisseau1 / 2 ) ) ) ]
 919         set zc [ expr ( $zc - ( $zN * ( $largVaisseau1 / 2 ) ) ) ]
 920
 921         renderer_$widgets(work3D) AddActor [ DrawSphere sphere_3_$widgets(work3D) 0.5 $xc $yc $zc 1.0 0.0 0.0 ]
 922
 923         set vectsPerp [ TclPerpendiculars_dll $xN $yN $zN 0 ]
 924         set xP1 [ lindex $vectsPerp 0 ]; set yP1 [ lindex $vectsPerp 1 ]; set zP1 [ lindex $vectsPerp 2 ];
 925         set xP2 [ lindex $vectsPerp 3 ]; set yP2 [ lindex $vectsPerp 4 ]; set zP2 [ lindex $vectsPerp 5 ];
 926
 927         set resIntP11 [ u_surf::intersectionSurface \
 928             [ cubes_$widgets(work3D) GetOutput ]          \
 929             [ list $xc $yc $zc ]                 \
 930             [ list $xP1 $yP1 $zP1 ]              \
 931             [ list $xO $yO $zO ]                 \
 932             0                                    \
 933             $bounds                              \
 934             [ expr $largmax / 2 ]                \
 935         ]
 936         set trouveP11 [ lindex $resIntP11 0 ]
 937         set xP11      [ lindex $resIntP11 1 ]
 938         set yP11      [ lindex $resIntP11 2 ]
 939         set zP11      [ lindex $resIntP11 3 ]
 940         set i         [ lindex $resIntP11 4 ]
 941
 942         set resIntP12 [ u_surf::intersectionSurface \
 943             [ cubes_$widgets(work3D) GetOutput ]          \
 944             [ list $xc $yc $zc ]                 \
 945             [ list $xP1 $yP1 $zP1 ]              \
 946             [ list $xO $yO $zO ]                 \
 947             1                                    \
 948             $bounds                              \
 949             [ expr $largmax / 2 ]                \
 950         ]
 951         set trouveP12 [ lindex $resIntP12 0 ]
 952         set xP12      [ lindex $resIntP12 1 ]
 953         set yP12      [ lindex $resIntP12 2 ]
 954         set zP12      [ lindex $resIntP12 3 ]
 955         set i         [ lindex $resIntP12 4 ]
 956
 957         if { ( $trouveP11 == 1 ) && ( $trouveP12 == 1 ) } {
 958             set largP1 [ DistPoints $xP11 $yP11 $zP11 $xP12 $yP12 $zP12 ]
 959         } else { set largP1 10000 }
 960
 961         set resIntP21 [ u_surf::intersectionSurface \
 962             [ cubes_$widgets(work3D) GetOutput ]          \
 963             [ list $xc $yc $zc ]                 \
 964             [ list $xP2 $yP2 $zP2 ]              \
 965             [ list $xO $yO $zO ]                 \
 966             0                                    \
 967             $bounds                              \
 968             [ expr $largmax / 2 ]                \
 969         ]
 970         set trouveP21 [ lindex $resIntP21 0 ]
 971         set xP21      [ lindex $resIntP21 1 ]
 972         set yP21      [ lindex $resIntP21 2 ]
 973         set zP21      [ lindex $resIntP21 3 ]
 974         set i         [ lindex $resIntP21 4 ]
 975
 976         set resIntP22 [ u_surf::intersectionSurface \
 977             [ cubes_$widgets(work3D) GetOutput ]          \
 978             [ list $xc $yc $zc ]                 \
 979             [ list $xP2 $yP2 $zP2 ]              \
 980             [ list $xO $yO $zO ]                 \
 981             1                                    \
 982             $bounds                              \
 983             [ expr $largmax / 2 ]                \
 984         ]
 985         set trouveP22 [ lindex $resIntP22 0 ]
 986         set xP22      [ lindex $resIntP22 1 ]
 987         set yP22      [ lindex $resIntP22 2 ]
 988         set zP22      [ lindex $resIntP22 3 ]
 989         set i         [ lindex $resIntP22 4 ]
 990
 991         if { ( $trouveP21 == 1 ) && ( $trouveP22 == 1 ) } {
 992             set largP2 [ DistPoints $xP21 $yP21 $zP21 $xP22 $yP22 $zP22 ]
 993         } else { set largP2 10000 }
 994
 995         if { ( $largP1 == 10000 ) && ( $largP2 == 10000 ) } {
 996
 997             set xP1 0; set yP1 0; set zP1 0
 998             set xP2 0; set yP2 0; set zP2 0
 999             set largdef 0
1000
1001         } elseif { ( $largP1 < $largP2 ) } {
1002
1003             set xP1 $xP11; set yP1 $yP11; set zP1 $zP11
1004             set xP2 $xP12; set yP2 $yP12; set zP2 $zP12
1005             set largdef $largP1
1006
1007         } elseif { ( $largP2 < $largP1 ) } {
1008
1009             set xP1 $xP21; set yP1 $yP21; set zP1 $zP21
1010             set xP2 $xP22; set yP2 $yP22; set zP2 $zP22
1011             set largdef $largP2
1012         }
1013         set largVaisseau2 $largdef
1014
1015         if { $largVaisseau2 > 0 } {
1016
1017             set largVaisseau [ expr ( $largVaisseau1 + $largVaisseau2 ) / 2 ]
1018             set vox_size [ GetActualVoxelSize_dll ]
1019             set coordVoxelP1 [ VoxelCoord $xP1 $yP1 $zP1 $xO $yO $zO $vox_size $vox_size $vox_size ]
1020             set xP1vol [ lindex $coordVoxelP1 0 ]; set yP1vol [ lindex $coordVoxelP1 1 ]; set zP1vol [ lindex $coordVoxelP1 2 ]
1021
1022             set coordVoxelP2 [VoxelCoord $xP2 $yP2 $zP2 $xO $yO $zO $vox_size $vox_size $vox_size ]
1023             set xP2vol [ lindex $coordVoxelP2 0 ]; set yP2vol [ lindex $coordVoxelP2 1 ]; set zP2vol [ lindex $coordVoxelP2 2 ]
1024             set distPointsVol2 [ DistPoints $xP1vol $yP1vol $zP1vol $xP2vol $yP2vol $zP2vol ]
1025
1026         } else {
1027
1028             set largVaisseau 0
1029             set distPointsVol2 0
1030         }
1031
1032         if { $largVaisseau2 > 0 } {
1033
1034             renderer_$widgets(work3D) AddActor [ DrawSphere sphere_4_$widgets(work3D) 0.5 $xP1 $yP1 $zP1 0.0 1.0 0.0 ]
1035             renderer_$widgets(work3D) AddActor [ DrawSphere sphere_5_$widgets(work3D) 0.5 $xP2 $yP2 $zP2 0.0 1.0 0.0 ]
1036
1037             vtkPoints points_2_$widgets(work3D)
1038                 points_2_$widgets(work3D) InsertPoint 0 $xP1 $yP1 $zP1
1039                 points_2_$widgets(work3D) InsertPoint 1 $xP2 $yP2 $zP2
1040
1041             vtkCellArray line_2_$widgets(work3D)
1042                 line_2_$widgets(work3D) InsertNextCell 2
1043             for { set j 0 } { $j < 2 } { incr j } { line_2_$widgets(work3D) InsertCellPoint $j }
1044
1045             vtkPolyData poly_normal_2_$widgets(work3D)
1046                 poly_normal_2_$widgets(work3D) SetPoints points_2_$widgets(work3D)
1047                 poly_normal_2_$widgets(work3D) SetLines line_2_$widgets(work3D)
1048
1049             vtkTubeFilter tube_normal_2_$widgets(work3D)
1050                 tube_normal_2_$widgets(work3D) SetInput poly_normal_2_$widgets(work3D)
1051                 tube_normal_2_$widgets(work3D) SetRadius 0.25
1052
1053             vtkPolyDataMapper line_mapper_2_$widgets(work3D)
1054                 line_mapper_2_$widgets(work3D) SetInput [ tube_normal_2_$widgets(work3D) GetOutput ]
1055                 line_mapper_2_$widgets(work3D) ImmediateModeRenderingOn
1056
1057             vtkActor line_actor_2_$widgets(work3D)
1058                 line_actor_2_$widgets(work3D) SetMapper line_mapper_2_$widgets(work3D)
1059                 [ line_actor_2_$widgets(work3D) GetProperty ] SetColor 0.0 1.0 0.0
1060                 [ line_actor_2_$widgets(work3D) GetProperty ] BackfaceCullingOff
1061
1062             renderer_$widgets(work3D) AddActor line_actor_2_$widgets(work3D)
1063
1064         }
1065
1066         if { $distPointsVol2 > 0 } {
1067             set distPointsVol [ expr ( $distPointsVol1 + $distPointsVol2 ) / 2 ]
1068         } else { set distPointsVol $distPointsVol1 }
1069         SetROIStep_dll $distPointsVol
1070         array set arr [ params_dll ]
1071         set act [ \
1072             DrawSphere \
1073                 sphere_ROI_$widgets(work3D) \
1074                 [ expr $arr(e_roi_dimension) / 2.0 ] \
1075                 $xc $yc $zc \
1076                 1.0 0.0 0.0 \
1077         ]
1078         [ $act GetProperty ] SetOpacity 0.2
1079         renderer_$widgets(work3D) AddActor $act
1080
1081     }
1082
1083     busy release .
1084     update
1085     [ $widgets(work3D) GetRenderWindow ] Render
1086
1087 }
1088
1089 proc u_surf::change_intensity { typ } {
1090
1091     # For programming facilities
1092     upvar u_surf::widgets widgets
1093
1094     if { $typ == 1 } {
1095
1096         set slc [ expr ( [ $widgets(sclIso) cget -to ] + ( [ $widgets(sclIso) cget -from ] * 3 ) ) / 4 ]
1097         $widgets(sclIso) set $slc
1098
1099     } else { set slc [ $widgets(sclIso) get ] }
1100
1101     cubes_$widgets(work3D) SetValue 0 $slc
1102     edgePoints_$widgets(work3D) SetValue $slc
1103     [ $widgets(work3D) GetRenderWindow ] Render
1104
1105
1106 }
1107
1108 proc u_surf::change_opacity { typ } {
1109
1110     # For programming facilities
1111     upvar u_surf::widgets widgets
1112
1113     if { $typ == 1 } {
1114
1115         set slc [ expr ( [ $widgets(sclOpacity) cget -to ] + [ $widgets(sclOpacity) cget -from ] ) / 2 ]
1116         $widgets(sclOpacity) set $slc
1117
1118     } else { set slc [ $widgets(sclOpacity) get ] }
1119
1120     [ isoActor_$widgets(work3D) GetProperty ] SetOpacity $slc
1121     [ edgeActor_$widgets(work3D) GetProperty ] SetOpacity $slc
1122     [ $widgets(work3D) GetRenderWindow ] Render
1123
1124 }
1125
1126 proc u_surf::show_axis { points } {
1127
1128     # For programming facilities
1129     upvar u_surf::widgets widgets
1130
1131     set resample [ GetVTKVolume_dll ]
1132     set bounds   [ $resample GetBounds ]
1133     set nP [ expr [ llength $points ] / 3 ]
1134
1135     if { $nP > 0 } {
1136
1137         # Poly-line actor construction...
1138         catch { renderer_$widgets(work3D) RemoveActor axisActor_$widgets(work3D) }
1139         catch { axisActor_$widgets(work3D)    Delete }
1140         catch { axisMapper_$widgets(work3D)   Delete }
1141         catch { axisGrid_$widgets(work3D)     Delete }
1142         catch { axisPolyLine_$widgets(work3D) Delete }
1143         catch { axisPoints_$widgets(work3D)   Delete }
1144         catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_6_$widgets(work3D) ] }
1145         catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_7_$widgets(work3D) ] }
1146         DeleteSphere sphere_6_$widgets(work3D)
1147         DeleteSphere sphere_7_$widgets(work3D)
1148
1149         vtkPoints axisPoints_$widgets(work3D)
1150         vtkPolyLine axisPolyLine_$widgets(work3D)
1151         [ axisPolyLine_$widgets(work3D) GetPointIds ] SetNumberOfIds $nP
1152         set vox_size [ GetActualVoxelSize_dll ]
1153         for { set i 0 } { $i < $nP } { incr i } {
1154
1155             [ axisPolyLine_$widgets(work3D) GetPointIds ] SetId $i $i
1156             set p [ \
1157                 PointCoord \
1158                 [ lindex $points [ expr $i * 3 + 0 ] ] \
1159                 [ lindex $points [ expr $i * 3 + 1 ] ] \
1160                 [ lindex $points [ expr $i * 3 + 2 ] ] \
1161                 [ lindex $bounds 0 ] \
1162                 [ lindex $bounds 2 ] \
1163                 [ lindex $bounds 4 ] \
1164                 $vox_size $vox_size $vox_size \
1165             ]
1166             axisPoints_$widgets(work3D) InsertNextPoint [ lindex $p 0 ] [ lindex $p 1 ] [ lindex $p 2 ]
1167
1168             #catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_cell_int_$widgets(work3D) ] }
1169             #DeleteSphere sphere_cell_int_$widgets(work3D)
1170             #set act [ \
1171             #    DrawSphere \
1172             #        sphere_cell_int_$widgets(work3D) \
1173             #        [ expr [ getCellIntensitySize_dll ] / 2.0 ] \
1174             #        [ lindex $p 0 ] [ lindex $p 1 ] [ lindex $p 2 ] \
1175             #        1.0 0.0 0.0 \
1176             #]
1177             #[ $act GetProperty ] SetOpacity 0.2
1178             #renderer_$widgets(work3D) AddActor $act
1179             #[ $widgets(work3D) GetRenderWindow ] Render
1180             #update
1181
1182         }
1183
1184         vtkUnstructuredGrid axisGrid_$widgets(work3D)
1185             axisGrid_$widgets(work3D) Allocate 1 1
1186             axisGrid_$widgets(work3D) InsertNextCell \
1187                 [ axisPolyLine_$widgets(work3D) GetCellType ] \
1188                 [ axisPolyLine_$widgets(work3D) GetPointIds ]
1189             axisGrid_$widgets(work3D) SetPoints axisPoints_$widgets(work3D)
1190
1191         vtkDataSetMapper axisMapper_$widgets(work3D)
1192             axisMapper_$widgets(work3D) SetInput axisGrid_$widgets(work3D)
1193          axisMapper_$widgets(work3D) ImmediateModeRenderingOn
1194
1195         vtkActor axisActor_$widgets(work3D)
1196             axisActor_$widgets(work3D) SetMapper axisMapper_$widgets(work3D)
1197             [ axisActor_$widgets(work3D) GetProperty] BackfaceCullingOn
1198             [ axisActor_$widgets(work3D) GetProperty] SetDiffuseColor 1 0 0
1199 #            [ axisActor_$widgets(work3D) GetProperty]  SetLineWidth 3
1200
1201         renderer_$widgets(work3D) AddActor axisActor_$widgets(work3D)
1202
1203         set p [ \
1204             PointCoord \
1205             [ lindex $points 0 ] \
1206             [ lindex $points 1 ] \
1207             [ lindex $points 2 ] \
1208             [ lindex $bounds 0 ] \
1209             [ lindex $bounds 2 ] \
1210             [ lindex $bounds 4 ] \
1211             $vox_size $vox_size $vox_size \
1212         ]
1213         renderer_$widgets(work3D) AddActor [ \
1214             DrawSphere \
1215                 sphere_6_$widgets(work3D) \
1216                 1.0 \
1217                 [ lindex $p 0 ] [ lindex $p 1 ] [ lindex $p 2 ] \
1218                 0.0 0.0 1.0 \
1219         ]
1220
1221         set i [ expr $nP - 1 ]
1222         set p [ \
1223             PointCoord \
1224             [ lindex $points [ expr $i * 3 + 0 ] ] \
1225             [ lindex $points [ expr $i * 3 + 1 ] ] \
1226             [ lindex $points [ expr $i * 3 + 2 ] ] \
1227             [ lindex $bounds 0 ] \
1228             [ lindex $bounds 2 ] \
1229             [ lindex $bounds 4 ] \
1230             $vox_size $vox_size $vox_size \
1231         ]
1232         renderer_$widgets(work3D) AddActor [ \
1233             DrawSphere \
1234                 sphere_7_$widgets(work3D) \
1235                 1.0 \
1236                 [ lindex $p 0 ] [ lindex $p 1 ] [ lindex $p 2 ] \
1237                 0.0 1.0 0.0 \
1238         ]
1239         [ $widgets(work3D) GetRenderWindow ] Render
1240         u_3D::controls 2
1241
1242     }
1243
1244 }
1245
1246 proc u_surf::extract_axis { } {
1247
1248     # For programming facilities
1249     upvar u_surf::widgets widgets
1250     upvar u_surf::axis_index      axis_index
1251
1252     busy hold .
1253     u_3D::controls
1254     update
1255
1256     catch { set center [ sphere_3_$widgets(work3D) GetCenter ] } err
1257     set err [ expr ( [ string compare [ lindex $err 0 ] invalid ] != 0 )? 0: 1 ]
1258
1259     catch { renderer_$widgets(work3D) RemoveActor axesActor_$widgets(work3D) }
1260     catch { axesActor_$widgets(work3D) Delete }
1261     catch { axesMapper_$widgets(work3D) Delete }
1262
1263     if { $err == 0 } {
1264
1265         set vox_size [ GetActualVoxelSize_dll ]
1266         set coord [ \
1267             VoxelCoord \
1268                 [ lindex $center 0 ] \
1269                 [ lindex $center 1 ] \
1270                 [ lindex $center 2 ] \
1271                 [ lindex [ split [ lindex [ [ struct_$widgets(work3D) GetOutput ] GetOrigin ] 0 ] . ] 0 ] \
1272                 [ lindex [ split [ lindex [ [ struct_$widgets(work3D) GetOutput ] GetOrigin ] 1 ] . ] 0 ] \
1273                 [ lindex [ split [ lindex [ [ struct_$widgets(work3D) GetOutput ] GetOrigin ] 2 ] . ] 0 ] \
1274                 $vox_size $vox_size $vox_size \
1275         ]
1276
1277 #        set resample [ GetVTKVolume_dll ]
1278 #        set bounds   [ $resample GetBounds ]
1279
1280         $widgets(edtChooseAxis) delete 0  end
1281         $widgets(edtChooseAxis) insert end ""
1282
1283         SetStartPoint_dll [ lindex $coord 0 ] [ lindex $coord 1 ] [ lindex $coord 2 ]
1284         ExtractAxes_dll
1285
1286         set axes [ GetAllAxes_dll ]
1287
1288         vtkPolyDataMapper axesMapper_$widgets(work3D)
1289         axesMapper_$widgets(work3D) SetInput $axes
1290
1291         vtkActor axesActor_$widgets(work3D)
1292         axesActor_$widgets(work3D) SetMapper axesMapper_$widgets(work3D)
1293         [ axesActor_$widgets(work3D) GetProperty ] SetColor 1 0 0
1294
1295         renderer_$widgets(work3D) AddActor axesActor_$widgets(work3D)
1296         [ $widgets(work3D) GetRenderWindow ] Render
1297
1298 #        set points [ getAxis_dll ]
1299 #        u_surf::show_axis $points
1300
1301         busy release .
1302         update
1303         u_3D::controls 2
1304
1305     } else {
1306
1307         busy release .
1308         update
1309
1310         tk_messageBox \
1311             -icon error \
1312             -message "$string_table::str_please_select_a_point" \
1313             -title "ERROR"
1314
1315     }
1316
1317 }
1318
1319 proc u_surf::add_axis { } {
1320
1321     # For programming facilities
1322     upvar u_surf::widgets    widgets
1323     upvar u_surf::axis_index axis_index
1324     upvar u_surf::indexes    indexes
1325
1326
1327     if { [ string compare [ $widgets(edtChooseAxis) get ] "" ] != 0 } {
1328
1329         set name [ $widgets(edtChooseAxis) get ]
1330         $widgets(edtChooseAxis) list insert end $name
1331         set indexes($name) [ commitAxis_dll $name ]
1332         u_3D::controls 2
1333
1334     } else {
1335
1336         set name [ dlg_name_axis::show $widgets(base) ]
1337         if { [ string compare $name "" ] != 0 } {
1338
1339             $widgets(edtChooseAxis) delete 0  end
1340             $widgets(edtChooseAxis) insert end $name
1341             u_surf::add_axis
1342
1343         }
1344
1345     }
1346
1347 }
1348
1349 proc u_surf::select_axis_point { x y } {
1350
1351     # For programming facilities
1352     upvar u_surf::widgets widgets
1353     upvar u_surf::axis_index axis_index
1354
1355     catch { tmp_world_picker_$widgets(work3D) Delete }
1356     renderer_$widgets(work3D) IsInViewport 0 0
1357
1358     set y [ expr [ lindex [ $widgets(work3D) configure -height ] 4 ] - $y - 1 ]
1359
1360     set pickWPPos [ pick_point_local_actor $x $y renderer_$widgets(work3D) isoActor_$widgets(work3D) 0.001 ]
1361     set xc [ lindex $pickWPPos 0 ]
1362     set yc [ lindex $pickWPPos 1 ]
1363     set zc [ lindex $pickWPPos 2 ]
1364
1365     #Chercher le point de l'axe le plus proche au point choisi sur la surface
1366     set indP [ axisGrid_$widgets(work3D) FindPoint $xc $yc $zc ]
1367     set coordsP [ axisGrid_$widgets(work3D) GetPoint $indP ]
1368     set xc [ lindex $coordsP 0 ]
1369     set yc [ lindex $coordsP 1 ]
1370     set zc [ lindex $coordsP 2 ]
1371
1372     renderer_$widgets(work3D) AddActor [ DrawSphere sphere_tmp_$widgets(work3D) 1.0 $xc $yc $zc 1.0 0.0 0.0 ]
1373
1374     [ $widgets(work3D) GetRenderWindow ] Render
1375
1376     set dir [ choose_direction::show $widgets(work3D) ]
1377     if { $dir == -1 || $dir == 1 } {
1378
1379         cutAxis_dll $indP $dir
1380         set points [ getAxis_dll ]
1381         u_surf::show_axis $points
1382         set ans [ \
1383             tk_messageBox \
1384                 -icon question \
1385                 -message "$string_table::str_accept_changes" \
1386                 -type yesno \
1387                 -title "Question" \
1388         ]
1389         if { [ string compare $ans no ] == 0 } {
1390
1391             undoAxis_dll
1392             u_surf::show_axis [ getAxis_dll ]
1393
1394         } else {
1395
1396             $widgets(edtChooseAxis) delete 0  end
1397             $widgets(edtChooseAxis) insert end ""
1398
1399         }
1400
1401     }
1402     [ $widgets(work3D) GetRenderWindow ] Render
1403     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_tmp_$widgets(work3D) ] }
1404     DeleteSphere sphere_tmp_$widgets(work3D)
1405
1406 }
1407
1408 proc u_surf::remove_axis { } {
1409
1410     # For programming facilities
1411     upvar u_surf::widgets    widgets
1412     upvar u_surf::axis_index axis_index
1413     upvar u_surf::indexes    indexes
1414
1415     #   Delete from data...
1416     set name [ $widgets(edtChooseAxis) get ]
1417     cleanAxis_dll
1418     if { $name != "" } {
1419
1420         deleteAxis_dll $indexes($name)
1421
1422         #   Reorder combobox
1423         $widgets(edtChooseAxis) delete 0  end
1424         $widgets(edtChooseAxis) insert end ""
1425         $widgets(edtChooseAxis) list delete $indexes($name) $indexes($name)
1426
1427         #   Reorder array
1428         set l [ getAxisDescriptions_dll ]
1429         array set indexes [ list [ lindex $l 0 ] 0 ]
1430         for { set i 1 } { $i < [ llength $l ] } { incr i } {
1431
1432             set indexes([ lindex $l $i ]) $i
1433
1434         }
1435
1436     }
1437
1438     #   3D data reset
1439     catch { renderer_$widgets(work3D) RemoveActor axisActor_$widgets(work3D) }
1440     catch { axisActor_$widgets(work3D)    Delete }
1441     catch { axisMapper_$widgets(work3D)   Delete }
1442     catch { axisGrid_$widgets(work3D)     Delete }
1443     catch { axisPolyLine_$widgets(work3D) Delete }
1444     catch { axisPoints_$widgets(work3D)   Delete }
1445     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_6_$widgets(work3D) ] }
1446     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_7_$widgets(work3D) ] }
1447     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_cell_int_$widgets(work3D) ] }
1448     DeleteSphere sphere_6_$widgets(work3D)
1449     DeleteSphere sphere_7_$widgets(work3D)
1450     DeleteSphere sphere_cell_int_$widgets(work3D)
1451
1452     [ $widgets(work3D) GetRenderWindow ] Render
1453     u_3D::controls 0
1454
1455 }
1456
1457 proc u_surf::continue_axis { } {
1458
1459     # For programming facilities
1460     upvar u_surf::widgets widgets
1461     upvar u_surf::axis_index axis_index
1462
1463     busy hold .
1464     u_3D::controls
1465     update
1466
1467     catch { set center [ sphere_3_$widgets(work3D) GetCenter ] } err
1468     set err [ expr ( [ string compare [ lindex $err 0 ] invalid ] != 0 )? 0: 1 ]
1469
1470     if { $err == 0 } {
1471
1472         set resample [ GetVTKVolume_dll ]
1473         set bounds   [ $resample GetBounds ]
1474         set vox_size [ GetActualVoxelSize_dll ]
1475         set coord [ \
1476             VoxelCoord \
1477                 [ lindex $center 0 ] \
1478                 [ lindex $center 1 ] \
1479                 [ lindex $center 2 ] \
1480                 [ lindex $bounds 0 ] \
1481                 [ lindex $bounds 2 ] \
1482                 [ lindex $bounds 4 ] \
1483                 $vox_size $vox_size $vox_size \
1484         ]
1485
1486         continueAxis_dll $coord
1487         set points [ getAxis_dll ]
1488         u_surf::show_axis $points
1489         set ans [ \
1490             tk_messageBox \
1491                 -icon question \
1492                 -message "$string_table::str_accept_changes" \
1493                 -type yesno \
1494                 -title "Question" \
1495         ]
1496         if { [ string compare $ans no ] == 0 } {
1497
1498             undoAxis_dll
1499             u_surf::show_axis [ getAxis_dll ]
1500
1501         } else {
1502
1503             $widgets(edtChooseAxis) delete 0  end
1504             $widgets(edtChooseAxis) insert end ""
1505
1506         }
1507
1508
1509         busy release .
1510         update
1511         u_3D::controls 0
1512
1513     } else {
1514
1515         busy release .
1516         update
1517         u_3D::controls 0
1518
1519         tk_messageBox \
1520             -icon error \
1521             -message "$string_table::str_please_select_a_point" \
1522             -title "ERROR"
1523
1524     }
1525 }
1526
1527 proc u_surf::set_mouse_left_events { mask } {
1528
1529     # For programming facilities
1530     upvar u_surf::widgets widgets
1531
1532     # TODO : change
1533     catch { bind $widgets(work3D) <Any-ButtonPress>   { ev_startMotion %W %x %y } }
1534     catch { bind $widgets(work3D) <Any-ButtonRelease> { ev_endMotion %W %x %y } }
1535
1536     if { [ expr $mask & 0x4 ] == 0x4 } { catch { bind $widgets(work3D) <B1-Motion> { evz_rotate %W %x %y } } }
1537     if { [ expr $mask & 0x2 ] == 0x2 } { catch { bind $widgets(work3D) <B1-Motion> { evz_pan %W %x %y } } }
1538
1539 }
1540
1541 proc u_surf::set_mouse_right_events { mask } {
1542
1543     # For programming facilities
1544     upvar u_surf::widgets widgets
1545
1546     catch { bind $widgets(work3D) <Any-ButtonPress>   { ev_startMotion %W %x %y } }
1547     catch { bind $widgets(work3D) <Any-ButtonRelease> { ev_endMotion %W %x %y } }
1548
1549     if { [ expr $mask & 0x4 ] == 0x4 } { catch { bind $widgets(work3D) <B3-Motion> { evz_zoom %W %x %y } } }
1550
1551 }
1552
1553 proc u_surf::select_axis { args } {
1554
1555     # For programming facilities
1556     upvar u_surf::widgets widgets
1557     upvar u_surf::axis_index axis_index
1558     upvar u_surf::indexes         indexes
1559
1560     if { [ array names indexes [ $widgets(edtChooseAxis) get ] ] != "" } {
1561
1562         setAxis_dll $indexes([ $widgets(edtChooseAxis) get ])
1563         u_surf::show_axis [ getAxis_dll ]
1564
1565     }
1566
1567 }
1568
1569 proc u_surf::get_isoval { } {
1570
1571     # For programming facilities
1572     upvar u_surf::widgets widgets
1573
1574     return [ $widgets(sclIso) get ]
1575
1576 }
1577
1578 proc u_surf::reload_axis { mask step } {
1579
1580     # For programming facilities
1581     upvar u_surf::widgets    widgets
1582     upvar u_surf::axis_index axis_index
1583
1584     if { $axis_index != -1 } {
1585
1586         if { $step == 1 } {
1587
1588             redoAxisSpline_dll
1589
1590         } elseif { $mask == 1 } { recalculeAxisSignal_dll }
1591         set points [ getAxis_dll ]
1592         u_surf::show_axis $points
1593
1594     }
1595
1596 }
1597
1598 proc u_surf::load_axes { } {
1599
1600     # For programming facilities
1601     upvar u_surf::widgets widgets
1602     upvar u_surf::indexes indexes
1603
1604     u_surf::show_axis [ getAxis_dll ]
1605
1606     $widgets(edtChooseAxis) list delete 0 end
1607     set names [ getAxisDescriptions_dll ]
1608     set i 0
1609     array set indexes [ list [ lindex $names 0 ] 0 ]
1610     foreach name $names {
1611
1612         $widgets(edtChooseAxis) list insert end $name
1613         set indexes($name) $i
1614         incr i
1615
1616     }
1617
1618     $widgets(edtChooseAxis) delete 0 end
1619     $widgets(edtChooseAxis) insert end  [ getAxisDescription_dll ]
1620     [ $widgets(work3D) GetRenderWindow ] Render
1621     u_3D::controls 2
1622
1623 }
1624
1625 proc u_surf::saveasvtk { } {
1626
1627     # For programming facilities
1628     upvar u_surf::widgets widgets
1629
1630 #    catch { objexp Delete }
1631 #
1632 #    vtkOBJExporter objexp
1633 #    objexp SetInput [ $widgets(work3D) GetRenderWindow ]
1634 #    objexp SetFilePrefix "./maracas"
1635 #    objexp Write
1636
1637     set a [cubes_$widgets(work3D) GetOutput]
1638     vtkPolyDataWriter b
1639
1640     set f [ tk_getSaveFile -defaultextension "vtk" \
1641         -initialdir "." \
1642                            -title "Save surface..." \
1643                            -filetypes { { {vtk Files} {.vtk} } }
1644     ]
1645     if { [ string compare $f "" ] != 0 } {
1646         b SetInput $a
1647         b SetFileName $f
1648         b SetFileTypeToASCII
1649         b Write
1650     }
1651     b Delete
1652 }
1653
1654
1655 # EOF - u_surf.tcl