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

   1 package require BLT
   2 catch { namespace import blt::* }
   3
   4 namespace eval planes_window {
   5
   6     # public interface
   7     namespace export        \
   8         create              \
   9         positionate         \
  10         forget
  11
  12     # variables
  13     variable widgets
  14
  15     variable reference_actor
  16     variable surf_data
  17     variable actual_actor
  18     variable quant_actor
  19     variable bounds
  20     variable intRange
  21     variable axis_index -1
  22     variable nClicks 0
  23     variable quantifing 0
  24     variable first_point_quant
  25     variable last_point_quant
  26     variable real_first_point_quant -1
  27     variable real_last_point_quant  -1
  28     variable actor_debug1
  29     variable actor_debug2
  30     variable initX
  31     variable initY
  32     variable initWindow
  33     variable initLevel
  34     variable man_points {}
  35     variable show_hs_var
  36     variable first_quant
  37     variable local_id
  38     variable show_rings
  39     variable rings_index {}
  40     variable quant_shown 0
  41
  42     variable actual_area    0.00
  43     variable actual_peri    0.00
  44     variable actual_darea   0.00
  45     variable actual_dperi   0.00
  46     variable actual_dmax    0.00
  47     variable actual_dmin    0.00
  48     variable actual_davg    0.00
  49     variable actual_sten    0.00
  50     variable actual_partial 0.00
  51     variable actual_total   0.00
  52
  53     variable actual_quant_x     {}
  54     variable actual_quant_area  {}
  55     variable actual_quant_peri  {}
  56     variable actual_quant_darea {}
  57     variable actual_quant_dperi {}
  58     variable actual_quant_dmax  {}
  59     variable actual_quant_dmin  {}
  60     variable actual_quant_davg  {}
  61     variable actual_quant_sten  {}
  62     variable shown 0
  63     variable given_points 0
  64
  65 }
  66
  67 proc planes_window::reset { parent } {
  68
  69     # For programming facilities
  70     upvar planes_window::widgets widgets
  71
  72     set widgets(base)              "$parent"
  73     set widgets(planes_wnd)        "$parent\.planes_wnd"
  74     set widgets(frTop)             "$parent\.planes_wnd.frTop"
  75     set widgets(frLeft)            "$parent\.planes_wnd.frTop.frLeft"
  76     set widgets(frRight)           "$parent\.planes_wnd.frTop.frRight"
  77     set widgets(work3D)            "$parent\.planes_wnd.frTop.frLeft.work3D"
  78     set widgets(frControls)        "$parent\.planes_wnd.frTop.frLeft.frControls"
  79     set widgets(frPlanes)          "$parent\.planes_wnd.frTop.frLeft.frControls.frPlanes"
  80     set widgets(btnSHealthySlice)  "$parent\.planes_wnd.frTop.frLeft.frControls.frPlanes.btnSHealthySlice"
  81     set widgets(btnPerpendicular)  "$parent\.planes_wnd.frTop.frLeft.frControls.frPlanes.btnPerpendicular"
  82     set widgets(frColor)           "$parent\.planes_wnd.frTop.frLeft.frControls.frColor"
  83     set widgets(btnGreyScale)      "$parent\.planes_wnd.frTop.frLeft.frControls.frColor.btnGreyScale"
  84     set widgets(btnColor)          "$parent\.planes_wnd.frTop.frLeft.frControls.frColor.btnColor"
  85     set widgets(frSurfaces)        "$parent\.planes_wnd.frTop.frLeft.frControls.frSurfaces"
  86     set widgets(btnTransparent)    "$parent\.planes_wnd.frTop.frLeft.frControls.frSurfaces.btnTransparent"
  87     set widgets(btnEdge)           "$parent\.planes_wnd.frTop.frLeft.frControls.frSurfaces.btnEdge"
  88     set widgets(btnOpaque)         "$parent\.planes_wnd.frTop.frLeft.frControls.frSurfaces.btnOpaque"
  89     set widgets(btnShowS)          "$parent\.planes_wnd.frTop.frLeft.frControls.frSurfaces.btnShowS"
  90     set widgets(btnRings)          "$parent\.planes_wnd.frTop.frLeft.frControls.frSurfaces.btnRings"
  91     set widgets(btnSurface)        "$parent\.planes_wnd.frTop.frLeft.frControls.frSurfaces.btnSurface"
  92     set widgets(btnSColor)         "$parent\.planes_wnd.frTop.frLeft.frControls.frSurfaces.btnSColor"
  93     set widgets(lbl001)            "$parent\.planes_wnd.frTop.frLeft.frControls.frSurfaces.lbl001"
  94     set widgets(frBrowsers)        "$parent\.planes_wnd.frTop.frLeft.frControls.frBrowsers"
  95     set widgets(sclSlice)          "$parent\.planes_wnd.frTop.frLeft.frControls.frBrowsers.sclSlice"
  96     set widgets(sclIsoVal)         "$parent\.planes_wnd.frTop.frLeft.frControls.frBrowsers.sclIsoVal"
  97     set widgets(sclOpacity)        "$parent\.planes_wnd.frTop.frLeft.frControls.frBrowsers.sclOpacity"
  98     set widgets(fr2D)              "$parent\.planes_wnd.frTop.frRight.fr2D"
  99     set widgets(image2D)           "$parent\.planes_wnd.frTop.frRight.fr2D.image2D"
 100     set widgets(frControls2D)      "$parent\.planes_wnd.frTop.frRight.fr2D.frControls2D"
 101     set widgets(fr001)             "$parent\.planes_wnd.frTop.frRight.fr2D.frControls2D.fr001"
 102     set widgets(btnContour)        "$parent\.planes_wnd.frTop.frRight.fr2D.frControls2D.fr001.btnContour"
 103     set widgets(btnClean)          "$parent\.planes_wnd.frTop.frRight.fr2D.frControls2D.fr001.btnClean"
 104     set widgets(btnHealthySlice)   "$parent\.planes_wnd.frTop.frRight.fr2D.frControls2D.fr001.btnHealthySlice"
 105     set widgets(btnCalculated)     "$parent\.planes_wnd.frTop.frRight.fr2D.frControls2D.fr001.btnCalculated"
 106     set widgets(btnPause)          "$parent\.planes_wnd.frTop.frRight.fr2D.frControls2D.fr001.btnPause"
 107     set widgets(btnEraseQuant)     "$parent\.planes_wnd.frTop.frRight.fr2D.frControls2D.fr001.btnEraseQuant"
 108     set widgets(btnSetPoint)       "$parent\.planes_wnd.frTop.frRight.fr2D.frControls2D.fr001.btnSetPoint"
 109     set widgets(frBLT)             "$parent\.planes_wnd.frTop.frRight.frBLT"
 110     set widgets(graph)             "$parent\.planes_wnd.frTop.frRight.frBLT.graph"
 111     set widgets(frData)            "$parent\.planes_wnd.frData"
 112     set widgets(frPartialAxis)     "$parent\.planes_wnd.frData.frPartialArea"
 113     set widgets(frTotalAxis)       "$parent\.planes_wnd.frData.frTotalArea"
 114     set widgets(frArea)            "$parent\.planes_wnd.frData.frArea"
 115     set widgets(frPerimeter)       "$parent\.planes_wnd.frData.frPerimeter"
 116     set widgets(frDiamArea)        "$parent\.planes_wnd.frData.frDiamArea"
 117     set widgets(frDiamPerimeter)   "$parent\.planes_wnd.frData.frDiamPerimeter"
 118     set widgets(frDiamMax)         "$parent\.planes_wnd.frData.frDiamMax"
 119     set widgets(frDiamMin)         "$parent\.planes_wnd.frData.frDiamMin"
 120     set widgets(frDiamAvg)         "$parent\.planes_wnd.frData.frDiamAvg"
 121     set widgets(frStenosis)        "$parent\.planes_wnd.frData.frStenosis"
 122     set widgets(lblArea)           "$parent\.planes_wnd.frData.frArea.lblArea"
 123     set widgets(lblPerimeter)      "$parent\.planes_wnd.frData.frPerimeter.lblPerimeter"
 124     set widgets(lblDiamArea)       "$parent\.planes_wnd.frData.frDiamArea.lblDiamArea"
 125     set widgets(lblDiamPerimeter)  "$parent\.planes_wnd.frData.frDiamPerimeter.lblDiamPerimeter"
 126     set widgets(lblDiamMax)        "$parent\.planes_wnd.frData.frDiamMax.lblDiamMax"
 127     set widgets(lblDiamMin)        "$parent\.planes_wnd.frData.frDiamMin.lblDiamMin"
 128     set widgets(lblDiamAvg)        "$parent\.planes_wnd.frData.frDiamAvg.lblDiamAvg"
 129     set widgets(lblStenosis)       "$parent\.planes_wnd.frData.frStenosis.lblStenosis"
 130     set widgets(lblPartialAxis)    "$parent\.planes_wnd.frData.frPartialArea.lblPartialArea"
 131     set widgets(lblTotalAxis)      "$parent\.planes_wnd.frData.frTotalArea.lblTotalArea"
 132     set widgets(vlblArea)          "$parent\.planes_wnd.frData.frArea.vlblArea"
 133     set widgets(vlblPerimeter)     "$parent\.planes_wnd.frData.frPerimeter.vlblPerimeter"
 134     set widgets(vlblDiamArea)      "$parent\.planes_wnd.frData.frDiamArea.vlblDiamArea"
 135     set widgets(vlblDiamPerimeter) "$parent\.planes_wnd.frData.frDiamPerimeter.vlblDiamPerimeter"
 136     set widgets(vlblDiamMax)       "$parent\.planes_wnd.frData.frDiamMax.vlblDiamMax"
 137     set widgets(vlblDiamMin)       "$parent\.planes_wnd.frData.frDiamMin.vlblDiamMin"
 138     set widgets(vlblDiamAvg)       "$parent\.planes_wnd.frData.frDiamAvg.vlblDiamAvg"
 139     set widgets(vlblStenosis)      "$parent\.planes_wnd.frData.frStenosis.vlblStenosis"
 140     set widgets(vlblPartialAxis)   "$parent\.planes_wnd.frData.frPartialArea.vlblPartialArea"
 141     set widgets(vlblTotalAxis)     "$parent\.planes_wnd.frData.frTotalArea.vlblTotalArea"
 142
 143 }
 144
 145 proc planes_window::create { parent id } {
 146
 147     # For programming facilities
 148     upvar planes_window::widgets        widgets
 149     upvar planes_window::local_id       local_id
 150     upvar planes_window::actual_area    actual_area
 151     upvar planes_window::actual_peri    actual_peri
 152     upvar planes_window::actual_darea   actual_darea
 153     upvar planes_window::actual_dperi   actual_dperi
 154     upvar planes_window::actual_dmax    actual_dmax
 155     upvar planes_window::actual_dmin    actual_dmin
 156     upvar planes_window::actual_davg    actual_davg
 157     upvar planes_window::actual_sten    actual_sten
 158     upvar planes_window::actual_partial actual_partial
 159     upvar planes_window::actual_total   actual_total
 160     upvar planes_window::quant_shown    quant_shown
 161     upvar planes_window::shown          shown
 162
 163     set shown 0
 164
 165     set local_id $id
 166     set quant_shown 0
 167
 168     planes_window::reset $parent
 169
 170     # frames
 171     frame $widgets(planes_wnd)   -height 100 -width 125
 172     frame $widgets(frTop)        -borderwidth 0 -height 1 -relief flat -width 1
 173     frame $widgets(frLeft)       -borderwidth 0 -height 1 -relief flat   -width 1
 174     frame $widgets(frControls)   -borderwidth 2 -height 112 -relief groove -width 100
 175     frame $widgets(frPlanes)     -borderwidth 0 -height 1 -relief groove -width 1
 176     frame $widgets(frColor)      -borderwidth 0 -height 1 -relief groove -width 1
 177     frame $widgets(frSurfaces)   -borderwidth 0 -height 1 -relief groove -width 1
 178     frame $widgets(frBrowsers)   -borderwidth 0 -height 1 -relief groove -width 1
 179     frame $widgets(frRight)      -borderwidth 0 -height 1 -relief flat   -width 1
 180     frame $widgets(fr2D)         -borderwidth 0 -height 1 -relief flat   -width 1
 181     frame $widgets(frControls2D) -borderwidth 0 -height 1 -relief flat   -width 1
 182     frame $widgets(fr001)        -borderwidth 2 -height 1 -relief groove -width 1
 183     frame $widgets(frBLT)        -borderwidth 0 -height 1 -relief flat   -width 1
 184     frame $widgets(frData)       -borderwidth 0 -height 1 -relief flat -width 1
 185
 186     frame $widgets(frPartialAxis)   -borderwidth 0 -height 1 -relief flat -width 1
 187     frame $widgets(frTotalAxis)     -borderwidth 0 -height 1 -relief flat -width 1
 188     frame $widgets(frArea)          -borderwidth 0 -height 1 -relief flat -width 1
 189     frame $widgets(frPerimeter)     -borderwidth 0 -height 1 -relief flat -width 1
 190     frame $widgets(frDiamArea)      -borderwidth 0 -height 1 -relief flat -width 1
 191     frame $widgets(frDiamPerimeter) -borderwidth 0 -height 1 -relief flat -width 1
 192     frame $widgets(frDiamMax)       -borderwidth 0 -height 1 -relief flat -width 1
 193     frame $widgets(frDiamMin)       -borderwidth 0 -height 1 -relief flat -width 1
 194     frame $widgets(frDiamAvg)       -borderwidth 0 -height 1 -relief flat -width 1
 195     frame $widgets(frStenosis)      -borderwidth 0 -height 1 -relief flat -width 1
 196
 197     # checkbuttons
 198     checkbutton $widgets(btnSHealthySlice)  -text $string_table::str_healthy_slice         -variable var_healthy -command { planes_window::show_hs_3D $var_healthy }
 199     checkbutton $widgets(btnShowS)          -text $string_table::str_show_surf             -variable var_showS   -command { planes_window::set_IsoActor [ expr ( $var_showS == 0 )? 4: $planes_window::actual_actor ] }
 200     checkbutton $widgets(btnRings)          -text $string_table::str_rings_visible         -variable var_rings   -command { planes_window::show3D_rings_contour $var_rings }
 201     checkbutton $widgets(btnSurface)        -text $string_table::str_rec_surface           -variable var_rec     -command { planes_window::load_reconstructed_surface $var_rec }
 202     checkbutton $widgets(btnPerpendicular)  -text $string_table::str_perpendicular_section -variable var_perp    -command { planes_window::put_plane_3D $var_perp }
 203
 204     # radiobuttons
 205     radiobutton $widgets(btnGreyScale)   -text $string_table::str_greyscale -variable color_type -value 1 -command { planes_window::set_color_table $color_type }
 206     radiobutton $widgets(btnColor)       -text $string_table::str_color     -variable color_type -value 2 -command { planes_window::set_color_table $color_type }
 207
 208     radiobutton $widgets(btnOpaque)      -text $string_table::str_opaque      -variable surf_type -value 1 -command { planes_window::set_IsoActor $surf_type }
 209     radiobutton $widgets(btnTransparent) -text $string_table::str_transparent -variable surf_type -value 2 -command { planes_window::set_IsoActor $surf_type }
 210     radiobutton $widgets(btnEdge)        -text $string_table::str_edge_points -variable surf_type -value 3 -command { planes_window::set_IsoActor $surf_type }
 211
 212     # buttons
 213     button $widgets(btnSColor)       -command "planes_window::change_color"
 214
 215     button $widgets(btnContour)      -text $string_table::str_contour
 216     button $widgets(btnClean)        -text $string_table::str_clean         -command "planes_window::clean_contour"
 217     button $widgets(btnHealthySlice) -text $string_table::str_healthy_slice -command "planes_window::set_healthy_slice"
 218     button $widgets(btnCalculated)   -text $string_table::str_calculated    -command "planes_window::contour_calculated"
 219     button $widgets(btnPause)        -text $string_table::str_pause         -command "planes_window::pause"
 220     button $widgets(btnEraseQuant)   -text $string_table::str_erase_quant   -command "planes_window::erase_all_data"
 221     button $widgets(btnSetPoint)     -text "Point..." -command "planes_window::set_quant_point_from_scale"
 222
 223     # scales
 224     scale $widgets(sclSlice)   -label $string_table::str_slice   -orient horizontal
 225     scale $widgets(sclIsoVal)  -label $string_table::str_isoval  -orient horizontal
 226     scale $widgets(sclOpacity) -label $string_table::str_opacity -orient horizontal
 227
 228     # labels
 229     label $widgets(lbl001)                                         -text $string_table::str_color
 230     label $widgets(lblArea)          -borderwidth 1 -relief groove -text $string_table::str_area
 231     label $widgets(lblPerimeter)     -borderwidth 1 -relief groove -text $string_table::str_peri
 232     label $widgets(lblDiamArea)      -borderwidth 1 -relief groove -text $string_table::str_diam_area
 233     label $widgets(lblDiamPerimeter) -borderwidth 1 -relief groove -text $string_table::str_diam_peri
 234     label $widgets(lblDiamMax)       -borderwidth 1 -relief groove -text $string_table::str_diam_max
 235     label $widgets(lblDiamMin)       -borderwidth 1 -relief groove -text $string_table::str_diam_min
 236     label $widgets(lblDiamAvg)       -borderwidth 1 -relief groove -text $string_table::str_diam_avg
 237     label $widgets(lblStenosis)      -borderwidth 1 -relief groove -text Stenosis
 238     label $widgets(lblPartialAxis)   -borderwidth 1 -relief groove -text "Partial Axis Length"
 239     label $widgets(lblTotalAxis)     -borderwidth 1 -relief groove -text "Total Axis Length"
 240
 241     label $widgets(vlblArea)          -borderwidth 1 -relief groove -textvariable planes_window::actual_area
 242     label $widgets(vlblPerimeter)     -borderwidth 1 -relief groove -textvariable planes_window::actual_peri
 243     label $widgets(vlblDiamArea)      -borderwidth 1 -relief groove -textvariable planes_window::actual_darea
 244     label $widgets(vlblDiamPerimeter) -borderwidth 1 -relief groove -textvariable planes_window::actual_dperi
 245     label $widgets(vlblDiamMax)       -borderwidth 1 -relief groove -textvariable planes_window::actual_dmax
 246     label $widgets(vlblDiamMin)       -borderwidth 1 -relief groove -textvariable planes_window::actual_dmin
 247     label $widgets(vlblDiamAvg)       -borderwidth 1 -relief groove -textvariable planes_window::actual_davg
 248     label $widgets(vlblStenosis)      -borderwidth 1 -relief groove -textvariable planes_window::actual_sten
 249     label $widgets(vlblPartialAxis)   -borderwidth 1 -relief groove -textvariable planes_window::actual_partial
 250     label $widgets(vlblTotalAxis)     -borderwidth 1 -relief groove -textvariable planes_window::actual_total
 251
 252     # BLT graph
 253     graph $widgets(graph) \
 254         -background white \
 255         -barmode infront \
 256         -borderwidth 0 \
 257         -foreground black \
 258         -halo 8 \
 259         -height 75 \
 260         -plotpadx {8 8} \
 261         -plotpady {8 8} \
 262         -plotrelief groove \
 263         -width 480
 264
 265 }
 266
 267 proc planes_window::positionate { } {
 268
 269     # For programming facilities
 270     upvar planes_window::widgets widgets
 271     upvar planes_window::local_id  local_id
 272     upvar planes_window::first_quant  first_quant
 273     upvar planes_window::local_id  local_id
 274     upvar planes_window::shown          shown
 275     upvar planes_window::given_points  given_points
 276
 277     set given_points 0
 278
 279     set shown 1
 280
 281     set global_window::show_params 0
 282
 283     set first_quant 1
 284     set global_window::window_shown $local_id
 285
 286     pack  $widgets(planes_wnd)       -anchor nw -expand 1 -fill both -side left
 287     pack  $widgets(frTop)            -anchor center -expand 1 -fill both -side top
 288     pack  $widgets(frLeft)           -anchor nw -expand 1 -fill both -side left
 289     pack  $widgets(work3D)           -anchor center -expand 1 -fill both -side top
 290     pack  $widgets(frControls)       -anchor center -expand 0 -fill both -side top
 291     place $widgets(frPlanes)         -x 10 -y 2 -width 300 -height 25 -anchor nw -bordermode ignore
 292     place $widgets(btnSHealthySlice) -x 5 -y 0 -anchor nw -bordermode ignore
 293     place $widgets(btnPerpendicular) -x 100 -y 0 -anchor nw -bordermode ignore
 294     place $widgets(frColor)          -x 350 -y 2 -width 150 -height 25 -anchor nw -bordermode ignore
 295     place $widgets(btnGreyScale)     -x 5 -y 0 -anchor nw -bordermode ignore
 296     place $widgets(btnColor)         -x 80 -y 0 -anchor nw -bordermode ignore
 297     place $widgets(frSurfaces)       -x 10 -y 27 -width 400 -height 25 -anchor nw -bordermode ignore
 298     #place $widgets(btnSurface)       -x 5 -y 0 -anchor nw -bordermode ignore
 299     place $widgets(btnRings)         -x 150 -y 0 -anchor nw -bordermode ignore
 300     place $widgets(btnShowS)         -x 250 -y 0 -anchor nw -bordermode ignore
 301     place $widgets(frBrowsers)       -x 10 -y 50 -width 515 -height 60 -anchor nw -bordermode ignore
 302     place $widgets(sclSlice)         -x 5 -y 0 -width 163 -height 60 -anchor nw -bordermode ignore
 303     place $widgets(sclIsoVal)        -x 175 -y 0 -width 163 -height 60 -anchor nw -bordermode ignore
 304     place $widgets(sclOpacity)       -x 350 -y 0 -width 158 -height 60 -anchor nw -bordermode ignore
 305     pack  $widgets(frRight)          -anchor center -expand 0 -fill both -side left
 306     pack  $widgets(fr2D)             -anchor center -expand 1 -fill both -side top
 307     pack  $widgets(image2D)          -anchor center -expand 1 -fill both -side top
 308     pack  $widgets(frControls2D)     -anchor center -expand 0 -fill x -side top
 309     pack  $widgets(fr001)            -anchor nw -expand 0 -fill none -side left
 310     pack  $widgets(btnContour)       -anchor nw -expand 0 -fill none -side left
 311     pack  $widgets(btnClean)         -anchor nw -expand 0 -fill none -side left
 312     pack  $widgets(btnHealthySlice)  -anchor nw -expand 0 -fill none -side left
 313     pack  $widgets(btnCalculated)    -anchor nw -expand 0 -fill none -side left
 314     pack  $widgets(btnPause)         -anchor nw -expand 0 -fill none -side left
 315     pack  $widgets(btnEraseQuant)    -anchor nw -expand 0 -fill none -side left
 316     pack  $widgets(btnSetPoint)      -anchor nw -expand 0 -fill none -side left
 317     pack  $widgets(frBLT)            -anchor center -expand 1 -fill both -side top
 318     pack  $widgets(graph)            -anchor center -expand 1 -fill both -side top
 319     pack  $widgets(frData)           -anchor center -expand 0 -fill x -side top
 320     pack  $widgets(frPartialAxis)    -anchor nw -expand 1 -fill both -side left
 321     pack  $widgets(frTotalAxis)      -anchor nw -expand 1 -fill both -side left
 322     pack  $widgets(frArea)           -anchor nw -expand 1 -fill both -side left
 323     pack  $widgets(frPerimeter)      -anchor nw -expand 1 -fill both -side left
 324     pack  $widgets(frDiamArea)       -anchor nw -expand 1 -fill both -side left
 325     pack  $widgets(frDiamPerimeter)  -anchor nw -expand 1 -fill both -side left
 326     pack  $widgets(frDiamMax)        -anchor nw -expand 1 -fill both -side left
 327     pack  $widgets(frDiamMin)        -anchor nw -expand 1 -fill both -side left
 328     pack  $widgets(frDiamAvg)        -anchor nw -expand 1 -fill both -side left
 329     pack  $widgets(frStenosis)       -anchor nw -expand 1 -fill both -side left
 330     pack  $widgets(lblArea)           -anchor center -expand 1 -fill both -side top
 331     pack  $widgets(lblPerimeter)      -anchor center -expand 1 -fill both -side top
 332     pack  $widgets(lblDiamArea)       -anchor center -expand 1 -fill both -side top
 333     pack  $widgets(lblDiamPerimeter)  -anchor center -expand 1 -fill both -side top
 334     pack  $widgets(lblDiamMax)        -anchor center -expand 1 -fill both -side top
 335     pack  $widgets(lblDiamMin)        -anchor center -expand 1 -fill both -side top
 336     pack  $widgets(lblDiamAvg)        -anchor center -expand 1 -fill both -side top
 337     pack  $widgets(lblStenosis)       -anchor center -expand 1 -fill both -side top
 338     pack  $widgets(lblPartialAxis)   -anchor center -expand 1 -fill both -side top
 339     pack  $widgets(lblTotalAxis)     -anchor center -expand 1 -fill both -side top
 340     pack  $widgets(vlblArea)          -anchor center -expand 1 -fill both -side top
 341     pack  $widgets(vlblPerimeter)     -anchor center -expand 1 -fill both -side top
 342     pack  $widgets(vlblDiamArea)      -anchor center -expand 1 -fill both -side top
 343     pack  $widgets(vlblDiamPerimeter) -anchor center -expand 1 -fill both -side top
 344     pack  $widgets(vlblDiamMax)       -anchor center -expand 1 -fill both -side top
 345     pack  $widgets(vlblDiamMin)       -anchor center -expand 1 -fill both -side top
 346     pack  $widgets(vlblDiamAvg)       -anchor center -expand 1 -fill both -side top
 347     pack  $widgets(vlblStenosis)      -anchor center -expand 1 -fill both -side top
 348     pack  $widgets(vlblPartialAxis)   -anchor center -expand 1 -fill both -side top
 349     pack  $widgets(vlblTotalAxis)     -anchor center -expand 1 -fill both -side top
 350
 351 }
 352
 353 proc planes_window::forget { } {
 354
 355     # For programming facilities
 356     upvar planes_window::widgets widgets
 357     upvar planes_window::shown   shown
 358
 359     set shown 0
 360
 361     pack  forget $widgets(vlblStenosis)
 362     pack  forget $widgets(vlblDiamAvg)
 363     pack  forget $widgets(vlblDiamMin)
 364     pack  forget $widgets(vlblDiamMax)
 365     pack  forget $widgets(vlblDiamPerimeter)
 366     pack  forget $widgets(vlblDiamArea)
 367     pack  forget $widgets(vlblPerimeter)
 368     pack  forget $widgets(vlblArea)
 369     pack  forget $widgets(lblStenosis)
 370     pack  forget $widgets(lblDiamAvg)
 371     pack  forget $widgets(lblDiamMin)
 372     pack  forget $widgets(lblDiamMax)
 373     pack  forget $widgets(lblDiamPerimeter)
 374     pack  forget $widgets(lblDiamArea)
 375     pack  forget $widgets(lblPerimeter)
 376     pack  forget $widgets(lblArea)
 377     pack  forget $widgets(frStenosis)
 378     pack  forget $widgets(frDiamAvg)
 379     pack  forget $widgets(frDiamMin)
 380     pack  forget $widgets(frDiamMax)
 381     pack  forget $widgets(frDiamPerimeter)
 382     pack  forget $widgets(frDiamArea)
 383     pack  forget $widgets(frPerimeter)
 384     pack  forget $widgets(frArea)
 385     pack  forget $widgets(frData)
 386     pack  forget $widgets(graph)
 387     pack  forget $widgets(frBLT)
 388     pack  forget $widgets(btnEraseQuant)
 389     pack  forget $widgets(btnPause)
 390     pack  forget $widgets(btnCalculated)
 391     pack  forget $widgets(btnHealthySlice)
 392     pack  forget $widgets(btnClean)
 393     pack  forget $widgets(btnContour)
 394     pack  forget $widgets(fr001)
 395     pack  forget $widgets(frControls2D)
 396     pack  forget $widgets(image2D)
 397     pack  forget $widgets(fr2D)
 398     pack  forget $widgets(frRight)
 399     place forget $widgets(sclOpacity)
 400     place forget $widgets(sclIsoVal)
 401     place forget $widgets(sclSlice)
 402     place forget $widgets(frBrowsers)
 403     place forget $widgets(lbl001)
 404     place forget $widgets(btnSColor)
 405     place forget $widgets(btnShowS)
 406     place forget $widgets(btnSurface)
 407     place forget $widgets(btnRings)
 408     place forget $widgets(btnOpaque)
 409     place forget $widgets(btnEdge)
 410     place forget $widgets(btnTransparent)
 411     place forget $widgets(frSurfaces)
 412     place forget $widgets(btnColor)
 413     place forget $widgets(btnGreyScale)
 414     place forget $widgets(frColor)
 415     place forget $widgets(btnPerpendicular)
 416     place forget $widgets(btnSHealthySlice)
 417     place forget $widgets(frPlanes)
 418     pack  forget $widgets(frControls)
 419     pack  forget $widgets(work3D)
 420     pack  forget $widgets(frLeft)
 421     pack  forget $widgets(frTop)
 422     pack  forget $widgets(planes_wnd)
 423
 424 }
 425
 426 proc planes_window::set_data { } {
 427
 428     # For programming facilities
 429     upvar planes_window::widgets widgets
 430     upvar planes_window::axis_index       axis_index
 431     upvar planes_window::first_point_quant first_point_quant
 432     upvar planes_window::last_point_quant last_point_quant
 433     upvar planes_window::first_quant       first_quant
 434     upvar planes_window::local_id  local_id
 435     upvar planes_window::actual_area  actual_area
 436     upvar planes_window::actual_peri  actual_peri
 437     upvar planes_window::actual_darea actual_darea
 438     upvar planes_window::actual_dperi actual_dperi
 439     upvar planes_window::actual_dmax  actual_dmax
 440     upvar planes_window::actual_dmin  actual_dmin
 441     upvar planes_window::actual_davg  actual_davg
 442     upvar planes_window::actual_sten  actual_sten
 443     upvar planes_window::rings_index  rings_index
 444     upvar planes_window::quant_shown  quant_shown
 445     upvar planes_window::real_first_point_quant real_first_point_quant
 446     upvar planes_window::real_last_point_quant real_last_point_quant
 447     upvar planes_window::actual_partial  actual_partial
 448     upvar planes_window::actual_total    actual_total
 449
 450     set real_first_point_quant -1
 451     set real_last_point_quant -1
 452     planes_window::controls 1
 453
 454     catch { renderer_$widgets(work3D) RemoveActor hs_actor_$widgets(work3D) }
 455     catch { hs_actor_$widgets(work3D) Delete }
 456     catch { hs_mapper_$widgets(work3D) Delete }
 457     catch { hs_grid_$widgets(work3D) Delete }
 458     catch { hs_points_$widgets(work3D) Delete }
 459     catch { hs_poly_line_$widgets(work3D) Delete }
 460     foreach i $rings_index {
 461
 462         catch { renderer_$widgets(work3D) RemoveActor cont3DActor_{$widgets(work3D)}_{$i} }
 463         catch { cont3DActor_{$widgets(work3D)}_{$i}    Delete }
 464         catch { cont3DMapper_{$widgets(work3D)}_{$i}   Delete }
 465         catch { cont3DGrid_{$widgets(work3D)}_{$i}     Delete }
 466         catch { cont3DPolyLine_{$widgets(work3D)}_{$i} Delete }
 467         catch { cont3DPoints_{$widgets(work3D)}_{$i}   Delete }
 468
 469     }
 470     set rings_index [ list ]
 471
 472     set actual_area  0.00
 473     set actual_peri  0.00
 474     set actual_darea 0.00
 475     set actual_dperi 0.00
 476     set actual_dmax  0.00
 477     set actual_dmin  0.00
 478     set actual_davg  0.00
 479     set actual_sten  0.00
 480     set quant_shown  0
 481     set global_window::data_loaded [ expr $global_window::data_loaded | $local_id ]
 482
 483     set actual_quant_x     [ list ]
 484     set actual_quant_area  [ list ]
 485     set actual_quant_peri  [ list ]
 486     set actual_quant_darea [ list ]
 487     set actual_quant_dperi [ list ]
 488     set actual_quant_dmax  [ list ]
 489     set actual_quant_dmin  [ list ]
 490     set actual_quant_davg  [ list ]
 491     set actual_quant_sten  [ list ]
 492
 493     planes_window::clean_BLT
 494     catch { $widgets(graph) marker delete line_healthy_slice }
 495
 496     set first_quant 1
 497
 498     # vtk controls
 499     destroy $widgets(work3D)
 500     destroy $widgets(image2D)
 501     vtkTkRenderWidget $widgets(work3D)  -width 30 -height 30
 502     vtkTkRenderWidget $widgets(image2D) -width 30 -height 30
 503
 504     # TODO: change
 505     bindBasicEvents $widgets(work3D)
 506     bindBasicEvents $widgets(image2D)
 507
 508     bind $widgets(work3D) <Double-Button-1> "planes_window::select_axis_point %x %y"
 509     bind $widgets(work3D) <Double-Button-2> "planes_window::set_plane_3D %x %y"
 510     bind $widgets(work3D) <Double-Button-3> "planes_window::set_plane_3D %x %y"
 511
 512     bind $widgets(image2D) <Double-Button-1> "planes_window::extract_contour %x %y 1"
 513     bind $widgets(image2D) <Double-Button-3> "planes_window::add_point_contour_manual %x %y"
 514
 515     catch { renderer_$widgets(work3D) Delete }
 516     catch { renderer_$widgets(image2D) Delete }
 517     vtkRenderer renderer_$widgets(work3D)
 518     vtkRenderer renderer_$widgets(image2D)
 519
 520     set render [ $widgets(work3D) GetRenderWindow ]
 521 #    renderer_$widgets(work3D) SetBackground 0.5 0.5 0.5
 522         renderer_$widgets(work3D) SetBackground 0.75 0.75 0.75
 523 #    renderer_$widgets(work3D) SetBackground 0 0 0
 524     $render AddRenderer renderer_$widgets(work3D)
 525     $render SetSize 1 1
 526
 527     set render [ $widgets(image2D) GetRenderWindow ]
 528 #    renderer_$widgets(image2D) SetBackground 0.5 0.5 0.5
 529     renderer_$widgets(image2D) SetBackground 0 0 0
 530     $render AddRenderer renderer_$widgets(image2D)
 531     $render SetSize 1 1
 532
 533     set range    [ GetImageRange_dll ]
 534     set resample [ GetVTKVolume_dll ]
 535     set bounds   [ $resample GetBounds ]
 536     $widgets(btnSColor) configure -background #faebd6
 537     set r 0.9803
 538     set g 0.9215
 539     set b 0.8392
 540     set actual_total [ change_float_precision [ getAxisLength_dll ] 2 ]
 541     set actual_partial 0.00
 542
 543     catch { renderer_$widgets(work3D) RemoveActor outlineActor_$widgets(work3D) }
 544     catch { renderer_$widgets(work3D) RemoveActor isoActor_$widgets(work3D) }
 545     catch { renderer_$widgets(work3D) RemoveActor edgeActor_$widgets(work3D) }
 546     catch { renderer_$widgets(work3D) RemoveVolume opaqueVol_$widgets(work3D) }
 547     catch { outlineActor_$widgets(work3D)  Delete }
 548     catch { outlineMapper_$widgets(work3D) Delete }
 549     catch { outlineSource_$widgets(work3D) Delete }
 550     catch { opaqueVol_$widgets(work3D)     Delete }
 551     catch { isoCast_$widgets(work3D)       Delete }
 552     catch { isoFunc_$widgets(work3D)       Delete }
 553     catch { opaqueProp_$widgets(work3D)    Delete }
 554     catch { colorFunc_$widgets(work3D)     Delete }
 555     catch { constFunc_$widgets(work3D)     Delete }
 556     catch { edgeActor_$widgets(work3D)     Delete }
 557     catch { edgeMapper_$widgets(work3D)    Delete }
 558     catch { edgePoints_$widgets(work3D)    Delete }
 559     catch { isoActor_$widgets(work3D)      Delete }
 560     catch { isoMapper_$widgets(work3D)     Delete }
 561     catch { cubes_$widgets(work3D)         Delete }
 562     catch { struct_$widgets(work3D)        Delete }
 563
 564     # 3D outline
 565     vtkCubeSource outlineSource_$widgets(work3D)
 566         outlineSource_$widgets(work3D) SetXLength [ expr [ lindex $bounds 1 ] - [ lindex $bounds 0 ] ]
 567         outlineSource_$widgets(work3D) SetYLength [ expr [ lindex $bounds 3 ] - [ lindex $bounds 2 ] ]
 568         outlineSource_$widgets(work3D) SetZLength [ expr [ lindex $bounds 5 ] - [ lindex $bounds 4 ] ]
 569         outlineSource_$widgets(work3D) SetCenter  \
 570             [ expr ( [ lindex $bounds 0 ] + [ lindex $bounds 1 ] ) / 2 ] \
 571             [ expr ( [ lindex $bounds 2 ] + [ lindex $bounds 3 ] ) / 2 ] \
 572             [ expr ( [ lindex $bounds 4 ] + [ lindex $bounds 5 ] ) / 2 ]
 573
 574     vtkPolyDataMapper outlineMapper_$widgets(work3D)
 575         outlineMapper_$widgets(work3D) SetInput [ outlineSource_$widgets(work3D) GetOutput ]
 576         outlineMapper_$widgets(work3D) ImmediateModeRenderingOn
 577
 578     vtkActor outlineActor_$widgets(work3D)
 579         outlineActor_$widgets(work3D) SetMapper outlineMapper_$widgets(work3D)
 580         [ outlineActor_$widgets(work3D) GetProperty ] SetRepresentationToWireframe
 581         [ outlineActor_$widgets(work3D) GetProperty ] SetColor    0.7 0.00 0.9
 582         [ outlineActor_$widgets(work3D) GetProperty ] SetAmbient  1
 583         [ outlineActor_$widgets(work3D) GetProperty ] SetDiffuse  0
 584         [ outlineActor_$widgets(work3D) GetProperty ] SetSpecular 0
 585
 586     # Surface
 587     vtkImageToStructuredPoints struct_$widgets(work3D)
 588         struct_$widgets(work3D) SetInput $resample
 589         struct_$widgets(work3D) Update
 590
 591     vtkMarchingCubes cubes_$widgets(work3D)
 592         cubes_$widgets(work3D) SetInput [ struct_$widgets(work3D) GetOutput ]
 593         cubes_$widgets(work3D) SetValue 0 [ expr [ lindex $range 1 ] / 4 ]
 594
 595     vtkPolyDataMapper isoMapper_$widgets(work3D)
 596         isoMapper_$widgets(work3D) SetInput [ cubes_$widgets(work3D) GetOutput ]
 597         isoMapper_$widgets(work3D) ScalarVisibilityOff
 598         isoMapper_$widgets(work3D) ImmediateModeRenderingOn
 599
 600     vtkActor isoActor_$widgets(work3D)
 601         isoActor_$widgets(work3D) SetMapper isoMapper_$widgets(work3D)
 602         eval [ isoActor_$widgets(work3D) GetProperty ] SetColor $r $g $b
 603         eval [ isoActor_$widgets(work3D) GetProperty ] SetOpacity 0.5
 604
 605     # Edge points
 606     vtkEdgePoints edgePoints_$widgets(work3D)
 607         edgePoints_$widgets(work3D) SetInput $resample
 608         edgePoints_$widgets(work3D) SetValue [ expr [ lindex $range 1 ] / 4 ]
 609
 610     vtkDataSetMapper edgeMapper_$widgets(work3D)
 611         edgeMapper_$widgets(work3D) SetInput [ edgePoints_$widgets(work3D) GetOutput ]
 612         edgeMapper_$widgets(work3D) ScalarVisibilityOff
 613         edgeMapper_$widgets(work3D) ImmediateModeRenderingOn
 614
 615     vtkActor edgeActor_$widgets(work3D)
 616         edgeActor_$widgets(work3D) SetMapper edgeMapper_$widgets(work3D)
 617         eval [ edgeActor_$widgets(work3D) GetProperty ] SetColor $r $g $b
 618
 619     # Opaque
 620     vtkPiecewiseFunction constFunc_$widgets(work3D)
 621         constFunc_$widgets(work3D) AddPoint  0                    1.0
 622         constFunc_$widgets(work3D) AddPoint  [ lindex $range 1 ]  1.0
 623
 624     vtkColorTransferFunction colorFunc_$widgets(work3D)
 625         colorFunc_$widgets(work3D) AddRGBPoint 0.00                 1.0 1.0 1.0
 626         colorFunc_$widgets(work3D) AddRGBPoint [ lindex $range 1 ] 1.0 1.0 1.0
 627
 628     vtkVolumeProperty opaqueProp_$widgets(work3D)
 629         opaqueProp_$widgets(work3D) SetColor colorFunc_$widgets(work3D)
 630         opaqueProp_$widgets(work3D) SetScalarOpacity constFunc_$widgets(work3D)
 631         opaqueProp_$widgets(work3D) ShadeOn
 632         opaqueProp_$widgets(work3D) SetInterpolationTypeToLinear
 633
 634     vtkVolumeRayCastIsosurfaceFunction isoFunc_$widgets(work3D)
 635         isoFunc_$widgets(work3D) SetIsoValue [ expr [ lindex $range 1 ] / 4 ]
 636
 637     vtkVolumeRayCastMapper isoCast_$widgets(work3D)
 638         isoCast_$widgets(work3D) SetInput $resample
 639         isoCast_$widgets(work3D) SetVolumeRayCastFunction isoFunc_$widgets(work3D)
 640
 641     vtkVolume opaqueVol_$widgets(work3D)
 642         opaqueVol_$widgets(work3D) SetMapper isoCast_$widgets(work3D)
 643         opaqueVol_$widgets(work3D) SetProperty opaqueProp_$widgets(work3D)
 644
 645     # Axis
 646     set points [ getAxis_dll ]
 647     set nP [ expr [ llength $points ] / 3 ]
 648
 649     # Poly-line actor construction...
 650     catch { renderer_$widgets(work3D) RemoveActor axisActor_$widgets(work3D) }
 651     catch { axisActor_$widgets(work3D)    Delete }
 652     catch { axisMapper_$widgets(work3D)   Delete }
 653     catch { axisGrid_$widgets(work3D)     Delete }
 654     catch { axisPolyLine_$widgets(work3D) Delete }
 655     catch { axisPoints_$widgets(work3D)   Delete }
 656
 657     vtkPoints axisPoints_$widgets(work3D)
 658     vtkPolyLine axisPolyLine_$widgets(work3D)
 659     [ axisPolyLine_$widgets(work3D) GetPointIds ] SetNumberOfIds $nP
 660     set vox_size [ getActualVoxelSize_dll ]
 661     for { set i 0 } { $i < $nP } { incr i } {
 662
 663         [ axisPolyLine_$widgets(work3D) GetPointIds ] SetId $i $i
 664         set p [ \
 665             PointCoord \
 666             [ lindex $points [ expr $i * 3 + 0 ] ] \
 667             [ lindex $points [ expr $i * 3 + 1 ] ] \
 668             [ lindex $points [ expr $i * 3 + 2 ] ] \
 669             [ lindex $bounds 0 ] \
 670             [ lindex $bounds 2 ] \
 671             [ lindex $bounds 4 ] \
 672             $vox_size $vox_size $vox_size \
 673         ]
 674         axisPoints_$widgets(work3D) InsertNextPoint [ lindex $p 0 ] [ lindex $p 1 ] [ lindex $p 2 ]
 675
 676     }
 677
 678     vtkUnstructuredGrid axisGrid_$widgets(work3D)
 679         axisGrid_$widgets(work3D) Allocate 1 1
 680         axisGrid_$widgets(work3D) InsertNextCell \
 681             [ axisPolyLine_$widgets(work3D) GetCellType ] \
 682             [ axisPolyLine_$widgets(work3D) GetPointIds ]
 683             axisGrid_$widgets(work3D) SetPoints axisPoints_$widgets(work3D)
 684
 685     vtkDataSetMapper axisMapper_$widgets(work3D)
 686         axisMapper_$widgets(work3D) SetInput axisGrid_$widgets(work3D)
 687         axisMapper_$widgets(work3D) ImmediateModeRenderingOn
 688
 689     vtkActor axisActor_$widgets(work3D)
 690         axisActor_$widgets(work3D) SetMapper axisMapper_$widgets(work3D)
 691         [ axisActor_$widgets(work3D) GetProperty] BackfaceCullingOn
 692         [ axisActor_$widgets(work3D) GetProperty] SetDiffuseColor 1 0 0
 693 #        [ axisActor_$widgets(work3D) GetProperty] SetLineWidth 3
 694
 695     renderer_$widgets(work3D) AddActor axisActor_$widgets(work3D)
 696
 697     [ $widgets(work3D) GetRenderWindow ] Render
 698     [ $widgets(image2D) GetRenderWindow ] Render
 699
 700     $widgets(sclIsoVal) configure \
 701         -from [ lindex $range 0 ] \
 702         -to   [ lindex $range 1 ] \
 703         -resolution 1.0
 704
 705     $widgets(sclOpacity) configure \
 706         -from 0.00 \
 707         -to   1.0 \
 708         -resolution 0.001
 709
 710     bind $widgets(sclIsoVal) <Any-ButtonRelease>
 711     bind $widgets(sclIsoVal) <Any-ButtonRelease> "planes_window::change_intensity 0"
 712
 713     bind $widgets(sclOpacity) <Any-ButtonRelease>
 714     bind $widgets(sclOpacity) <Any-ButtonRelease> "planes_window::change_opacity 0"
 715
 716     if { [ u_surf::get_isoval ] != 0 } {
 717
 718         planes_window::change_intensity 1 [ u_surf::get_isoval ]
 719
 720     } else {
 721
 722         planes_window::change_intensity 1 [ expr ( [ $widgets(sclIsoVal) cget -to ] + ( [ $widgets(sclIsoVal) cget -from ] * 3 ) ) / 4 ]
 723
 724     }
 725     planes_window::change_opacity 1
 726
 727     $widgets(btnPerpendicular) select
 728     $widgets(btnPerpendicular) invoke
 729
 730     $widgets(btnOpaque)      deselect
 731     $widgets(btnTransparent) deselect
 732     $widgets(btnEdge)        deselect
 733     $widgets(btnTransparent) invoke
 734
 735     $widgets(sclSlice) configure \
 736         -from 0 \
 737         -to   [ expr [ getNumberOfAxisPoints_dll ] - 1 ] \
 738         -resolution 1
 739
 740     set first_point_quant 0
 741     set last_point_quant [ expr [ getNumberOfAxisPoints_dll ] - 1 ]
 742
 743     bind $widgets(sclSlice) <Any-ButtonRelease>
 744     $widgets(sclSlice) set [ expr [ getNumberOfAxisPoints_dll ] / 2 ]
 745     planes_window::prepare_planes
 746     planes_window::set_plane
 747     bind $widgets(sclSlice) <Any-ButtonRelease> "planes_window::set_plane"
 748
 749     $widgets(btnGreyScale) deselect
 750     $widgets(btnColor)     deselect
 751     $widgets(btnGreyScale) invoke
 752
 753     $widgets(btnSHealthySlice) deselect
 754     $widgets(btnSHealthySlice) invoke
 755
 756     $widgets(btnShowS) deselect
 757     $widgets(btnShowS) invoke
 758
 759     $widgets(btnRings) select
 760     $widgets(btnRings) invoke
 761
 762     [ $widgets(work3D) GetRenderWindow ] Render
 763     [ $widgets(image2D) GetRenderWindow ] Render
 764
 765     planes_window::controls 0
 766     global_window::deselect_buttons
 767     global_window::invoke_buttons [ expr \
 768         $global_window::en_clear  | \
 769         $global_window::en_rotate | \
 770         $global_window::en_zoom     \
 771     ]
 772
 773     renderer_$widgets(work3D) AddActor outlineActor_$widgets(work3D)
 774     [ $widgets(work3D) GetRenderWindow ] Render
 775     [ $widgets(image2D) GetRenderWindow ] Render
 776
 777     $widgets(btnContour) configure \
 778         -command "planes_window::extract_contour -1 -1"
 779
 780 }
 781
 782 proc planes_window::set_IsoActor { typ } {
 783
 784     # For programming facilities
 785     upvar planes_window::widgets widgets
 786     upvar planes_window::actual_actor     actual_actor
 787
 788     catch { renderer_$widgets(work3D) RemoveActor isoActor_$widgets(work3D) }
 789     catch { renderer_$widgets(work3D) RemoveActor edgeActor_$widgets(work3D) }
 790     catch { renderer_$widgets(work3D) RemoveVolume opaqueVol_$widgets(work3D) }
 791
 792     if { $typ != 4 } { set actual_actor $typ }
 793
 794     if { $typ == 1 } {
 795
 796         renderer_$widgets(work3D) AddVolume opaqueVol_$widgets(work3D)
 797         $widgets(btnShowS) select
 798
 799     } elseif { $typ == 2 } {
 800
 801         renderer_$widgets(work3D) AddActor isoActor_$widgets(work3D)
 802         $widgets(btnShowS) select
 803
 804     } elseif { $typ == 3 } {
 805
 806         renderer_$widgets(work3D) AddActor edgeActor_$widgets(work3D)
 807         $widgets(btnShowS) select
 808
 809     }
 810     [ $widgets(work3D) GetRenderWindow ] Render
 811     [ $widgets(image2D) GetRenderWindow ] Render
 812
 813 }
 814
 815 proc planes_window::change_color { } {
 816
 817     # For programming facilities
 818     upvar planes_window::widgets widgets
 819     upvar planes_window::actual_actor     actual_actor
 820
 821     set col [ $widgets(btnSColor) cget -background ]
 822     set col [ \
 823         tk_chooseColor \
 824             -initialcolor $col \
 825             -parent $widgets(btnColor) \
 826             -title "Choose a color..."
 827     ]
 828     if { $col != "" } {
 829
 830         $widgets(btnSColor) configure -background $col
 831         set r [ expr "0x[ string index $col 1 ][ string index $col 2 ]" / 255.0 ]
 832         set g [ expr "0x[ string index $col 3 ][ string index $col 4 ]" / 255.0 ]
 833         set b [ expr "0x[ string index $col 5 ][ string index $col 6 ]" / 255.0 ]
 834         [ isoActor_$widgets(work3D) GetProperty ] SetColor $r $g $b
 835         [ edgeActor_$widgets(work3D) GetProperty ] SetColor $r $g $b
 836
 837         [ $widgets(work3D) GetRenderWindow ] Render
 838         [ $widgets(image2D) GetRenderWindow ] Render
 839
 840     }
 841
 842 }
 843
 844 proc planes_window::change_intensity { typ { isoval 0 } } {
 845
 846     # For programming facilities
 847     upvar planes_window::widgets widgets
 848
 849     if { $typ == 1 } {
 850
 851         set slc $isoval
 852         $widgets(sclIsoVal) set $slc
 853
 854     } else { set slc [ $widgets(sclIsoVal) get ] }
 855
 856     cubes_$widgets(work3D) SetValue 0 $slc
 857     edgePoints_$widgets(work3D) SetValue $slc
 858     [ $widgets(work3D) GetRenderWindow ] Render
 859     [ $widgets(image2D) GetRenderWindow ] Render
 860
 861
 862 }
 863
 864 proc planes_window::change_opacity { typ } {
 865
 866     # For programming facilities
 867     upvar planes_window::widgets widgets
 868
 869     if { $typ == 1 } {
 870
 871         set slc [ expr ( [ $widgets(sclOpacity) cget -to ] + [ $widgets(sclOpacity) cget -from ] ) / 2 ]
 872         $widgets(sclOpacity) set $slc
 873
 874     } else { set slc [ $widgets(sclOpacity) get ] }
 875
 876     [ isoActor_$widgets(work3D) GetProperty ] SetOpacity $slc
 877     [ edgeActor_$widgets(work3D) GetProperty ] SetOpacity $slc
 878     [ $widgets(work3D) GetRenderWindow ] Render
 879     [ $widgets(image2D) GetRenderWindow ] Render
 880
 881
 882 }
 883
 884 proc planes_window::prepare_planes { } {
 885
 886     # For programming facilities
 887     upvar planes_window::widgets widgets
 888     upvar planes_window::axis_index axis_index
 889
 890     catch { renderer_$widgets(image2D) RemoveActor plane_actor_2D_$widgets(image2D) }
 891     catch { renderer_$widgets(work3D) RemoveActor plane_actor_3D_$widgets(work3D) }
 892     catch { plane_actor_2D_$widgets(image2D) Delete }
 893     catch { mapper_2D_$widgets(image2D) Delete }
 894     catch { collookup_$widgets(work3D) Delete }
 895     catch { bwlookup_$widgets(work3D) Delete }
 896     catch { plane_actor_3D_$widgets(work3D) Delete }
 897     catch { mapper_3D_$widgets(work3D) Delete }
 898
 899     set range    [ getIntensityRange_dll ]
 900
 901     vtkWindowLevelLookupTable bwlookup_$widgets(work3D)
 902         bwlookup_$widgets(work3D) SetHueRange 0.00 1.0
 903         bwlookup_$widgets(work3D) SetNumberOfColors [ lindex [ split [ expr [ lindex $range 1 ] - [ lindex $range 0 ] + 1 ] . ] 0 ]
 904         bwlookup_$widgets(work3D) SetTableRange [ lindex $range 0 ] [ lindex $range 1 ]
 905         bwlookup_$widgets(work3D) SetSaturationRange 0 0
 906         bwlookup_$widgets(work3D) SetValueRange 0 1
 907         bwlookup_$widgets(work3D) SetAlphaRange 1 1
 908         bwlookup_$widgets(work3D) Build
 909
 910     vtkLookupTable collookup_$widgets(work3D)
 911         collookup_$widgets(work3D) SetNumberOfColors 256
 912         collookup_$widgets(work3D) SetTableRange 0 255
 913         collookup_$widgets(work3D) Build
 914         collookup_$widgets(work3D) SetTableValue 0    1 0 0 1
 915         collookup_$widgets(work3D) SetTableValue 128  0 0 1 1
 916         collookup_$widgets(work3D) SetTableValue 255  0 1 0 1
 917
 918     vtkDataSetMapper mapper_2D_$widgets(image2D)
 919         mapper_2D_$widgets(image2D) SetInput [ getVTKPoints_dll ]
 920         mapper_2D_$widgets(image2D) SetLookupTable bwlookup_$widgets(work3D)
 921         eval mapper_2D_$widgets(image2D) SetScalarRange [ lindex $range 0 ] [ lindex $range 1 ]
 922         mapper_2D_$widgets(image2D) ImmediateModeRenderingOn
 923
 924     vtkActor plane_actor_2D_$widgets(image2D)
 925        plane_actor_2D_$widgets(image2D) SetMapper mapper_2D_$widgets(image2D)
 926
 927     renderer_$widgets(image2D) AddActor plane_actor_2D_$widgets(image2D)
 928
 929     [ renderer_$widgets(image2D) GetActiveCamera ] SetPosition   [ expr [ getCutSize_dll ] / 2 ] [ expr [ getCutSize_dll ] / 2 ] [ expr round( [ getCutSize_dll ] * 1.8 ) ]
 930     [ renderer_$widgets(image2D) GetActiveCamera ] SetFocalPoint [ expr [ getCutSize_dll ] / 2 ] [ expr [ getCutSize_dll ] / 2 ] 0
 931
 932     # 3D actor
 933     vtkDataSetMapper mapper_3D_$widgets(work3D)
 934         mapper_3D_$widgets(work3D) SetInput [ [ getVTKProbe_dll ] GetOutput ]
 935         mapper_3D_$widgets(work3D) SetLookupTable bwlookup_$widgets(work3D)
 936         eval mapper_3D_$widgets(work3D) SetScalarRange $range
 937         mapper_3D_$widgets(work3D) ImmediateModeRenderingOn
 938
 939     vtkActor plane_actor_3D_$widgets(work3D)
 940         plane_actor_3D_$widgets(work3D) SetMapper mapper_3D_$widgets(work3D)
 941
 942     [ $widgets(work3D) GetRenderWindow ] Render
 943     [ $widgets(image2D) GetRenderWindow ] Render
 944
 945 }
 946
 947 proc planes_window::set_plane { } {
 948
 949     # For programming facilities
 950     upvar planes_window::widgets widgets
 951     upvar planes_window::axis_index axis_index
 952     upvar planes_window::actual_area  actual_area
 953     upvar planes_window::actual_peri  actual_peri
 954     upvar planes_window::actual_darea actual_darea
 955     upvar planes_window::actual_dperi actual_dperi
 956     upvar planes_window::actual_dmax  actual_dmax
 957     upvar planes_window::actual_dmin  actual_dmin
 958     upvar planes_window::actual_davg  actual_davg
 959     upvar planes_window::actual_sten  actual_sten
 960     upvar planes_window::actual_quant_x actual_quant_x
 961     upvar planes_window::actual_quant_sten actual_quant_sten
 962     upvar planes_window::real_first_point_quant real_first_point_quant
 963     upvar planes_window::real_last_point_quant real_last_point_quant
 964
 965     set slice [ $widgets(sclSlice) get ]
 966
 967     planes_window::clean_contour
 968     changeSliceAxis_dll $slice
 969     set p [ getAxisPoint_dll $slice ]
 970     set resample [ getVTKSource_dll ]
 971     set bounds   [ $resample GetBounds ]
 972     catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_cell_int_$widgets(work3D) ] }
 973     DeleteSphere sphere_cell_int_$widgets(work3D)
 974     set act [ \
 975         DrawSphere \
 976             sphere_cell_int_$widgets(work3D) \
 977             [ expr [ getCellIntensitySize_dll ] / 2.0 ] \
 978             [ expr [ lindex $p 0 ] + [ lindex $bounds 0 ] ] \
 979             [ expr [ lindex $p 1 ] + [ lindex $bounds 2 ] ] \
 980             [ expr [ lindex $p 2 ] + [ lindex $bounds 4 ] ] \
 981             0.0 0.0 1.0 \
 982     ]
 983     [ $act GetProperty ] SetOpacity 0.2
 984     renderer_$widgets(work3D) AddActor $act
 985
 986     [ $widgets(work3D) GetRenderWindow ] Render
 987     [ $widgets(image2D) GetRenderWindow ] Render
 988
 989     catch { $widgets(graph) marker delete line_select }
 990     $widgets(graph) marker create line -coords { $slice -Inf $slice Inf } -dashes dash -linewidth 1 -outline red -name line_select
 991
 992     set quant_data [ getValues_dll $slice ]
 993     set actual_area  [ change_float_precision [ lindex $quant_data 0 ] 2 ]
 994     set actual_peri  [ change_float_precision [ lindex $quant_data 1 ] 2 ]
 995     set actual_darea [ change_float_precision [ lindex $quant_data 2 ] 2 ]
 996     set actual_dperi [ change_float_precision [ lindex $quant_data 3 ] 2 ]
 997     set actual_dmax  [ change_float_precision [ lindex $quant_data 4 ] 2 ]
 998     set actual_dmin  [ change_float_precision [ lindex $quant_data 5 ] 2 ]
 999     set actual_davg  [ change_float_precision [ lindex $quant_data 6 ] 2 ]
1000
1001     if { [ llength $actual_quant_sten ] > 0 } {
1002
1003         set actual_sten [ change_float_precision [ lindex $actual_quant_sten [ expr $slice - [ lindex $actual_quant_x 0 ] ] ] 2 ]
1004
1005     }
1006
1007 }
1008
1009 proc planes_window::extract_contour { x y { transformy 0 } } {
1010
1011     # For programming facilities
1012     upvar planes_window::widgets widgets
1013     upvar planes_window::axis_index axis_index
1014     upvar planes_window::man_points man_points
1015     upvar planes_window::actual_area  actual_area
1016     upvar planes_window::actual_peri  actual_peri
1017     upvar planes_window::actual_darea actual_darea
1018     upvar planes_window::actual_dperi actual_dperi
1019     upvar planes_window::actual_dmax  actual_dmax
1020     upvar planes_window::actual_dmin  actual_dmin
1021     upvar planes_window::actual_davg  actual_davg
1022     upvar planes_window::actual_sten  actual_sten
1023     upvar planes_window::actual_quant_x     actual_quant_x
1024     upvar planes_window::actual_quant_area  actual_quant_area
1025     upvar planes_window::actual_quant_peri  actual_quant_peri
1026     upvar planes_window::actual_quant_darea actual_quant_darea
1027     upvar planes_window::actual_quant_dperi actual_quant_dperi
1028     upvar planes_window::actual_quant_dmax  actual_quant_dmax
1029     upvar planes_window::actual_quant_dmin  actual_quant_dmin
1030     upvar planes_window::actual_quant_davg  actual_quant_davg
1031     upvar planes_window::actual_quant_sten  actual_quant_sten
1032     upvar planes_window::quant_shown        quant_shown
1033     upvar planes_window::quantifing         quantifing
1034     upvar planes_window::first_quant        first_quant
1035     upvar planes_window::real_first_point_quant real_first_point_quant
1036     upvar planes_window::real_last_point_quant real_last_point_quant
1037
1038     set index [ $widgets(sclSlice) get ]
1039     planes_window::clean_contour
1040
1041     if { [ llength $man_points ] > 0 } {
1042
1043         setContour_dll $man_points
1044         for { set i 1 } { $i <= [ llength $man_points ] } { incr i } {
1045
1046             catch { renderer_$widgets(image2D) RemoveActor [ GetSphereActorName man_point_$i ] }
1047             DeleteSphere man_point_$i
1048
1049         }
1050         set man_points [ list ]
1051
1052     } else {
1053
1054         set params [ getContourParams_dll ]
1055         if { $transformy == 1 } {
1056
1057             set y [ expr [ lindex [ $widgets(image2D) configure -height ] 4 ] - $y - 1 ]
1058             catch { tmp_picker_$widgets(image2D) Delete }
1059             vtkWorldPointPicker tmp_picker_$widgets(image2D)
1060                 set pickWP    [ tmp_picker_$widgets(image2D) Pick $x $y 0 renderer_$widgets(image2D) ]
1061                 set pickWPPos [ tmp_picker_$widgets(image2D) GetPickPosition ]
1062
1063             set x [ lindex $pickWPPos 0 ]
1064             set y [ lindex $pickWPPos 1 ]
1065
1066         }
1067         if { $x == -1 } { set rx [ expr [ getCutSize_dll ] / 2 ] } else { set rx $x }
1068         if { $y == -1 } { set ry [ expr [ getCutSize_dll ] / 2 ] } else { set ry $y }
1069         planes_window::generate_isocontour $rx $ry [ lindex $params 5 ] [ lindex $params 6 ]
1070         if { $x != -1 } { set x [ expr round( $x ) ] }
1071         if { $y != -1 } { set y [ expr round( [ getCutSize_dll ] - $y - 1 ) ] }
1072         extractContour_dll $x $y isoStrips_$widgets(work3D)
1073
1074     }
1075
1076   catch { triangles_tmp Delete }
1077   catch { mesures_tmp Delete }
1078
1079     # triangulate the polygons
1080 #    vtkTriangleFilter triangles_tmp
1081 #        triangles_tmp SetInput [ isoStrips_$widgets(work3D) GetOutput ]
1082 #        triangles_tmp PassLinesOn
1083 #        triangles_tmp PassVertsOn
1084 #
1085 #    vtkMassProperties mesures_tmp
1086 #        mesures_tmp SetInput [triangles_tmp GetOutput]
1087 #        mesures_tmp Update
1088 #        set monarea [ mesures_tmp GetSurfaceArea ]
1089 #    puts $monarea
1090
1091     # Some contours had been calculated, so it's possible that
1092     # the user wants to keep them.
1093     set first_quant 0
1094
1095     set points [ getContourPoints_dll ]
1096     set taille [ expr [ llength $points ] / 2 ]
1097
1098     vtkPolygon aPolygon_$widgets(image2D)
1099     vtkPoints PointsContour_$widgets(image2D)
1100
1101     vtkPolyLine aPolyLine_$widgets(image2D)
1102         set PointIds [ aPolyLine_$widgets(image2D) GetPointIds ]
1103         $PointIds SetNumberOfIds $taille
1104         set PointIdsPolygon [ aPolygon_$widgets(image2D) GetPointIds ]
1105         $PointIdsPolygon SetNumberOfIds $taille
1106     for { set i 0 } { $i< $taille } { incr i } {
1107       $PointIds SetId $i $i
1108       $PointIdsPolygon SetId $i $i
1109       PointsContour_$widgets(image2D) InsertNextPoint [ lindex $points [ expr ( $i * 2 ) + 0 ] ] [ lindex $points [ expr ( $i * 2 ) + 1 ] ] 0
1110     }
1111
1112     vtkUnstructuredGrid aPolyLineGrid_$widgets(image2D)
1113         aPolyLineGrid_$widgets(image2D) Allocate 1 1
1114         set param1 [ aPolyLine_$widgets(image2D) GetCellType]
1115         set param2 [ aPolyLine_$widgets(image2D) GetPointIds]
1116         aPolyLineGrid_$widgets(image2D) InsertNextCell $param1 $param2
1117         aPolyLineGrid_$widgets(image2D) SetPoints PointsContour_$widgets(image2D)
1118
1119     vtkDataSetMapper aPolyLineMapper_$widgets(image2D)
1120         aPolyLineMapper_$widgets(image2D)    SetInput aPolyLineGrid_$widgets(image2D)
1121
1122     vtkActor aPolyLineActor_$widgets(image2D)
1123         aPolyLineActor_$widgets(image2D) SetMapper aPolyLineMapper_$widgets(image2D)
1124         set Property1 [aPolyLineActor_$widgets(image2D) GetProperty]
1125         $Property1 SetColor 0 1 0
1126         $Property1 SetLineWidth 2
1127         $Property1 SetPointSize 2
1128         $Property1 BackfaceCullingOff
1129
1130     renderer_$widgets(image2D) AddActor aPolyLineActor_$widgets(image2D)
1131
1132     vtkUnstructuredGrid aPolygonGrid_$widgets(image2D)
1133         aPolygonGrid_$widgets(image2D) Allocate 1 1
1134         set param1 [ aPolygon_$widgets(image2D) GetCellType ]
1135         set param2 [ aPolygon_$widgets(image2D) GetPointIds ]
1136         aPolygonGrid_$widgets(image2D) InsertNextCell $param1 $param2
1137         aPolygonGrid_$widgets(image2D) SetPoints PointsContour_$widgets(image2D)
1138
1139     vtkDataSetMapper aPolygonMapper_$widgets(image2D)
1140         aPolygonMapper_$widgets(image2D)  SetInput aPolygonGrid_$widgets(image2D)
1141
1142     vtkActor aPolygonActor_$widgets(image2D)
1143         aPolygonActor_$widgets(image2D) SetMapper aPolygonMapper_$widgets(image2D)
1144         set Property1 [ aPolygonActor_$widgets(image2D) GetProperty ]
1145         $Property1 SetColor 0 1 0
1146         $Property1 SetLineWidth 2
1147         $Property1 SetPointSize 2
1148         $Property1 BackfaceCullingOff
1149
1150     array set arr [ params_dll 0 ]
1151     if { $arr(e_debug_fill_area) == 1 } { renderer_$widgets(image2D) AddActor aPolygonActor_$widgets(image2D) }
1152
1153     planes_window::show_max_min_diameters
1154
1155     [ $widgets(image2D) GetRenderWindow ] Render
1156
1157     planes_window::draw3D_contour $index
1158
1159     set quant_data [ getValues_dll $index ]
1160     set actual_area  [ change_float_precision [ lindex $quant_data 0 ] 2 ]
1161     set actual_peri  [ change_float_precision [ lindex $quant_data 1 ] 2 ]
1162     set actual_darea [ change_float_precision [ lindex $quant_data 2 ] 2 ]
1163     set actual_dperi [ change_float_precision [ lindex $quant_data 3 ] 2 ]
1164     set actual_dmax  [ change_float_precision [ lindex $quant_data 4 ] 2 ]
1165     set actual_dmin  [ change_float_precision [ lindex $quant_data 5 ] 2 ]
1166     set actual_davg  [ change_float_precision [ lindex $quant_data 6 ] 2 ]
1167     set i [ lsearch -exact $actual_quant_x $index ]
1168     if { $i != -1 } {
1169
1170         set actual_quant_area  [ lreplace $actual_quant_area  $i $i $actual_area ]
1171         set actual_quant_peri  [ lreplace $actual_quant_peri  $i $i $actual_peri ]
1172         set actual_quant_darea [ lreplace $actual_quant_darea $i $i $actual_darea ]
1173         set actual_quant_dperi [ lreplace $actual_quant_dperi $i $i $actual_dperi ]
1174         set actual_quant_dmax  [ lreplace $actual_quant_dmax  $i $i $actual_dmax ]
1175         set actual_quant_dmin  [ lreplace $actual_quant_dmin  $i $i $actual_dmin ]
1176         set actual_quant_davg  [ lreplace $actual_quant_davg  $i $i $actual_davg ]
1177         if { [ llength $actual_quant_sten ] > 0 } {
1178
1179             set actual_quant_sten [ getStenosisQuant_dll ]
1180             set actual_sten [ change_float_precision [ lindex $actual_quant_sten [ expr $index - $real_first_point_quant ] ] 2 ]
1181
1182         }
1183
1184     }
1185     planes_window::update_blt_all_meassures
1186
1187 }
1188
1189 proc planes_window::clean_contour { } {
1190
1191     # For programming facilities
1192     upvar planes_window::widgets widgets
1193
1194     catch { renderer_$widgets(image2D) RemoveActor actor_debug2_work3D }
1195     catch { renderer_$widgets(image2D) RemoveActor actor_debug1_work3D }
1196     catch { actor_debug2_work3D Delete }
1197     catch { connMapper_$widgets(work3D) Delete }
1198     catch { isoStrips_$widgets(work3D) Delete }
1199     catch { cpd2_$widgets(work3D) Delete }
1200     catch { conn_$widgets(work3D) Delete }
1201     catch { cpd_$widgets(work3D) Delete }
1202     catch { actor_debug1_work3D Delete }
1203     catch { cntVTKMapper_$widgets(work3D) Delete }
1204     catch { cntVTK_$widgets(work3D) Delete }
1205     catch { renderer_$widgets(image2D) RemoveActor aPolyLineActor_$widgets(image2D) }
1206     catch { renderer_$widgets(image2D) RemoveActor aPolygonActor_$widgets(image2D) }
1207     catch { aPolyLineActor_$widgets(image2D) Delete }
1208     catch { aPolyLineMapper_$widgets(image2D) Delete }
1209     catch { aPolyLineGrid_$widgets(image2D) Delete }
1210     catch { aPolyLine_$widgets(image2D) Delete }
1211     catch { PointsContour_$widgets(image2D) Delete }
1212     catch { aPolygonActor_$widgets(image2D) Delete }
1213     catch { aPolygonMapper_$widgets(image2D) Delete }
1214     catch { aPolygonGrid_$widgets(image2D) Delete }
1215     catch { aPolygon_$widgets(image2D) Delete }
1216     catch { renderer_$widgets(image2D) RemoveActor dMax_actor_$widgets(image2D) }
1217     catch { renderer_$widgets(image2D) RemoveActor dMin_actor_$widgets(image2D) }
1218     catch { dMax_actor_$widgets(image2D)   Delete }
1219     catch { dMax_mapper_$widgets(image2D) Delete }
1220     catch { dMax_line_$widgets(image2D)   Delete }
1221     catch { dMin_actor_$widgets(image2D)   Delete }
1222     catch { dMin_mapper_$widgets(image2D) Delete }
1223     catch { dMin_line_$widgets(image2D)   Delete }
1224
1225     [ $widgets(work3D) GetRenderWindow ] Render
1226     [ $widgets(image2D) GetRenderWindow ] Render
1227
1228 }
1229
1230 proc planes_window::show_hs_3D { var_healthy } {
1231
1232     # For programming facilities
1233     upvar planes_window::widgets widgets
1234     upvar planes_window::actor_debug1 actor_debug1
1235     upvar planes_window::actor_debug2 actor_debug2
1236     upvar planes_window::show_hs_var show_hs_var
1237
1238     set show_hs_var $var_healthy
1239     if { $var_healthy == 1 } {
1240     catch { renderer_$widgets(work3D) AddActor hs_actor_$widgets(work3D) }
1241     } else {
1242     catch { renderer_$widgets(work3D) RemoveActor hs_actor_$widgets(work3D) }
1243     }
1244     [ $widgets(work3D) GetRenderWindow ] Render
1245
1246 }
1247
1248 proc planes_window::put_plane_3D { var_perp } {
1249
1250     # For programming facilities
1251     upvar planes_window::widgets widgets
1252     upvar planes_window::actor_debug1 actor_debug1
1253     upvar planes_window::actor_debug2 actor_debug2
1254
1255     if { $var_perp == 1 } {
1256     catch { renderer_$widgets(work3D) AddActor plane_actor_3D_$widgets(work3D) }
1257     } else {
1258     catch { renderer_$widgets(work3D) RemoveActor plane_actor_3D_$widgets(work3D) }
1259     }
1260     [ $widgets(work3D) GetRenderWindow ] Render
1261
1262 }
1263
1264 proc planes_window::set_color_table { typ } {
1265
1266     # For programming facilities
1267     upvar planes_window::widgets widgets
1268     upvar planes_window::actor_debug1 actor_debug1
1269     upvar planes_window::actor_debug2 actor_debug2
1270
1271     if { $typ == 1 } {
1272
1273         mapper_3D_$widgets(work3D) SetLookupTable bwlookup_$widgets(work3D)
1274
1275     } else {
1276
1277         mapper_3D_$widgets(work3D) SetLookupTable collookup_$widgets(work3D)
1278
1279     }
1280     [ $widgets(work3D) GetRenderWindow ] Render
1281
1282 }
1283
1284 proc planes_window::generate_isocontour { x y vmin vmax } {
1285
1286     # For programming facilities
1287     upvar planes_window::widgets widgets
1288
1289     catch { renderer_$widgets(image2D) RemoveActor actor_debug2_work3D }
1290     catch { renderer_$widgets(image2D) RemoveActor actor_debug1_work3D }
1291     catch { actor_debug2_work3D Delete }
1292     catch { connMapper_$widgets(work3D) Delete }
1293     catch { isoStrips_$widgets(work3D) Delete }
1294     catch { cpd2_$widgets(work3D) Delete }
1295     catch { conn_$widgets(work3D) Delete }
1296     catch { cpd_$widgets(work3D) Delete }
1297     catch { actor_debug1_work3D Delete }
1298     catch { cntVTKMapper_$widgets(work3D) Delete }
1299     catch { cntVTK_$widgets(work3D) Delete }
1300     catch { renderer_$widgets(image2D) RemoveActor [ GetSphereActorName tmp_gc_point ] }
1301     DeleteSphere tmp_gc_point
1302
1303     renderer_$widgets(image2D) AddActor [ \
1304         DrawSphere tmp_gc_point 0.1 \
1305         $x $y 0 \
1306         1.00 0.0 0.00
1307     ]
1308
1309     set spoints [ getVTKPoints_dll ]
1310     vtkKitwareContourFilter cntVTK_$widgets(work3D)
1311         cntVTK_$widgets(work3D) SetInput $spoints
1312         cntVTK_$widgets(work3D) SetNumberOfContours 1
1313         cntVTK_$widgets(work3D) SetValue 0 $vmin
1314         #cntVTK_$widgets(work3D) SetValue 1 $vmax
1315
1316     vtkPolyDataMapper cntVTKMapper_$widgets(work3D)
1317         cntVTKMapper_$widgets(work3D) SetInput [ cntVTK_$widgets(work3D) GetOutput ]
1318         cntVTKMapper_$widgets(work3D) ScalarVisibilityOff
1319
1320     vtkActor actor_debug1_work3D
1321         actor_debug1_work3D SetMapper cntVTKMapper_$widgets(work3D)
1322         [ actor_debug1_work3D GetProperty ] SetColor 1 0 0
1323
1324     vtkCleanPolyData cpd_$widgets(work3D)
1325         cpd_$widgets(work3D) SetInput [ cntVTK_$widgets(work3D) GetOutput ]
1326
1327     vtkPolyDataConnectivityFilter conn_$widgets(work3D)
1328         conn_$widgets(work3D) SetInput [ cpd_$widgets(work3D) GetOutput ]
1329         conn_$widgets(work3D) SetExtractionModeToClosestPointRegion
1330         conn_$widgets(work3D) SetClosestPoint $x $y 0
1331         conn_$widgets(work3D) Update
1332
1333     vtkCleanPolyData cpd2_$widgets(work3D)
1334         cpd2_$widgets(work3D) SetInput [ conn_$widgets(work3D) GetOutput ]
1335
1336     vtkStripper isoStrips_$widgets(work3D)
1337         isoStrips_$widgets(work3D) SetInput [ cpd2_$widgets(work3D) GetOutput ]
1338         isoStrips_$widgets(work3D) Update
1339
1340     vtkPolyDataMapper connMapper_$widgets(work3D)
1341         connMapper_$widgets(work3D) SetInput [ isoStrips_$widgets(work3D) GetOutput ]
1342         connMapper_$widgets(work3D) ScalarVisibilityOff
1343
1344     vtkActor actor_debug2_work3D
1345         actor_debug2_work3D SetMapper connMapper_$widgets(work3D)
1346         [ actor_debug2_work3D GetProperty ] SetColor 0 0 1
1347
1348     array set arr [ params_dll 0 ]
1349
1350     if { $arr(e_debug_isocontour) == 1 } {
1351
1352         renderer_$widgets(image2D) AddActor actor_debug1_work3D
1353         renderer_$widgets(image2D) AddActor actor_debug2_work3D
1354
1355     }
1356     [ $widgets(image2D) GetRenderWindow ] Render
1357
1358 }
1359
1360 proc planes_window::select_axis_point { x y { real -1 } } {
1361
1362     # For programming facilities
1363     upvar planes_window::widgets widgets
1364     upvar planes_window::axis_index axis_index
1365     upvar planes_window::nClicks nClicks
1366     upvar planes_window::first_point_quant first_point_quant
1367     upvar planes_window::last_point_quant last_point_quant
1368     upvar planes_window::actual_partial actual_partial
1369     upvar planes_window::given_points  given_points
1370
1371     set nClicks [ expr ( $nClicks % 2 ) + 1 ]
1372
1373     if { $real == -1 } {
1374
1375         renderer_$widgets(work3D) IsInViewport 0 0
1376         catch { tmp_world_picker_$widgets(work3D) Delete }
1377         set y [ expr [ lindex [ $widgets(work3D) configure -height ] 4 ] - $y - 1 ]
1378                 [ $widgets(work3D) GetRenderWindow ] Render
1379         set pickWPPos [ pick_point_local_actor $x $y renderer_$widgets(work3D) axisActor_$widgets(work3D) 0.001 ]
1380         set xc [ lindex $pickWPPos 0 ]
1381         set yc [ lindex $pickWPPos 1 ]
1382         set zc [ lindex $pickWPPos 2 ]
1383
1384         #Chercher le point de l'axe le plus proche au point choisi
1385         set indP [axisGrid_$widgets(work3D) FindPoint $xc $yc $zc]
1386         set coordsP [axisGrid_$widgets(work3D) GetPoint $indP]
1387         set xc [lindex $coordsP 0]
1388         set yc [lindex $coordsP 1]
1389         set zc [lindex $coordsP 2]
1390
1391     } else {
1392
1393         set indP $real
1394         set coordsP [ axisGrid_$widgets(work3D) GetPoint $indP ]
1395         set xc [ lindex $coordsP 0 ]
1396         set yc [ lindex $coordsP 1 ]
1397         set zc [ lindex $coordsP 2 ]
1398
1399     }
1400
1401     if { $nClicks == 1 } {
1402
1403         set first_point_quant $indP
1404         catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_quant1_$widgets(work3D) ] }
1405         DeleteSphere sphere_quant1_$widgets(work3D)
1406
1407         renderer_$widgets(work3D) AddActor [ DrawSphere sphere_quant1_$widgets(work3D) 0.5 $xc $yc $zc 0.00 0.00 1.0 ]
1408
1409     } else {
1410
1411         set last_point_quant $indP
1412         catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_quant2_$widgets(work3D) ] }
1413         DeleteSphere sphere_quant2_$widgets(work3D)
1414
1415         renderer_$widgets(work3D) AddActor [ DrawSphere sphere_quant2_$widgets(work3D) 0.5 $xc $yc $zc 0.00 1.0 0.00 ]
1416         planes_window::controls 1
1417         set given_points 1
1418
1419     }
1420
1421     [ $widgets(work3D) GetRenderWindow ] Render
1422     set f [ expr ( $first_point_quant < $last_point_quant )? $first_point_quant: $last_point_quant ]
1423     set l [ expr ( $first_point_quant > $last_point_quant )? $first_point_quant: $last_point_quant ]
1424     set actual_partial [ change_float_precision [ getPartialAxisLength_dll $f $l ] 2 ]
1425
1426 }
1427
1428
1429 proc planes_window::set_plane_3D { x y } {
1430
1431     # For programming facilities
1432     upvar planes_window::widgets widgets
1433     upvar planes_window::axis_index axis_index
1434
1435     renderer_$widgets(work3D) IsInViewport 0 0
1436
1437     busy hold .
1438     update
1439
1440     catch { tmp_world_picker_$widgets(work3D) Delete }
1441     set y [ expr [ lindex [ $widgets(work3D) configure -height ] 4 ] - $y - 1 ]
1442
1443     set pickWPPos [ pick_point_local_actor $x $y renderer_$widgets(work3D) isoActor_$widgets(work3D) 0.001 ]
1444     set xc [ lindex $pickWPPos 0 ]
1445     set yc [ lindex $pickWPPos 1 ]
1446     set zc [ lindex $pickWPPos 2 ]
1447     #Chercher le point de l'axe le plus proche au point choisi sur la surface
1448     set indP [axisGrid_$widgets(work3D) FindPoint $xc $yc $zc]
1449     set coordsP [axisGrid_$widgets(work3D) GetPoint $indP]
1450     set xc [lindex $coordsP 0]
1451     set yc [lindex $coordsP 1]
1452     set zc [lindex $coordsP 2]
1453
1454     if { $indP >= 0 } {
1455
1456         $widgets(sclSlice) set $indP
1457         planes_window::set_plane
1458
1459     }
1460
1461     busy release .
1462     update
1463
1464     [ $widgets(work3D) GetRenderWindow ] Render
1465
1466 }
1467
1468 proc planes_window::do_quant { } {
1469
1470     # For programming facilities
1471     upvar planes_window::widgets widgets
1472     upvar planes_window::axis_index        axis_index
1473     upvar planes_window::nClicks           nClicks
1474     upvar planes_window::first_point_quant first_point_quant
1475     upvar planes_window::last_point_quant  last_point_quant
1476     upvar planes_window::quantifing        quantifing
1477     upvar planes_window::first_quant       first_quant
1478     upvar planes_window::actual_quant_x     actual_quant_x
1479     upvar planes_window::actual_quant_area  actual_quant_area
1480     upvar planes_window::actual_quant_peri  actual_quant_peri
1481     upvar planes_window::actual_quant_darea actual_quant_darea
1482     upvar planes_window::actual_quant_dperi actual_quant_dperi
1483     upvar planes_window::actual_quant_dmax  actual_quant_dmax
1484     upvar planes_window::actual_quant_dmin  actual_quant_dmin
1485     upvar planes_window::actual_quant_davg  actual_quant_davg
1486     upvar planes_window::actual_quant_sten  actual_quant_sten
1487     upvar planes_window::actual_area  actual_area
1488     upvar planes_window::actual_peri  actual_peri
1489     upvar planes_window::actual_darea actual_darea
1490     upvar planes_window::actual_dperi actual_dperi
1491     upvar planes_window::actual_dmax  actual_dmax
1492     upvar planes_window::actual_dmin  actual_dmin
1493     upvar planes_window::actual_davg  actual_davg
1494     upvar planes_window::quant_shown        quant_shown
1495     upvar planes_window::real_first_point_quant real_first_point_quant
1496     upvar planes_window::real_last_point_quant real_last_point_quant
1497     upvar planes_window::actual_partial actual_partial
1498
1499     if { $quantifing == 0 } {
1500
1501         planes_window::clean_BLT
1502         planes_window::clean3D
1503
1504         set quantifing 1
1505
1506         set f [ expr ( $first_point_quant < $last_point_quant )? $first_point_quant: $last_point_quant ]
1507         set l [ expr ( $first_point_quant > $last_point_quant )? $first_point_quant: $last_point_quant ]
1508         planes_window::controls 2
1509
1510         set actual_quant_x     [ list ]
1511         set actual_quant_area  [ list ]
1512         set actual_quant_peri  [ list ]
1513         set actual_quant_darea [ list ]
1514         set actual_quant_dperi [ list ]
1515         set actual_quant_dmax  [ list ]
1516         set actual_quant_dmin  [ list ]
1517         set actual_quant_davg  [ list ]
1518         for { set i $f } { $i <= $l } { incr i } { lappend actual_quant_x $i }
1519         update_blt_all_meassures
1520
1521         startQuant_dll $f
1522         set cont $f
1523         changeSliceAxis_dll $f
1524
1525         set ans [ \
1526             tk_messageBox \
1527                 -icon question \
1528                 -message "$string_table::str_recalculate_contours" \
1529                 -type yesno \
1530                 -title "Question" \
1531         ]
1532         set recal [ expr ( [ string compare $ans yes ] == 0 )? 1: 0 ]
1533
1534         planes_window::clean_contour
1535         $widgets(sclSlice) set $cont
1536         planes_window::set_plane
1537         set quant_shown 1
1538         set params [ getContourParams_dll ]
1539         planes_window::generate_isocontour [ expr [ getCutSize_dll ] / 2 ] [ expr [ getCutSize_dll ] / 2 ] [ lindex $params 5 ] [ lindex $params 6 ]
1540         while { [ nextQuant_dll $recal isoStrips_$widgets(work3D) ] == 1 && $cont <= $l } {
1541
1542             if { $quantifing == 1 } {
1543
1544                 catch { renderer_$widgets(image2D) RemoveActor aPolygonActor_$widgets(image2D) }
1545                 catch { renderer_$widgets(image2D) RemoveActor aPolyLineActor_$widgets(image2D) }
1546                 catch { aPolygonActor_$widgets(image2D)   Delete }
1547                 catch { aPolygonMapper_$widgets(image2D)  Delete }
1548                 catch { aPolygonGrid_$widgets(image2D)    Delete }
1549                 catch { aPolyLineActor_$widgets(image2D)  Delete }
1550                 catch { aPolyLineMapper_$widgets(image2D) Delete }
1551                 catch { aPolyLineGrid_$widgets(image2D)   Delete }
1552                 catch { aPolyLine_$widgets(image2D)       Delete }
1553                 catch { PointsContour_$widgets(image2D)   Delete }
1554                 catch { aPolygon_$widgets(image2D)        Delete }
1555
1556                 set points [ getContourPoints_dll ]
1557                 set taille [ expr [ llength $points ] / 2 ]
1558
1559                 vtkPolygon aPolygon_$widgets(image2D)
1560                 vtkPoints PointsContour_$widgets(image2D)
1561
1562                 vtkPolyLine aPolyLine_$widgets(image2D)
1563                     set PointIds [ aPolyLine_$widgets(image2D) GetPointIds ]
1564                     $PointIds SetNumberOfIds $taille
1565                     set PointIdsPolygon [ aPolygon_$widgets(image2D) GetPointIds ]
1566                     $PointIdsPolygon SetNumberOfIds $taille
1567                 for { set i 0 } { $i< $taille } { incr i } {
1568                     $PointIds SetId $i $i
1569                     $PointIdsPolygon SetId $i $i
1570                     PointsContour_$widgets(image2D) InsertNextPoint [ lindex $points [ expr ( $i * 2 ) + 0 ] ] [ lindex $points [ expr ( $i * 2 ) + 1 ] ] 0
1571                 }
1572
1573                 vtkUnstructuredGrid aPolyLineGrid_$widgets(image2D)
1574                     aPolyLineGrid_$widgets(image2D) Allocate 1 1
1575                     set param1 [ aPolyLine_$widgets(image2D) GetCellType]
1576                     set param2 [ aPolyLine_$widgets(image2D) GetPointIds]
1577                     aPolyLineGrid_$widgets(image2D) InsertNextCell $param1 $param2
1578                     aPolyLineGrid_$widgets(image2D) SetPoints PointsContour_$widgets(image2D)
1579
1580                 vtkDataSetMapper aPolyLineMapper_$widgets(image2D)
1581                     aPolyLineMapper_$widgets(image2D)    SetInput aPolyLineGrid_$widgets(image2D)
1582
1583                 vtkActor aPolyLineActor_$widgets(image2D)
1584                     aPolyLineActor_$widgets(image2D) SetMapper aPolyLineMapper_$widgets(image2D)
1585                     set Property1 [aPolyLineActor_$widgets(image2D) GetProperty]
1586                     $Property1 SetColor 0 1 0
1587                     $Property1 SetLineWidth 2
1588                     $Property1 SetPointSize 2
1589                     $Property1 BackfaceCullingOff
1590
1591                 renderer_$widgets(image2D) AddActor aPolyLineActor_$widgets(image2D)
1592
1593                 vtkUnstructuredGrid aPolygonGrid_$widgets(image2D)
1594                     aPolygonGrid_$widgets(image2D) Allocate 1 1
1595                     set param1 [ aPolygon_$widgets(image2D) GetCellType ]
1596                     set param2 [ aPolygon_$widgets(image2D) GetPointIds ]
1597                     aPolygonGrid_$widgets(image2D) InsertNextCell $param1 $param2
1598                     aPolygonGrid_$widgets(image2D) SetPoints PointsContour_$widgets(image2D)
1599
1600                 vtkDataSetMapper aPolygonMapper_$widgets(image2D)
1601                     aPolygonMapper_$widgets(image2D)  SetInput aPolygonGrid_$widgets(image2D)
1602
1603                 vtkActor aPolygonActor_$widgets(image2D)
1604                     aPolygonActor_$widgets(image2D) SetMapper aPolygonMapper_$widgets(image2D)
1605                     set Property1 [ aPolygonActor_$widgets(image2D) GetProperty ]
1606                     $Property1 SetColor 0 1 0
1607                     $Property1 SetLineWidth 2
1608                     $Property1 SetPointSize 2
1609                     $Property1 BackfaceCullingOff
1610
1611                 array set arr [ params_dll 0 ]
1612                 if { $arr(e_debug_fill_area) == 1 } { renderer_$widgets(image2D) AddActor aPolygonActor_$widgets(image2D) }
1613                 planes_window::show_max_min_diameters
1614
1615                 [ $widgets(image2D) GetRenderWindow ] Render
1616
1617                 planes_window::draw3D_contour $cont
1618
1619                 set values [ getValues_dll $cont ]
1620                 lappend actual_quant_area  [ lindex $values 0 ]
1621                 lappend actual_quant_peri  [ lindex $values 1 ]
1622                 lappend actual_quant_darea [ lindex $values 2 ]
1623                 lappend actual_quant_dperi [ lindex $values 3 ]
1624                 lappend actual_quant_dmax  [ lindex $values 4 ]
1625                 lappend actual_quant_dmin  [ lindex $values 5 ]
1626                 lappend actual_quant_davg  [ lindex $values 6 ]
1627                 planes_window::update_blt_all_meassures
1628
1629                 set actual_area  [ change_float_precision [ lindex $values 0 ] 2 ]
1630                 set actual_peri  [ change_float_precision [ lindex $values 1 ] 2 ]
1631                 set actual_darea [ change_float_precision [ lindex $values 2 ] 2 ]
1632                 set actual_dperi [ change_float_precision [ lindex $values 3 ] 2 ]
1633                 set actual_dmax  [ change_float_precision [ lindex $values 4 ] 2 ]
1634                 set actual_dmin  [ change_float_precision [ lindex $values 5 ] 2 ]
1635                 set actual_davg  [ change_float_precision [ lindex $values 6 ] 2 ]
1636                 incr cont
1637                 planes_window::clean_contour
1638                 $widgets(sclSlice) set $cont
1639                 planes_window::set_plane
1640                 set params [ getContourParams_dll ]
1641                 planes_window::generate_isocontour [ expr [ getCutSize_dll ] / 2 ] [ expr [ getCutSize_dll ] / 2 ] [ lindex $params 5 ] [ lindex $params 6 ]
1642                 update
1643
1644             } elseif { $quantifing == 2 } {
1645
1646                 while { $quantifing == 2 } { update }
1647
1648             } elseif { $quantifing == 3 } {
1649
1650                 $widgets(btnPause) configure -text $string_table::str_pause
1651                 break
1652
1653             }
1654
1655         }
1656         finishQuant_dll
1657         planes_window::clean_contour
1658         set quantifing 0
1659
1660     } else {
1661
1662         set quantifing 2
1663         set ans [ \
1664             tk_messageBox \
1665                 -icon question \
1666                 -message "$string_table::str_stop_quantification" \
1667                 -type yesno \
1668                 -title "Question" \
1669         ]
1670         set quantifing 1
1671         if { [ string compare $ans yes ] == 0 } { set quantifing 3 }
1672
1673     }
1674
1675 }
1676
1677 proc planes_window::contour_calculated { } {
1678
1679     # For programming facilities
1680     upvar planes_window::widgets widgets
1681     upvar planes_window::axis_index axis_index
1682
1683     set index [ $widgets(sclSlice) get ]
1684
1685     planes_window::clean_contour
1686     set points [ getContourPoints_dll ]
1687     set taille [ expr [ llength $points ] / 2 ]
1688
1689     if { $taille > 0 } {
1690
1691         vtkPolygon aPolygon_$widgets(image2D)
1692         vtkPoints PointsContour_$widgets(image2D)
1693
1694         vtkPolyLine aPolyLine_$widgets(image2D)
1695             set PointIds [ aPolyLine_$widgets(image2D) GetPointIds ]
1696             $PointIds SetNumberOfIds $taille
1697             set PointIdsPolygon [ aPolygon_$widgets(image2D) GetPointIds ]
1698             $PointIdsPolygon SetNumberOfIds $taille
1699         for { set i 0 } { $i< $taille } { incr i } {
1700
1701             $PointIds SetId $i $i
1702             $PointIdsPolygon SetId $i $i
1703             PointsContour_$widgets(image2D) InsertNextPoint [ lindex $points [ expr ( $i * 2 ) + 0 ] ] [ lindex $points [ expr ( $i * 2 ) + 1 ] ] 0
1704
1705         }
1706
1707         vtkUnstructuredGrid aPolyLineGrid_$widgets(image2D)
1708             aPolyLineGrid_$widgets(image2D) Allocate 1 1
1709             set param1 [ aPolyLine_$widgets(image2D) GetCellType]
1710             set param2 [ aPolyLine_$widgets(image2D) GetPointIds]
1711             aPolyLineGrid_$widgets(image2D) InsertNextCell $param1 $param2
1712             aPolyLineGrid_$widgets(image2D) SetPoints PointsContour_$widgets(image2D)
1713
1714         vtkDataSetMapper aPolyLineMapper_$widgets(image2D)
1715             aPolyLineMapper_$widgets(image2D)    SetInput aPolyLineGrid_$widgets(image2D)
1716
1717         vtkActor aPolyLineActor_$widgets(image2D)
1718             aPolyLineActor_$widgets(image2D) SetMapper aPolyLineMapper_$widgets(image2D)
1719             set Property1 [aPolyLineActor_$widgets(image2D) GetProperty]
1720             $Property1 SetColor 0 1 0
1721             $Property1 SetLineWidth 2
1722             $Property1 SetPointSize 2
1723             $Property1 BackfaceCullingOff
1724
1725         renderer_$widgets(image2D) AddActor aPolyLineActor_$widgets(image2D)
1726
1727         vtkUnstructuredGrid aPolygonGrid_$widgets(image2D)
1728             aPolygonGrid_$widgets(image2D) Allocate 1 1
1729             set param1 [ aPolygon_$widgets(image2D) GetCellType ]
1730             set param2 [ aPolygon_$widgets(image2D) GetPointIds ]
1731             aPolygonGrid_$widgets(image2D) InsertNextCell $param1 $param2
1732             aPolygonGrid_$widgets(image2D) SetPoints PointsContour_$widgets(image2D)
1733
1734         vtkDataSetMapper aPolygonMapper_$widgets(image2D)
1735             aPolygonMapper_$widgets(image2D)  SetInput aPolygonGrid_$widgets(image2D)
1736
1737         vtkActor aPolygonActor_$widgets(image2D)
1738             aPolygonActor_$widgets(image2D) SetMapper aPolygonMapper_$widgets(image2D)
1739             set Property1 [ aPolygonActor_$widgets(image2D) GetProperty ]
1740             $Property1 SetColor 0 1 0
1741             $Property1 SetLineWidth 2
1742             $Property1 SetPointSize 2
1743             $Property1 BackfaceCullingOff
1744
1745         array set arr [ params_dll 0 ]
1746         if { $arr(e_debug_fill_area) == 1 } { renderer_$widgets(image2D) AddActor aPolygonActor_$widgets(image2D) }
1747
1748         [ $widgets(work3D) GetRenderWindow ] Render
1749         [ $widgets(image2D) GetRenderWindow ] Render
1750
1751     }
1752
1753 }
1754
1755 proc planes_window::clean_BLT { } {
1756
1757     # For programming facilities
1758     upvar planes_window::widgets     widgets
1759
1760     $widgets(graph) axis configure y -min 0.00
1761     $widgets(graph) grid configure  -hide no
1762     $widgets(graph) legend configure -position bottom -font {Helvetica -14 bold}
1763     Blt_Crosshairs $widgets(graph)
1764     $widgets(graph) crosshairs configure -hide no
1765     $widgets(graph) crosshairs configure -color red -dashes 2
1766     bind bltCrosshairs <ButtonPress-1> {}
1767
1768     catch { $widgets(graph) marker delete line_select }
1769     catch { $widgets(graph) element delete $string_table::str_area }
1770     catch { $widgets(graph) element delete $string_table::str_peri }
1771     catch { $widgets(graph) element delete $string_table::str_diam_area }
1772     catch { $widgets(graph) element delete $string_table::str_diam_peri }
1773     catch { $widgets(graph) element delete $string_table::str_diam_max }
1774     catch { $widgets(graph) element delete $string_table::str_diam_min }
1775     catch { $widgets(graph) element delete $string_table::str_diam_avg }
1776     catch { $widgets(graph) element delete $string_table::str_stenosis }
1777
1778 }
1779
1780 proc planes_window::update_blt_all_meassures { } {
1781
1782     # For programming facilities
1783     upvar planes_window::widgets widgets
1784     upvar planes_window::actual_quant_x     actual_quant_x
1785     upvar planes_window::actual_quant_area  actual_quant_area
1786     upvar planes_window::actual_quant_peri  actual_quant_peri
1787     upvar planes_window::actual_quant_darea actual_quant_darea
1788     upvar planes_window::actual_quant_dperi actual_quant_dperi
1789     upvar planes_window::actual_quant_dmax  actual_quant_dmax
1790     upvar planes_window::actual_quant_dmin  actual_quant_dmin
1791     upvar planes_window::actual_quant_davg  actual_quant_davg
1792     upvar planes_window::actual_quant_sten  actual_quant_sten
1793     upvar planes_window::quant_shown        quant_shown
1794
1795     if { [ llength $actual_quant_x ] > 0 } {
1796
1797         planes_window::clean_BLT
1798         bind bltCrosshairs <ButtonPress-1> "planes_window::set_plane_BLT %x"
1799
1800         array set arr [ params_dll 0 ]
1801
1802         if { [ expr $arr(e_quantification_type) & 0x01 ] == 0x01 } { $widgets(graph) element create $string_table::str_area      -symbol "" -color #ff0000 -xdata $actual_quant_x -ydata $actual_quant_area }
1803         if { [ expr $arr(e_quantification_type) & 0x02 ] == 0x02 } { $widgets(graph) element create $string_table::str_peri      -symbol "" -color #ff8000 -xdata $actual_quant_x -ydata $actual_quant_peri }
1804         if { [ expr $arr(e_quantification_type) & 0x04 ] == 0x04 } { $widgets(graph) element create $string_table::str_diam_area -symbol "" -color #808040 -xdata $actual_quant_x -ydata $actual_quant_darea }
1805         if { [ expr $arr(e_quantification_type) & 0x08 ] == 0x08 } { $widgets(graph) element create $string_table::str_diam_peri -symbol "" -color #808080 -xdata $actual_quant_x -ydata $actual_quant_dperi }
1806         if { [ expr $arr(e_quantification_type) & 0x10 ] == 0x10 } { $widgets(graph) element create $string_table::str_diam_min  -symbol "" -color #0000ff -xdata $actual_quant_x -ydata $actual_quant_dmin }
1807         if { [ expr $arr(e_quantification_type) & 0x20 ] == 0x20 } { $widgets(graph) element create $string_table::str_diam_max  -symbol "" -color #800080 -xdata $actual_quant_x -ydata $actual_quant_dmax }
1808         if { [ expr $arr(e_quantification_type) & 0x40 ] == 0x40 } { $widgets(graph) element create $string_table::str_diam_avg  -symbol "" -color #000000 -xdata $actual_quant_x -ydata $actual_quant_davg }
1809         if { [ llength $actual_quant_sten ] > 0 } {
1810
1811             set actual_quant_sten [ getStenosisQuant_dll ]
1812             $widgets(graph) element create $string_table::str_stenosis -symbol "" -color #00ff00 -xdata $actual_quant_x -ydata $actual_quant_sten
1813             $widgets(graph) element configure $string_table::str_stenosis -mapy y2
1814             $widgets(graph) axis configure y2 -hide no
1815             $widgets(graph) axis configure y2 -min -100.00 -max 100.00
1816
1817         }
1818
1819     }
1820
1821 }
1822
1823 proc planes_window::ev_start_window_level { x y } {
1824
1825     # For programming facilities
1826     upvar planes_window::widgets widgets
1827     upvar planes_window::initX           initX
1828     upvar planes_window::initY           initY
1829     upvar planes_window::initWindow      initWindow
1830     upvar planes_window::initLevel       initLevel
1831
1832     set initX $x
1833     set initY $y
1834
1835     set initWindow [ bwlookup_$widgets(work3D) GetWindow ]
1836     set initLevel  [ bwlookup_$widgets(work3D) GetLevel  ]
1837
1838 }
1839
1840 proc planes_window::ev_window_level { x y } {
1841
1842     # For programming facilities
1843     upvar planes_window::widgets widgets
1844     upvar planes_window::initX           initX
1845     upvar planes_window::initY           initY
1846     upvar planes_window::initWindow      initWindow
1847     upvar planes_window::initLevel       initLevel
1848
1849     # get the widgets dimensions
1850     set width  [ lindex [ $widgets(image2D) configure -width ] 4 ]
1851     set height [ lindex [ $widgets(image2D) configure -height ] 4 ]
1852
1853     # compute normalized delta
1854     set dx [ expr 4.0 * ( $x - $initX ) / $width  ]
1855     set dy [ expr 4.0 * ( $initY - $y ) / $height ]
1856
1857     # scale by current values
1858     set dx [ expr $dx * $initWindow ]
1859     set dy [ expr $dy * $initLevel  ]
1860
1861     # abs so that direction does not flip
1862     if { $initWindow < 0.00 } { set dx [ expr 0 - $dx ] }
1863     if { $initLevel < 0.00  } { set dy [ expr 0 - $dy ] }
1864
1865     # compute new window level
1866     set window [ expr $dx + $initWindow ]
1867     if {$window < 0.00} {
1868     set level [ expr $dy + $initLevel ]
1869     } else {
1870     set level [ expr $initLevel - $dy ]
1871     }
1872
1873     if { $window < 0.00 } { set dy [ expr 0 - $dy ] }
1874
1875     bwlookup_$widgets(work3D) SetWindow $window
1876     bwlookup_$widgets(work3D) SetLevel  $level
1877
1878     [ $widgets(image2D) GetRenderWindow ] Render
1879
1880 }
1881
1882 proc planes_window::profil_linear { x y } {
1883
1884     # For programming facilities
1885     upvar planes_window::widgets widgets
1886     upvar planes_window::initX   initX
1887     upvar planes_window::initY   initY
1888
1889     set y1 [ expr [ lindex [ $widgets(image2D) configure -height ] 4 ] - $initY - 1 ]
1890     set y2 [ expr [ lindex [ $widgets(image2D) configure -height ] 4 ] - $y - 1 ]
1891     set x1 $initX
1892     set x2 $x
1893
1894     catch { tmp_picker_$widgets(image2D) Delete }
1895     vtkWorldPointPicker tmp_picker_$widgets(image2D)
1896         set pickWP     [ tmp_picker_$widgets(image2D) Pick $x1 $y1 0 renderer_$widgets(image2D) ]
1897         set pickWPPos1 [ tmp_picker_$widgets(image2D) GetPickPosition ]
1898         set pickWP     [ tmp_picker_$widgets(image2D) Pick $x2 $y2 0 renderer_$widgets(image2D) ]
1899         set pickWPPos2 [ tmp_picker_$widgets(image2D) GetPickPosition ]
1900
1901     set c1 [ list [ lindex $pickWPPos1 0 ] [ lindex $pickWPPos1 1 ] 0 ]
1902     set c2 [ list [ lindex $pickWPPos2 0 ] [ lindex $pickWPPos2 1 ] 0 ]
1903
1904     planes_window::clear
1905
1906     renderer_$widgets(image2D) AddActor [ \
1907         DrawSphere prb1_lfv 0.1 \
1908         [ lindex $c1 0 ] [ lindex $c1 1 ] [ lindex $c1 2 ] \
1909         1.0 0.00 0.00
1910     ]
1911     renderer_$widgets(image2D) AddActor [ \
1912         DrawSphere prb2_lfv 0.1 \
1913         [ lindex $c2 0 ] [ lindex $c2 1 ] [ lindex $c2 2 ] \
1914         0.00 0.00 1.0
1915     ]
1916
1917     vtkLineSource line_2D_profil_$widgets(image2D)
1918         line_2D_profil_$widgets(image2D) SetPoint1 [ lindex $c1 0 ] [ lindex $c1 1 ] [ lindex $c1 2 ]
1919         line_2D_profil_$widgets(image2D) SetPoint2 [ lindex $c2 0 ] [ lindex $c2 1 ] [ lindex $c2 2 ]
1920     vtkPolyDataMapper mapper_2D_profil_$widgets(image2D)
1921         mapper_2D_profil_$widgets(image2D) SetInput [ line_2D_profil_$widgets(image2D) GetOutput ]
1922         mapper_2D_profil_$widgets(image2D) ImmediateModeRenderingOn
1923     vtkActor actor_2D_profil_$widgets(image2D)
1924         actor_2D_profil_$widgets(image2D) SetMapper mapper_2D_profil_$widgets(image2D)
1925         [ actor_2D_profil_$widgets(image2D) GetProperty ] SetColor  1.0 0.00 0.00
1926     renderer_$widgets(image2D) AddActor actor_2D_profil_$widgets(image2D)
1927
1928     [ $widgets(image2D) GetRenderWindow ] Render
1929
1930     busy hold .
1931     update
1932     set vals [ getProfilCut_dll $c1 $c2 ]
1933     catch { destroy $widgets(image2D).fnProfil }
1934     toplevel $widgets(image2D).fnProfil -width [ lindex $vals 2 ] -height [ lindex $vals 1 ] -background black
1935     canvas $widgets(image2D).fnProfil.c -width [ lindex $vals 2 ] -height [ lindex $vals 1 ] -background black -borderwidth 1
1936     pack $widgets(image2D).fnProfil.c -fill both -expand 1
1937     for { set i 5 } { $i < [ llength $vals ] } { incr i } {
1938
1939         if { $i > 5 } {
1940
1941         $widgets(image2D).fnProfil.c create line \
1942             [ expr $i - 6 ] [ expr [ lindex $vals 1 ] - [ lindex $vals [ expr $i - 1 ] ] ] \
1943             [ expr $i - 5 ] [ expr [ lindex $vals 1 ] - [ lindex $vals $i ] ] \
1944             -fill #0000ff -width 1
1945
1946         } else {
1947
1948             $widgets(image2D).fnProfil.c create line \
1949                 0 0 \
1950                 [ expr $i - 5 ] [ expr [ lindex $vals 1 ] - [ lindex $vals $i ] ] \
1951                 -fill #0000ff -width 1
1952
1953         }
1954
1955     }
1956     array set arr [ params_dll 0 ]
1957     set dist [ DistPoints [ lindex $c1 0 ] [ lindex $c1 1 ] 0 [ lindex $c2 0 ] [ lindex $c2 1 ] 0 ]
1958     set len [ expr $dist * $arr(e_scale) * $arr(e_roi_dimension) / [ getCutSize_dll ] ]
1959     $widgets(image2D).fnProfil.c create text \
1960         0 0 \
1961         -text "$string_table::str_min = [ lindex $vals 0 ]\n$string_table::str_max = [ lindex $vals 1 ]\n$string_table::str_nro_pix = [ lindex $vals 2 ]\n$string_table::str_mm_length = $len\n$string_table::str_avg = [ lindex $vals 3 ]\n$string_table::str_std = [ lindex $vals 4 ]" \
1962         -fill yellow \
1963         -justify left \
1964         -anchor nw \
1965         -font { Helvetica -12 bold }
1966     busy release .
1967     update
1968
1969 }
1970
1971 proc planes_window::profil_area { x y } {
1972
1973     # For programming facilities
1974     upvar planes_window::widgets widgets
1975     upvar planes_window::initX   initX
1976     upvar planes_window::initY   initY
1977
1978     set y1 [ expr [ lindex [ $widgets(image2D) configure -height ] 4 ] - $initY - 1 ]
1979     set y2 [ expr [ lindex [ $widgets(image2D) configure -height ] 4 ] - $y - 1 ]
1980     set x1 $initX
1981     set x2 $x
1982
1983     catch { tmp_picker_$widgets(image2D) Delete }
1984     vtkWorldPointPicker tmp_picker_$widgets(image2D)
1985         set pickWP     [ tmp_picker_$widgets(image2D) Pick $x1 $y1 0 renderer_$widgets(image2D) ]
1986         set pickWPPos1 [ tmp_picker_$widgets(image2D) GetPickPosition ]
1987         set pickWP     [ tmp_picker_$widgets(image2D) Pick $x2 $y2 0 renderer_$widgets(image2D) ]
1988         set pickWPPos2 [ tmp_picker_$widgets(image2D) GetPickPosition ]
1989
1990     set c1 [ list [ lindex $pickWPPos1 0 ] [ lindex $pickWPPos1 1 ] 0 ]
1991     set c2 [ list [ lindex $pickWPPos2 0 ] [ lindex $pickWPPos2 1 ] 0 ]
1992
1993     planes_window::clear
1994
1995     renderer_$widgets(image2D) AddActor [ \
1996         DrawSphere prb1_lfv2 1.0 \
1997         [ lindex $c1 0 ] [ lindex $c1 1 ] [ lindex $c1 2 ] \
1998         1.0 0.00 0.00
1999     ]
2000     renderer_$widgets(image2D) AddActor [ \
2001         DrawSphere prb2_lfv2 1.0 \
2002         [ lindex $c2 0 ] [ lindex $c2 1 ] [ lindex $c2 2 ] \
2003         0.00 0.00 1.0
2004     ]
2005
2006     [ $widgets(image2D) GetRenderWindow ] Render
2007
2008     busy hold .
2009     update
2010     set vals [ getProfilAreaCut_dll $c1 $c2 ]
2011     catch { destroy .fnProfil }
2012     toplevel $widgets(image2D).fnProfil -width 100 -height 100 -background black
2013     canvas $widgets(image2D).fnProfil.c -width 100 -height 100 -background black -borderwidth 1
2014     pack $widgets(image2D).fnProfil.c -fill both -expand 1
2015     $widgets(image2D).fnProfil.c create text \
2016         0 0 \
2017         -text "$string_table::str_min = [ lindex $vals 0 ]\n$string_table::str_max = [ lindex $vals 1 ]\n$string_table::str_nro_pix = [ lindex $vals 2 ]\n$string_table::str_avg = [ lindex $vals 3 ]\n$string_table::str_std = [ lindex $vals 4 ]" \
2018         -fill yellow \
2019         -justify left \
2020         -anchor nw \
2021         -font { Helvetica -12 bold }
2022     busy release .
2023     update
2024
2025 }
2026
2027 proc planes_window::clear { } {
2028
2029     # For programming facilities
2030     upvar planes_window::widgets widgets
2031
2032     catch { renderer_$widgets(image2D) RemoveActor [ GetSphereActorName prb1_lfv2 ] }
2033     catch { renderer_$widgets(image2D) RemoveActor [ GetSphereActorName prb2_lfv2 ] }
2034     DeleteSphere prb1_lfv2
2035     DeleteSphere prb2_lfv2
2036     catch { renderer_$widgets(image2D) RemoveActor [ GetSphereActorName prb1_lfv ] }
2037     catch { renderer_$widgets(image2D) RemoveActor [ GetSphereActorName prb2_lfv ] }
2038     catch { renderer_$widgets(image2D) RemoveActor actor_2D_profil_$widgets(image2D) }
2039     catch { actor_2D_profil_$widgets(image2D) Delete }
2040     catch { mapper_2D_profil_$widgets(image2D) Delete }
2041     catch { line_2D_profil_$widgets(image2D) Delete }
2042     DeleteSphere prb1_lfv
2043     DeleteSphere prb2_lfv
2044
2045     catch { [ $widgets(image2D) GetRenderWindow ] Render }
2046
2047 }
2048
2049 proc planes_window::set_healthy_slice { } {
2050
2051     # For programming facilities
2052     upvar planes_window::widgets widgets
2053     upvar planes_window::axis_index        axis_index
2054     upvar planes_window::first_point_quant first_point_quant
2055     upvar planes_window::last_point_quant  last_point_quant
2056     upvar planes_window::show_hs_var show_hs_var
2057     upvar planes_window::actual_sten actual_sten
2058     upvar planes_window::actual_quant_sten actual_quant_sten
2059     upvar planes_window::real_first_point_quant real_first_point_quant
2060     upvar planes_window::real_last_point_quant real_last_point_quant
2061
2062     set f $real_first_point_quant
2063     set l $real_last_point_quant
2064
2065     set x [ list ]
2066     for { set i $f } { $i <= $l } { incr i } { lappend x $i }
2067
2068     set slice [ $widgets(sclSlice) get ]
2069
2070     # Get new data
2071     setHealthySlice_dll $slice
2072     set actual_quant_sten [ getStenosisQuant_dll ]
2073
2074     # Show it
2075     catch { $widgets(graph) marker delete line_healthy_slice }
2076     $widgets(graph) marker create line -coords { $slice -Inf $slice Inf } -dashes dash -linewidth 1.5 -outline green -name line_healthy_slice
2077     planes_window::update_blt_all_meassures
2078     set actual_sten 0.00
2079
2080     # Show plane
2081     set plane [ getVTKPlane_dll ]
2082     set o [ $plane GetOrigin ]
2083     set c [ $plane GetCenter ]
2084     set n [ $plane GetNormal ]
2085     set p1 [ $plane GetPoint1 ]
2086     set p2 [ $plane GetPoint2 ]
2087
2088     catch { renderer_$widgets(work3D) RemoveActor hs_actor_$widgets(work3D) }
2089     catch { hs_actor_$widgets(work3D) Delete }
2090     catch { hs_mapper_$widgets(work3D) Delete }
2091     catch { hs_grid_$widgets(work3D) Delete }
2092     catch { hs_points_$widgets(work3D) Delete }
2093     catch { hs_poly_line_$widgets(work3D) Delete }
2094
2095     vtkPolyLine hs_poly_line_$widgets(work3D)
2096         [ hs_poly_line_$widgets(work3D) GetPointIds ] SetNumberOfIds 8
2097         [ hs_poly_line_$widgets(work3D) GetPointIds ] SetId 0 0
2098         [ hs_poly_line_$widgets(work3D) GetPointIds ] SetId 1 1
2099         [ hs_poly_line_$widgets(work3D) GetPointIds ] SetId 2 2
2100         [ hs_poly_line_$widgets(work3D) GetPointIds ] SetId 3 3
2101         [ hs_poly_line_$widgets(work3D) GetPointIds ] SetId 4 4
2102         [ hs_poly_line_$widgets(work3D) GetPointIds ] SetId 5 5
2103         [ hs_poly_line_$widgets(work3D) GetPointIds ] SetId 6 6
2104         [ hs_poly_line_$widgets(work3D) GetPointIds ] SetId 7 7
2105
2106     vtkPoints hs_points_$widgets(work3D)
2107         hs_points_$widgets(work3D) InsertNextPoint [ lindex $o 0 ] [ lindex $o 1 ] [ lindex $o 2 ]
2108         hs_points_$widgets(work3D) InsertNextPoint [ lindex $p1 0 ] [ lindex $p1 1 ] [ lindex $p1 2 ]
2109         hs_points_$widgets(work3D) InsertNextPoint \
2110             [ expr [ lindex $p2 0 ] + [ lindex $p1 0 ] - [ lindex $o 0 ] ] \
2111             [ expr [ lindex $p2 1 ] + [ lindex $p1 1 ] - [ lindex $o 1 ] ] \
2112             [ expr [ lindex $p2 2 ] + [ lindex $p1 2 ] - [ lindex $o 2 ] ]
2113         hs_points_$widgets(work3D) InsertNextPoint [ lindex $p2 0 ] [ lindex $p2 1 ] [ lindex $p2 2 ]
2114         hs_points_$widgets(work3D) InsertNextPoint [ lindex $o 0 ] [ lindex $o 1 ] [ lindex $o 2 ]
2115         hs_points_$widgets(work3D) InsertNextPoint \
2116             [ expr [ lindex $p2 0 ] + [ lindex $p1 0 ] - [ lindex $o 0 ] ] \
2117             [ expr [ lindex $p2 1 ] + [ lindex $p1 1 ] - [ lindex $o 1 ] ] \
2118             [ expr [ lindex $p2 2 ] + [ lindex $p1 2 ] - [ lindex $o 2 ] ]
2119         hs_points_$widgets(work3D) InsertNextPoint [ lindex $p1 0 ] [ lindex $p1 1 ] [ lindex $p1 2 ]
2120         hs_points_$widgets(work3D) InsertNextPoint [ lindex $p2 0 ] [ lindex $p2 1 ] [ lindex $p2 2 ]
2121
2122     vtkUnstructuredGrid hs_grid_$widgets(work3D)
2123         hs_grid_$widgets(work3D) Allocate 1 1
2124         hs_grid_$widgets(work3D) InsertNextCell \
2125             [ hs_poly_line_$widgets(work3D) GetCellType ] [ hs_poly_line_$widgets(work3D) GetPointIds ]
2126             hs_grid_$widgets(work3D) SetPoints hs_points_$widgets(work3D)
2127
2128     vtkDataSetMapper hs_mapper_$widgets(work3D)
2129         hs_mapper_$widgets(work3D) SetInput hs_grid_$widgets(work3D)
2130         hs_mapper_$widgets(work3D) ImmediateModeRenderingOn
2131
2132     vtkActor hs_actor_$widgets(work3D)
2133         hs_actor_$widgets(work3D) SetMapper hs_mapper_$widgets(work3D)
2134         [ hs_actor_$widgets(work3D) GetProperty] BackfaceCullingOn
2135         [ hs_actor_$widgets(work3D) GetProperty] SetDiffuseColor 0 1 0
2136
2137     if { $show_hs_var == 1 } { catch { renderer_$widgets(work3D) AddActor hs_actor_$widgets(work3D) } }
2138
2139     [ $widgets(work3D) GetRenderWindow ] Render
2140
2141 }
2142
2143 proc planes_window::set_plane_BLT { x } {
2144
2145     # For programming facilities
2146     upvar planes_window::widgets widgets
2147     upvar planes_window::axis_index axis_index
2148
2149     busy hold .
2150     update
2151
2152     set slice [ expr round( [ $widgets(graph) axis invtransform x $x ] ) ]
2153     $widgets(sclSlice) set $slice
2154     planes_window::set_plane
2155     catch { $widgets(graph) marker delete line_select }
2156     $widgets(graph) marker create line -coords { $slice -Inf $slice Inf } -dashes dash -linewidth 1 -outline red -name line_select
2157
2158     busy release .
2159     update
2160
2161     [ $widgets(work3D) GetRenderWindow ] Render
2162
2163 }
2164
2165 proc planes_window::add_point_contour_manual { x y } {
2166
2167     # For programming facilities
2168     upvar planes_window::widgets widgets
2169     upvar planes_window::man_points man_points
2170
2171     set y [ expr [ lindex [ $widgets(image2D) configure -height ] 4 ] - $y - 1 ]
2172
2173     catch { tmp_picker_$widgets(image2D) Delete }
2174     vtkWorldPointPicker tmp_picker_$widgets(image2D)
2175         set pickWP    [ tmp_picker_$widgets(image2D) Pick $x $y 0 renderer_$widgets(image2D) ]
2176         set pickWPPos [ tmp_picker_$widgets(image2D) GetPickPosition ]
2177
2178     set point [ list [ lindex $pickWPPos 0 ] [ lindex $pickWPPos 1 ] 0 ]
2179     lappend man_points [ lindex $point 0 ]
2180     lappend man_points [ lindex $point 1 ]
2181     set i [ llength $man_points ]
2182
2183     renderer_$widgets(image2D) AddActor [ \
2184         DrawSphere man_point_$i 0.5 \
2185         [ lindex $point 0 ] [ lindex $point 1 ] [ lindex $point 2 ] \
2186         0.00 1.0 0.00
2187     ]
2188
2189     [ $widgets(image2D) GetRenderWindow ] Render
2190
2191 }
2192
2193 proc planes_window::set_mouse_left_events { mask } {
2194
2195     # For programming facilities
2196     upvar planes_window::widgets widgets
2197
2198     # TODO : change
2199     catch { bind $widgets(work3D) <Any-ButtonPress>   { ev_startMotion %W %x %y } }
2200     catch { bind $widgets(work3D) <Any-ButtonRelease> { ev_endMotion %W %x %y } }
2201     catch { bind $widgets(image2D) <Any-ButtonPress>   { ev_startMotion %W %x %y } }
2202     catch { bind $widgets(image2D) <Any-ButtonRelease> { ev_endMotion %W %x %y } }
2203
2204     if { [ expr $mask & 0x4 ] == 0x4 } {
2205
2206         catch { bind $widgets(work3D) <B1-Motion> { evz_rotate %W %x %y } }
2207         catch { bind $widgets(image2D) <B1-Motion> { evz_pan %W %x %y } }
2208
2209     }
2210     if { [ expr $mask & 0x2 ] == 0x2 } {
2211
2212         catch { bind $widgets(work3D) <B1-Motion> { evz_pan %W %x %y } }
2213         catch { bind $widgets(image2D) <B1-Motion> { evz_pan %W %x %y } }
2214
2215     }
2216     if { [ expr $mask & 0x1 ] == 0x1 } {
2217
2218         catch { bind $widgets(image2D) <B1-Motion> { planes_window::point_intensity %x %y } }
2219
2220     }
2221
2222 }
2223
2224 proc planes_window::set_mouse_right_events { mask } {
2225
2226     # For programming facilities
2227     upvar planes_window::widgets widgets
2228
2229     catch { bind $widgets(work3D) <Any-ButtonPress>   { ev_startMotion %W %x %y } }
2230     catch { bind $widgets(work3D) <Any-ButtonRelease> { ev_endMotion %W %x %y } }
2231
2232     if { [ expr $mask & 0x4 ] == 0x4 } {
2233
2234         catch { bind $widgets(work3D) <B3-Motion> { evz_zoom %W %x %y } }
2235
2236         catch { bind $widgets(image2D) <ButtonPress-3>   { ev_startMotion %W %x %y } }
2237         catch { bind $widgets(image2D) <ButtonRelease-3> { ev_endMotion %W %x %y } }
2238         catch { bind $widgets(image2D) <B3-Motion>       { evz_zoom %W %x %y } }
2239
2240     }
2241     if { [ expr $mask & 0x8 ] == 0x8 } {
2242
2243         catch { bind $widgets(work3D) <B3-Motion> { evz_zoom %W %x %y } }
2244
2245         catch { bind $widgets(image2D) <ButtonPress-3>   { planes_window::ev_start_window_level %x %y } }
2246         catch { bind $widgets(image2D) <ButtonRelease-3> { ev_endMotion %W %x %y } }
2247         catch { bind $widgets(image2D) <B3-Motion>       { planes_window::ev_window_level %x %y } }
2248
2249     }
2250     if { [ expr $mask & 0x2 ] == 0x2 } {
2251
2252         catch { bind $widgets(work3D) <B3-Motion> { evz_zoom %W %x %y } }
2253
2254         catch { bind $widgets(image2D) <ButtonPress-3>   { planes_window::ev_start_window_level %x %y } }
2255         catch { bind $widgets(image2D) <B3-Motion>       { } }
2256         catch { bind $widgets(image2D) <ButtonRelease-3> { planes_window::profil_linear %x %y } }
2257
2258     }
2259     if { [ expr $mask & 0x1 ] == 0x1 } {
2260
2261         catch { bind $widgets(work3D) <B3-Motion> { evz_zoom %W %x %y } }
2262
2263         catch { bind $widgets(image2D) <ButtonPress-3>   { planes_window::ev_start_window_level %x %y } }
2264         catch { bind $widgets(image2D) <B3-Motion>       { } }
2265         catch { bind $widgets(image2D) <ButtonRelease-3> { planes_window::profil_area %x %y } }
2266
2267     }
2268
2269 }
2270
2271 proc planes_window::draw3D_contour { slice } {
2272
2273     # For programming facilities
2274     upvar planes_window::widgets widgets
2275     upvar planes_window::axis_index axis_index
2276     upvar planes_window::show_rings show_rings
2277     upvar planes_window::rings_index  rings_index
2278
2279     if { [ lsearch -exact $rings_index $slice ] == -1 } { lappend rings_index $slice }
2280
2281     catch { renderer_$widgets(work3D) RemoveActor cont3DActor_{$widgets(work3D)}_{$slice} }
2282     catch { cont3DActor_{$widgets(work3D)}_{$slice}    Delete }
2283     catch { cont3DMapper_{$widgets(work3D)}_{$slice}   Delete }
2284     catch { cont3DGrid_{$widgets(work3D)}_{$slice}     Delete }
2285     catch { cont3DPolyLine_{$widgets(work3D)}_{$slice} Delete }
2286     catch { cont3DPoints_{$widgets(work3D)}_{$slice}   Delete }
2287
2288     set points3D [ get3DContour_dll $slice ]
2289     set nP [ expr [ llength $points3D ] / 3 ]
2290
2291     vtkPoints cont3DPoints_{$widgets(work3D)}_{$slice}
2292     vtkPolyLine cont3DPolyLine_{$widgets(work3D)}_{$slice}
2293     [ cont3DPolyLine_{$widgets(work3D)}_{$slice} GetPointIds ] SetNumberOfIds $nP
2294     for { set i 0 } { $i < $nP } { incr i } {
2295
2296         [ cont3DPolyLine_{$widgets(work3D)}_{$slice} GetPointIds ] SetId $i $i
2297         cont3DPoints_{$widgets(work3D)}_{$slice} InsertNextPoint \
2298             [ lindex $points3D [ expr $i * 3 + 0 ] ] \
2299             [ lindex $points3D [ expr $i * 3 + 1 ] ] \
2300             [ lindex $points3D [ expr $i * 3 + 2 ] ]
2301
2302     }
2303
2304     vtkUnstructuredGrid cont3DGrid_{$widgets(work3D)}_{$slice}
2305         cont3DGrid_{$widgets(work3D)}_{$slice} Allocate 1 1
2306         cont3DGrid_{$widgets(work3D)}_{$slice} InsertNextCell \
2307             [ cont3DPolyLine_{$widgets(work3D)}_{$slice} GetCellType ] \
2308             [ cont3DPolyLine_{$widgets(work3D)}_{$slice} GetPointIds ]
2309         cont3DGrid_{$widgets(work3D)}_{$slice} SetPoints cont3DPoints_{$widgets(work3D)}_{$slice}
2310
2311     vtkDataSetMapper cont3DMapper_{$widgets(work3D)}_{$slice}
2312         cont3DMapper_{$widgets(work3D)}_{$slice} SetInput cont3DGrid_{$widgets(work3D)}_{$slice}
2313      cont3DMapper_{$widgets(work3D)}_{$slice} ImmediateModeRenderingOn
2314
2315     vtkActor cont3DActor_{$widgets(work3D)}_{$slice}
2316         cont3DActor_{$widgets(work3D)}_{$slice} SetMapper cont3DMapper_{$widgets(work3D)}_{$slice}
2317         [ cont3DActor_{$widgets(work3D)}_{$slice} GetProperty] BackfaceCullingOn
2318         [ cont3DActor_{$widgets(work3D)}_{$slice} GetProperty] SetDiffuseColor 0 1 0
2319
2320     if { $show_rings == 1 } { renderer_$widgets(work3D) AddActor cont3DActor_{$widgets(work3D)}_{$slice} }
2321     [ $widgets(work3D) GetRenderWindow ] Render
2322
2323 }
2324
2325 proc planes_window::show3D_rings_contour { var_rings } {
2326
2327     # For programming facilities
2328     upvar planes_window::widgets widgets
2329     upvar planes_window::axis_index axis_index
2330     upvar planes_window::show_rings show_rings
2331
2332     set show_rings $var_rings
2333
2334     set noap [ getNumberOfAxisPoints_dll ]
2335
2336     for { set i 0 } { $i < $noap } { incr i } {
2337
2338         if { $show_rings == 0 } {
2339         catch { renderer_$widgets(work3D) RemoveActor cont3DActor_{$widgets(work3D)}_{$i} }
2340         } else {
2341         catch { renderer_$widgets(work3D) AddActor cont3DActor_{$widgets(work3D)}_{$i} }
2342         }
2343
2344     }
2345
2346     [ $widgets(work3D) GetRenderWindow ] Render
2347
2348 }
2349
2350 proc planes_window::controls { { id -1 } } {
2351
2352     if { $id == -1 } {
2353
2354         global_window::active_controls 0
2355
2356     } else {
2357
2358         if { $id == 0 } {
2359
2360             global_window::active_controls [   \
2361                 expr                           \
2362                 $global_window::en_params    | \
2363                 $global_window::en_save      | \
2364                 $global_window::en_load      | \
2365                 $global_window::en_open      | \
2366                 $global_window::en_help      | \
2367                 $global_window::en_rotate    | \
2368                 $global_window::en_bright    | \
2369                 $global_window::en_pan       | \
2370                 $global_window::en_zoom      | \
2371                 $global_window::en_clear     | \
2372                 $global_window::en_intensity | \
2373                 $global_window::en_linear    | \
2374                 $global_window::en_area      | \
2375                 $global_window::en_back      | \
2376                 $global_window::en_wizard    | \
2377                 0
2378             ]
2379
2380         } elseif { $id == 1 } {
2381
2382             global_window::active_controls [   \
2383                 expr                           \
2384                 $global_window::en_quant     | \
2385                 $global_window::en_params    | \
2386                 $global_window::en_save      | \
2387                 $global_window::en_load      | \
2388                 $global_window::en_open      | \
2389                 $global_window::en_help      | \
2390                 $global_window::en_rotate    | \
2391                 $global_window::en_bright    | \
2392                 $global_window::en_pan       | \
2393                 $global_window::en_zoom      | \
2394                 $global_window::en_clear     | \
2395                 $global_window::en_intensity | \
2396                 $global_window::en_linear    | \
2397                 $global_window::en_area      | \
2398                 $global_window::en_back      | \
2399                 $global_window::en_wizard    | \
2400                 0
2401             ]
2402
2403         } elseif { $id == 2 } {
2404
2405             global_window::active_controls [   \
2406                 expr                           \
2407                 $global_window::en_quant     | \
2408                 $global_window::en_params    | \
2409                 $global_window::en_save      | \
2410                 $global_window::en_load      | \
2411                 $global_window::en_open      | \
2412                 $global_window::en_help      | \
2413                 $global_window::en_rotate    | \
2414                 $global_window::en_bright    | \
2415                 $global_window::en_pan       | \
2416                 $global_window::en_zoom      | \
2417                 $global_window::en_clear     | \
2418                 $global_window::en_intensity | \
2419                 $global_window::en_linear    | \
2420                 $global_window::en_area      | \
2421                 $global_window::en_back      | \
2422                 $global_window::en_excel     | \
2423                 $global_window::en_wizard    | \
2424                 0
2425             ]
2426
2427         }
2428
2429     }
2430
2431 }
2432
2433 proc planes_window::point_intensity { x y } {
2434
2435     # For programming facilities
2436     upvar planes_window::widgets widgets
2437
2438     set y [ expr [ lindex [ $widgets(work3D) configure -height ] 4 ] - $y - 1 ]
2439     catch { tmp_picker_$widgets(image2D) Delete }
2440     vtkWorldPointPicker tmp_picker_$widgets(image2D)
2441         set pickWP    [ tmp_picker_$widgets(image2D) Pick $x $y 0 renderer_$widgets(image2D) ]
2442         set pickWPPos [ tmp_picker_$widgets(image2D) GetPickPosition ]
2443     set x [ lindex [ split [ lindex $pickWPPos 0 ] . ] 0 ]
2444     set y [ lindex [ split [ lindex $pickWPPos 1 ] . ] 0 ]
2445     set y [ expr [ getCutSize_dll ] - $y - 1 ]
2446     set intensity [ getIntensityCut_dll  $x $y ]
2447
2448 }
2449
2450
2451 proc planes_window::refresh_quant { } {
2452
2453     # For programming facilities
2454     upvar planes_window::widgets widgets
2455     upvar planes_window::actual_quant_sten actual_quant_sten
2456     upvar planes_window::axis_index axis_index
2457     upvar planes_window::real_first_point_quant real_first_point_quant
2458     upvar planes_window::real_last_point_quant real_last_point_quant
2459
2460     if { $real_first_point_quant != -1 && $real_last_point_quant != -1 && [ llength $actual_quant_sten ] > 0 } {
2461
2462         set actual_quant_sten [ getStenosisQuant_dll ]
2463         set actual_sten [ change_float_precision [ lindex $actual_quant_sten [ expr [ $widgets(sclSlice) get ] - $real_first_point_quant ] ] 2 ]
2464
2465     }
2466     planes_window::update_blt_all_meassures
2467
2468 }
2469
2470 proc planes_window::pause { } {
2471
2472     # For programming facilities
2473     upvar planes_window::widgets    widgets
2474     upvar planes_window::quantifing quantifing
2475
2476     if { $quantifing == 1 } {
2477
2478         set quantifing 2
2479         $widgets(btnPause) configure -text $string_table::str_play
2480         backQuant_dll
2481
2482     } elseif { $quantifing == 2 } {
2483
2484         set quantifing 1
2485         $widgets(btnPause) configure -text $string_table::str_pause
2486
2487     }
2488
2489 }
2490
2491
2492 proc planes_window::clean3D { } {
2493
2494     # For programming facilities
2495     upvar planes_window::widgets widgets
2496     upvar planes_window::real_first_point_quant real_first_point_quant
2497     upvar planes_window::real_last_point_quant real_last_point_quant
2498     upvar planes_window::rings_index rings_index
2499     upvar planes_window::actual_area  actual_area
2500     upvar planes_window::actual_peri  actual_peri
2501     upvar planes_window::actual_darea actual_darea
2502     upvar planes_window::actual_dperi actual_dperi
2503     upvar planes_window::actual_dmax  actual_dmax
2504     upvar planes_window::actual_dmin  actual_dmin
2505     upvar planes_window::actual_davg  actual_davg
2506     upvar planes_window::actual_sten  actual_sten
2507     upvar planes_window::quant_shown  quant_shown
2508     upvar planes_window::actual_quant_x     actual_quant_x
2509     upvar planes_window::actual_quant_area  actual_quant_area
2510     upvar planes_window::actual_quant_peri  actual_quant_peri
2511     upvar planes_window::actual_quant_darea actual_quant_darea
2512     upvar planes_window::actual_quant_dperi actual_quant_dperi
2513     upvar planes_window::actual_quant_dmax  actual_quant_dmax
2514     upvar planes_window::actual_quant_dmin  actual_quant_dmin
2515     upvar planes_window::actual_quant_davg  actual_quant_davg
2516     upvar planes_window::actual_quant_sten  actual_quant_sten
2517     upvar planes_window::first_quant first_quant
2518
2519     set first_quant 1
2520     set real_first_point_quant -1
2521     set real_last_point_quant -1
2522     planes_window::controls 1
2523     set quant_shown 0
2524
2525     catch { renderer_$widgets(work3D) RemoveActor hs_actor_$widgets(work3D) }
2526     catch { hs_actor_$widgets(work3D) Delete }
2527     catch { hs_mapper_$widgets(work3D) Delete }
2528     catch { hs_grid_$widgets(work3D) Delete }
2529     catch { hs_points_$widgets(work3D) Delete }
2530     catch { hs_poly_line_$widgets(work3D) Delete }
2531     foreach i $rings_index {
2532
2533         catch { renderer_$widgets(work3D) RemoveActor cont3DActor_{$widgets(work3D)}_{$i} }
2534         catch { cont3DActor_{$widgets(work3D)}_{$i}    Delete }
2535         catch { cont3DMapper_{$widgets(work3D)}_{$i}   Delete }
2536         catch { cont3DGrid_{$widgets(work3D)}_{$i}     Delete }
2537         catch { cont3DPolyLine_{$widgets(work3D)}_{$i} Delete }
2538         catch { cont3DPoints_{$widgets(work3D)}_{$i}   Delete }
2539
2540     }
2541     set rings_index [ list ]
2542
2543 }
2544
2545 proc planes_window::erase_all_data { } {
2546
2547     # For programming facilities
2548     upvar planes_window::widgets widgets
2549     upvar planes_window::real_first_point_quant real_first_point_quant
2550     upvar planes_window::real_last_point_quant real_last_point_quant
2551     upvar planes_window::rings_index rings_index
2552     upvar planes_window::actual_area  actual_area
2553     upvar planes_window::actual_peri  actual_peri
2554     upvar planes_window::actual_darea actual_darea
2555     upvar planes_window::actual_dperi actual_dperi
2556     upvar planes_window::actual_dmax  actual_dmax
2557     upvar planes_window::actual_dmin  actual_dmin
2558     upvar planes_window::actual_davg  actual_davg
2559     upvar planes_window::actual_sten  actual_sten
2560     upvar planes_window::quant_shown  quant_shown
2561     upvar planes_window::actual_quant_x     actual_quant_x
2562     upvar planes_window::actual_quant_area  actual_quant_area
2563     upvar planes_window::actual_quant_peri  actual_quant_peri
2564     upvar planes_window::actual_quant_darea actual_quant_darea
2565     upvar planes_window::actual_quant_dperi actual_quant_dperi
2566     upvar planes_window::actual_quant_dmax  actual_quant_dmax
2567     upvar planes_window::actual_quant_dmin  actual_quant_dmin
2568     upvar planes_window::actual_quant_davg  actual_quant_davg
2569     upvar planes_window::actual_quant_sten  actual_quant_sten
2570     upvar planes_window::first_quant first_quant
2571
2572     set ans [ \
2573         tk_messageBox \
2574             -icon question \
2575             -message "$string_table::str_erase_quant_q" \
2576             -type yesno \
2577             -title "Question" \
2578     ]
2579
2580     if { [ string compare $ans yes ] == 0 } {
2581
2582         set first_quant 1
2583         set real_first_point_quant -1
2584         set real_last_point_quant -1
2585         planes_window::controls 1
2586         set quant_shown 0
2587         planes_window::clean_BLT
2588
2589         catch { renderer_$widgets(work3D) RemoveActor hs_actor_$widgets(work3D) }
2590         catch { hs_actor_$widgets(work3D) Delete }
2591         catch { hs_mapper_$widgets(work3D) Delete }
2592         catch { hs_grid_$widgets(work3D) Delete }
2593         catch { hs_points_$widgets(work3D) Delete }
2594         catch { hs_poly_line_$widgets(work3D) Delete }
2595         foreach i $rings_index {
2596
2597             catch { renderer_$widgets(work3D) RemoveActor cont3DActor_{$widgets(work3D)}_{$i} }
2598             catch { cont3DActor_{$widgets(work3D)}_{$i}    Delete }
2599             catch { cont3DMapper_{$widgets(work3D)}_{$i}   Delete }
2600             catch { cont3DGrid_{$widgets(work3D)}_{$i}     Delete }
2601             catch { cont3DPolyLine_{$widgets(work3D)}_{$i} Delete }
2602             catch { cont3DPoints_{$widgets(work3D)}_{$i}   Delete }
2603
2604         }
2605         set rings_index [ list ]
2606
2607         set actual_quant_x     [ list ]
2608         set actual_quant_area  [ list ]
2609         set actual_quant_peri  [ list ]
2610         set actual_quant_darea [ list ]
2611         set actual_quant_dperi [ list ]
2612         set actual_quant_dmax  [ list ]
2613         set actual_quant_dmin  [ list ]
2614         set actual_quant_davg  [ list ]
2615         set actual_quant_sten  [ list ]
2616
2617         set actual_area  0.00
2618         set actual_peri  0.00
2619         set actual_darea 0.00
2620         set actual_dperi 0.00
2621         set actual_dmax  0.00
2622         set actual_dmin  0.00
2623         set actual_davg  0.00
2624         set actual_sten  0.00
2625         set quant_shown  0
2626         [ $widgets(work3D) GetRenderWindow ] Render
2627
2628         planes_window::clean_contour
2629
2630         set ans [ \
2631             tk_messageBox \
2632                 -icon question \
2633                 -message "$string_table::str_erase_extracted_contours" \
2634                 -type yesno \
2635                 -title "Question" \
2636         ]
2637         if { [ string compare $ans yes ] == 0 } { cleanData_dll }
2638
2639     }
2640
2641 }
2642
2643 proc planes_window::reload_axis { mask step } {
2644
2645     # For programming facilities
2646     upvar planes_window::widgets      widgets
2647     upvar planes_window::axis_index   axis_index
2648     upvar planes_window::given_points given_points
2649     upvar planes_window::quant_shown  quant_shown
2650     upvar planes_window::shown        shown
2651     upvar planes_window::rings_index  rings_index
2652
2653     if { $step == 1 } {
2654
2655         redoAxisSpline_dll
2656         catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_quant1_$widgets(work3D) ] }
2657         catch { renderer_$widgets(work3D) RemoveActor [ GetSphereActorName sphere_quant2_$widgets(work3D) ] }
2658         DeleteSphere sphere_quant1_$widgets(work3D)
2659         DeleteSphere sphere_quant2_$widgets(work3D)
2660         set given_points 0
2661
2662     } elseif { $mask == 1 } { recalculeAxisSignal_dll }
2663
2664     if { ( $mask == 1 || $step == 1 ) && $shown == 1 } {
2665
2666         tk_messageBox \
2667             -icon info \
2668             -message "$string_table::str_quant_will_be_erased" \
2669             -type ok
2670
2671         catch { renderer_$widgets(work3D) RemoveActor hs_actor_$widgets(work3D) }
2672         catch { hs_actor_$widgets(work3D) Delete }
2673         catch { hs_mapper_$widgets(work3D) Delete }
2674         catch { hs_grid_$widgets(work3D) Delete }
2675         catch { hs_points_$widgets(work3D) Delete }
2676         catch { hs_poly_line_$widgets(work3D) Delete }
2677         foreach i $rings_index {
2678
2679             catch { renderer_$widgets(work3D) RemoveActor cont3DActor_{$widgets(work3D)}_{$i} }
2680             catch { cont3DActor_{$widgets(work3D)}_{$i}    Delete }
2681             catch { cont3DMapper_{$widgets(work3D)}_{$i}   Delete }
2682             catch { cont3DGrid_{$widgets(work3D)}_{$i}     Delete }
2683             catch { cont3DPolyLine_{$widgets(work3D)}_{$i} Delete }
2684             catch { cont3DPoints_{$widgets(work3D)}_{$i}   Delete }
2685
2686         }
2687         set rings_index [ list ]
2688
2689         set actual_area  0.00
2690         set actual_peri  0.00
2691         set actual_darea 0.00
2692         set actual_dperi 0.00
2693         set actual_dmax  0.00
2694         set actual_dmin  0.00
2695         set actual_davg  0.00
2696         set actual_sten  0.00
2697         set quant_shown  0
2698
2699         planes_window::clean_BLT
2700
2701         set first_quant 1
2702         set range    [ getIntensityRange_dll ]
2703         set resample [ getVTKSource_dll ]
2704         set bounds   [ $resample GetBounds ]
2705
2706         # Axis
2707         set points [ getAxis_dll ]
2708         set nP [ expr [ llength $points ] / 3 ]
2709         $widgets(sclSlice) configure \
2710             -from 0 \
2711             -to   [ expr [ getNumberOfAxisPoints_dll ] - 1 ] \
2712             -resolution 1
2713
2714         # Poly-line actor construction...
2715         catch { renderer_$widgets(work3D) RemoveActor axisActor_$widgets(work3D) }
2716         catch { axisActor_$widgets(work3D)    Delete }
2717         catch { axisMapper_$widgets(work3D)   Delete }
2718         catch { axisGrid_$widgets(work3D)     Delete }
2719         catch { axisPolyLine_$widgets(work3D) Delete }
2720         catch { axisPoints_$widgets(work3D)   Delete }
2721
2722         vtkPoints axisPoints_$widgets(work3D)
2723         vtkPolyLine axisPolyLine_$widgets(work3D)
2724         [ axisPolyLine_$widgets(work3D) GetPointIds ] SetNumberOfIds $nP
2725         set vox_size [ getActualVoxelSize_dll ]
2726         for { set i 0 } { $i < $nP } { incr i } {
2727
2728             [ axisPolyLine_$widgets(work3D) GetPointIds ] SetId $i $i
2729             set p [ \
2730                 PointCoord \
2731                 [ lindex $points [ expr $i * 3 + 0 ] ] \
2732                 [ lindex $points [ expr $i * 3 + 1 ] ] \
2733                 [ lindex $points [ expr $i * 3 + 2 ] ] \
2734                 [ lindex $bounds 0 ] \
2735                 [ lindex $bounds 2 ] \
2736                 [ lindex $bounds 4 ] \
2737                 $vox_size $vox_size $vox_size \
2738             ]
2739             axisPoints_$widgets(work3D) InsertNextPoint [ lindex $p 0 ] [ lindex $p 1 ] [ lindex $p 2 ]
2740
2741         }
2742
2743         vtkUnstructuredGrid axisGrid_$widgets(work3D)
2744             axisGrid_$widgets(work3D) Allocate 1 1
2745             axisGrid_$widgets(work3D) InsertNextCell \
2746                 [ axisPolyLine_$widgets(work3D) GetCellType ] \
2747                 [ axisPolyLine_$widgets(work3D) GetPointIds ]
2748                 axisGrid_$widgets(work3D) SetPoints axisPoints_$widgets(work3D)
2749
2750         vtkDataSetMapper axisMapper_$widgets(work3D)
2751             axisMapper_$widgets(work3D) SetInput axisGrid_$widgets(work3D)
2752             axisMapper_$widgets(work3D) ImmediateModeRenderingOn
2753
2754         vtkActor axisActor_$widgets(work3D)
2755             axisActor_$widgets(work3D) SetMapper axisMapper_$widgets(work3D)
2756             [ axisActor_$widgets(work3D) GetProperty] BackfaceCullingOn
2757             [ axisActor_$widgets(work3D) GetProperty] SetDiffuseColor 1 0 0
2758
2759         renderer_$widgets(work3D) AddActor axisActor_$widgets(work3D)
2760
2761         [ $widgets(work3D) GetRenderWindow ] Render
2762         [ $widgets(image2D) GetRenderWindow ] Render
2763
2764         renderer_$widgets(work3D) AddActor outlineActor_$widgets(work3D)
2765         planes_window::controls 0
2766
2767     }
2768     if { $given_points == 1 } {
2769
2770         planes_window::controls 1
2771
2772     }
2773     if { $quant_shown == 1 } {
2774
2775         planes_window::update_blt_all_meassures
2776
2777     }
2778
2779 }
2780
2781 proc planes_window::load_reconstructed_surface { typ } {
2782
2783     # For programming facilities
2784     upvar planes_window::widgets                widgets
2785     upvar planes_window::axis_index             axis_index
2786     upvar planes_window::real_first_point_quant real_first_point_quant
2787     upvar planes_window::real_last_point_quant  real_last_point_quant
2788
2789     catch { renderer_$widgets(work3D) RemoveActor surfaceActor_rec_$widgets(work3D) }
2790     catch { surfaceActor_rec_$widgets(work3D) Delete }
2791     catch { map_rec_$widgets(work3D)          Delete }
2792     catch { reverse_rec_$widgets(work3D)      Delete }
2793     catch { cf_rec_$widgets(work3D)           Delete }
2794     catch { surf_rec_$widgets(work3D)         Delete }
2795     catch { source_rec_$widgets(work3D)       Delete }
2796     catch { cells_rec_$widgets(work3D)        Delete }
2797     catch { points_rec_$widgets(work3D)       Delete }
2798
2799     if { $typ == 1 } {
2800
2801         vtkPoints    points_rec_$widgets(work3D)
2802         vtkCellArray cells_rec_$widgets(work3D)
2803         set f [ getFirstSlice_dll ]
2804         set l [ getLastSlice_dll ]
2805
2806         set k 0
2807         for { set i $f } { $i < $l } { incr i } {
2808
2809             set points3D [ get3DContour_dll $i ]
2810             set nP [ expr [ llength $points3D ] / 3 ]
2811             for { set j 0 } { $j < $nP } { incr j } {
2812
2813                 points_rec_$widgets(work3D) InsertNextPoint \
2814                     [ lindex $points3D [ expr $j * 3 + 0 ] ] \
2815                     [ lindex $points3D [ expr $j * 3 + 1 ] ] \
2816                     [ lindex $points3D [ expr $j * 3 + 2 ] ]
2817                 cells_rec_$widgets(work3D) InsertNextCell 0
2818                 cells_rec_$widgets(work3D) InsertCellPoint $k
2819                 incr k
2820
2821             }
2822
2823         }
2824
2825         vtkPolyData source_rec_$widgets(work3D)
2826             source_rec_$widgets(work3D) SetPoints points_rec_$widgets(work3D)
2827             source_rec_$widgets(work3D) SetPolys cells_rec_$widgets(work3D)
2828
2829         vtkSurfaceReconstructionFilter surf_rec_$widgets(work3D)
2830             surf_rec_$widgets(work3D) SetInput source_rec_$widgets(work3D)
2831             surf_rec_$widgets(work3D) SetSampleSpacing 0.05
2832
2833         vtkMarchingCubes cf_rec_$widgets(work3D)
2834 #        vtkContourFilter cf_rec_$widgets(work3D)
2835             cf_rec_$widgets(work3D) SetInput [ surf_rec_$widgets(work3D) GetOutput ]
2836             cf_rec_$widgets(work3D) SetValue 0 0.0
2837
2838         vtkReverseSense reverse_rec_$widgets(work3D)
2839             reverse_rec_$widgets(work3D) SetInput [ cf_rec_$widgets(work3D) GetOutput ]
2840             reverse_rec_$widgets(work3D) ReverseCellsOn
2841             reverse_rec_$widgets(work3D) ReverseNormalsOn
2842
2843         vtkPolyDataMapper map_rec_$widgets(work3D)
2844             map_rec_$widgets(work3D) SetInput [ reverse_rec_$widgets(work3D) GetOutput ]
2845             map_rec_$widgets(work3D) ScalarVisibilityOff
2846
2847         vtkActor surfaceActor_rec_$widgets(work3D)
2848             surfaceActor_rec_$widgets(work3D) SetMapper map_rec_$widgets(work3D)
2849             [ surfaceActor_rec_$widgets(work3D) GetProperty ] SetDiffuseColor 0.5 0.3882 0.2784
2850             [ surfaceActor_rec_$widgets(work3D) GetProperty ] SetSpecularColor 1 1 1
2851             [ surfaceActor_rec_$widgets(work3D) GetProperty ] SetSpecular .4
2852             [ surfaceActor_rec_$widgets(work3D) GetProperty ] SetSpecularPower 50
2853
2854         renderer_$widgets(work3D) AddActor surfaceActor_rec_$widgets(work3D)
2855
2856     }
2857     [ $widgets(work3D) GetRenderWindow ] Render
2858
2859 }
2860
2861 proc planes_window::show_max_min_diameters { } {
2862
2863     # For programming facilities
2864     upvar planes_window::widgets widgets
2865
2866     set slice [ $widgets(sclSlice) get ]
2867     set lmax [ getMaximumLine_dll ]
2868     set lmin [ getMinimumLine_dll ]
2869
2870     catch { renderer_$widgets(image2D) RemoveActor dMax_actor_$widgets(image2D) }
2871     catch { renderer_$widgets(image2D) RemoveActor dMin_actor_$widgets(image2D) }
2872     catch { dMax_actor_$widgets(image2D)   Delete }
2873     catch { dMax_mapper_$widgets(image2D) Delete }
2874     catch { dMax_line_$widgets(image2D)   Delete }
2875     catch { dMin_actor_$widgets(image2D)   Delete }
2876     catch { dMin_mapper_$widgets(image2D) Delete }
2877     catch { dMin_line_$widgets(image2D)   Delete }
2878
2879     vtkLineSource dMax_line_$widgets(image2D)
2880         dMax_line_$widgets(image2D) SetPoint1 [ lindex $lmax 0 ] [ lindex $lmax 1 ] 0.0
2881         dMax_line_$widgets(image2D) SetPoint2 [ lindex $lmax 2 ] [ lindex $lmax 3 ] 0.0
2882     vtkPolyDataMapper dMax_mapper_$widgets(image2D)
2883         dMax_mapper_$widgets(image2D) SetInput [ dMax_line_$widgets(image2D) GetOutput ]
2884         dMax_mapper_$widgets(image2D) ImmediateModeRenderingOn
2885     vtkActor dMax_actor_$widgets(image2D)
2886         dMax_actor_$widgets(image2D) SetMapper dMax_mapper_$widgets(image2D)
2887         [ dMax_actor_$widgets(image2D) GetProperty ] SetColor  1.00 0.00 0.00
2888
2889     vtkLineSource dMin_line_$widgets(image2D)
2890         dMin_line_$widgets(image2D) SetPoint1 [ lindex $lmin 0 ] [ lindex $lmin 1 ] 0.0
2891         dMin_line_$widgets(image2D) SetPoint2 [ lindex $lmin 2 ] [ lindex $lmin 3 ] 0.0
2892     vtkPolyDataMapper dMin_mapper_$widgets(image2D)
2893         dMin_mapper_$widgets(image2D) SetInput [ dMin_line_$widgets(image2D) GetOutput ]
2894         dMin_mapper_$widgets(image2D) ImmediateModeRenderingOn
2895     vtkActor dMin_actor_$widgets(image2D)
2896         dMin_actor_$widgets(image2D) SetMapper dMin_mapper_$widgets(image2D)
2897         [ dMin_actor_$widgets(image2D) GetProperty ] SetColor  0.00 0.00 1.00
2898
2899     array set arr [ params_dll 0 ]
2900     if { $arr(e_debug_diameters) == 1 } {
2901
2902         renderer_$widgets(image2D) AddActor dMax_actor_$widgets(image2D)
2903         renderer_$widgets(image2D) AddActor dMin_actor_$widgets(image2D)
2904
2905     }
2906     [ $widgets(image2D) GetRenderWindow ] Render
2907
2908 }
2909
2910 proc planes_window::back { } {
2911
2912     # For programming facilities
2913     upvar planes_window::shown shown
2914
2915     set ret $shown
2916     set shown 0
2917
2918     return $ret
2919
2920 }
2921
2922 proc planes_window::set_quant_point_from_scale { } {
2923
2924     # For programming facilities
2925     upvar planes_window::widgets widgets
2926
2927     set slice [ $widgets(sclSlice) get ]
2928     planes_window::select_axis_point 0 0 $slice
2929
2930 }
2931
2932 # EOF - planes_window.tcl