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

   1 package require ibrowser
   2 package require imagepp
   3 package require BLT
   4 catch { namespace import ibrowser::* }
   5 catch { namespace import imagepp::* }
   6 catch { namespace import blt::* }
   7
   8 namespace eval image_browser {
   9
  10     # public interface
  11     namespace export        \
  12         create              \
  13         positionate         \
  14         forget              \
  15         get_images          \
  16         get_real_images
  17
  18     # variables
  19     variable widgets
  20
  21     variable first_image -1
  22     variable last_image -1
  23     variable image_width  -1
  24     variable image_height -1
  25     variable mip_raised    0
  26     variable actual_image
  27     variable local_id
  28     variable shown
  29     variable return_nothing 0
  30
  31 }
  32
  33 proc image_browser::reset { parent } {
  34
  35     # For programming facilities
  36     upvar image_browser::widgets widgets
  37
  38     set widgets(base)       "$parent"
  39     set widgets(image_brw)  "$parent\.images"
  40     set widgets(bottom_brw) "$parent\.images.02"
  41     set widgets(vert_split) "$parent\.images.03"
  42     set widgets(right_brw)  "$parent\.images.02.02"
  43     set widgets(horz_split) "$parent\.images.02.03"
  44     set widgets(type)       "$parent\.images.02.02.type"
  45     set widgets(ibrw)       "$parent\.images.01"
  46     set widgets(impp)       "$parent\.images.02.01"
  47     set widgets(btnSerie)   "$parent\.images.02.02.type.btnSerie"
  48     set widgets(btnMIP)     "$parent\.images.02.02.type.btnMIP"
  49     set widgets(lbl001)     "$parent\.images.02.02.lbl001"
  50     set widgets(sclSerie)   "$parent\.images.02.02.sclSerie"
  51
  52 }
  53
  54 proc image_browser::create { parent id } {
  55
  56     # For programming facilities
  57     upvar image_browser::widgets widgets
  58     upvar image_browser::image_width  image_width
  59     upvar image_browser::image_height image_height
  60     upvar image_browser::mip_raised   mip_raised
  61     upvar image_browser::local_id  local_id
  62     upvar image_browser::shown     shown
  63
  64     set local_id $id
  65     image_browser::reset $parent
  66     set shown 0
  67
  68     # frames
  69     frame $widgets(image_brw)  -height 1 -width 1
  70     frame $widgets(bottom_brw) -borderwidth 1 -relief groove
  71     frame $widgets(right_brw)  -borderwidth 1 -relief groove
  72     frame $widgets(type)       -borderwidth 2 -height 75 -relief groove -width 125
  73     frame $widgets(horz_split) -borderwidth 2 -relief raised
  74     frame $widgets(vert_split) -borderwidth 2 -relief raised
  75
  76     # radio buttons
  77     set mip_raised 0
  78     radiobutton $widgets(btnSerie) -text $string_table::str_serie -variable var_type -value 1 -command "image_browser::cb_load_serie"
  79     radiobutton $widgets(btnMIP)   -text $string_table::str_mip   -variable var_type -value 2 -command "image_browser::cb_load_mip"
  80
  81     # labels
  82     label $widgets(lbl001) -borderwidth 0 -text $string_table::str_showtype
  83
  84     # scales
  85     scale $widgets(sclSerie) -label $string_table::str_series -orient horizontal
  86
  87     # split bindings
  88     bind $widgets(horz_split) <B1-Motion> {
  89         set root [ split %W . ]
  90         set nb [ llength $root ]
  91         incr nb -1
  92         set root [ lreplace $root $nb $nb ]
  93         set root [ join $root . ]
  94         set width [ winfo width $root ].0
  95         set val [ expr (%X - [winfo rootx $root]) /$width ]
  96         if { $val >= 0 && $val <= 1.0 } {
  97             place $root.01 -relwidth $val
  98             place $root.03 -relx $val
  99             place $root.02 -relwidth [ expr 1.0 - $val ]
 100         }
 101     }
 102     bind $widgets(vert_split) <B1-Motion> {
 103         set root [ split %W . ]
 104         set nb [ llength $root ]
 105         incr nb -1
 106         set root [ lreplace $root $nb $nb ]
 107         set root [ join $root . ]
 108         set height [ winfo height $root ].0
 109         set val [ expr (%Y - [winfo rooty $root]) /$height ]
 110         if { $val >= 0 && $val <= 1.0 } {
 111             place $root.01 -relheight $val
 112             place $root.03 -rely $val
 113             place $root.02 -relheight [ expr 1.0 - $val ]
 114         }
 115     }
 116
 117 }
 118
 119 proc image_browser::positionate { } {
 120
 121     # For programming facilities
 122     upvar image_browser::widgets      widgets
 123     upvar image_browser::image_width  image_width
 124     upvar image_browser::image_height image_height
 125     upvar image_browser::mip_raised   mip_raised
 126     upvar image_browser::local_id     local_id
 127     upvar image_browser::shown     shown
 128     upvar image_browser::return_nothing return_nothing
 129
 130     set return_nothing 0
 131     set shown 1
 132     set global_window::window_shown $local_id
 133
 134     pack  $widgets(image_brw)  -anchor n -expand 1 -fill both -side top
 135     place $widgets(ibrw)       -x 0 -y 0 -relwidth 1 -height -1 -relheight 0.25 -anchor nw -bordermode ignore
 136     place $widgets(bottom_brw) -x 0 -y 0 -rely 1 -relwidth 1 -height -1 -relheight 0.75 -anchor sw -bordermode ignore
 137     place $widgets(impp)       -x 0 -y 0 -width -1 -relwidth 0.75 -relheight 1 -anchor nw -bordermode ignore
 138     place $widgets(right_brw)  -x 0 -relx 1 -y 0 -width -1 -relwidth 0.25 -relheight 1 -anchor ne -bordermode ignore
 139     place $widgets(type)       -x 15 -y 60 -width 110 -height 65 -anchor nw -bordermode ignore
 140     place $widgets(btnSerie)   -x 20 -y 10 -anchor nw -bordermode ignore
 141     place $widgets(btnMIP)     -x 20 -y 35 -anchor nw -bordermode ignore
 142     place $widgets(lbl001)     -x 20 -y 50 -anchor nw -bordermode ignore
 143     place $widgets(sclSerie)   -x 15 -y 130 -width 200 -anchor nw -bordermode ignore
 144     place $widgets(horz_split) -x 0 -relx 0.75 -y 0 -rely 0.9 -width 10 -height 10 -anchor s -bordermode ignore
 145     place $widgets(vert_split) -x 0 -relx 0.9 -y 0 -rely 0.25 -width 10 -height 10 -anchor e -bordermode ignore
 146
 147     image_browser::controls 0
 148
 149 }
 150
 151 proc image_browser::forget { } {
 152
 153     # For programming facilities
 154     upvar image_browser::widgets      widgets
 155     upvar image_browser::image_width  image_width
 156     upvar image_browser::image_height image_height
 157     upvar image_browser::mip_raised   mip_raised
 158     upvar image_browser::shown     shown
 159
 160     set shown 0
 161
 162     place forget $widgets(vert_split)
 163     place forget $widgets(horz_split)
 164     place forget $widgets(sclSerie)
 165     place forget $widgets(lbl001)
 166     place forget $widgets(btnMIP)
 167     place forget $widgets(btnSerie)
 168     place forget $widgets(type)
 169     place forget $widgets(right_brw)
 170     catch { place forget $widgets(impp) }
 171     place forget $widgets(bottom_brw)
 172     catch { place forget $widgets(ibrw) }
 173     pack  forget $widgets(image_brw)
 174
 175 }
 176
 177 proc image_browser::set_data { } {
 178
 179     # For programming facilities
 180     upvar image_browser::widgets  widgets
 181     upvar image_browser::local_id local_id
 182
 183     set global_window::data_loaded [ expr $global_window::data_loaded | $local_id ]
 184
 185     catch {
 186
 187         set data [ $widgets(ibrw) curselection ]
 188         $widgets(ibrw) delete -tags "delete"
 189
 190     }
 191
 192     # image browser
 193     destroy $widgets(ibrw)
 194     ibrowser $widgets(ibrw)     \
 195         -borderwidth    1       \
 196         -cache          1       \
 197         -fontcolor      #ffff00 \
 198         -gap            5       \
 199         -height         1       \
 200         -multisel       1       \
 201         -primarycolor   #ff0000 \
 202         -relief         groove  \
 203         -secondarycolor #00ff00 \
 204         -thumbheight    100     \
 205         -thumbwidth     100     \
 206         -width          1
 207     bind $widgets(ibrw) <<AfterSelectFirstImage>> "image_browser::select_image 0"
 208     bind $widgets(ibrw) <<AfterSelectLastImage>> "image_browser::select_image 1"
 209
 210     # image pp
 211     destroy $widgets(impp)
 212     imagepp $widgets(impp)           \
 213         -borderwidth 1               \
 214         -height      10              \
 215         -initialroi  "10 10 100 100" \
 216         -relief      groove          \
 217         -takefocus   0               \
 218         -width       10
 219     bind $widgets(impp) <<AfterProfil>> "image_browser::do_profil"
 220
 221     array set ser_data [ serieData_dll $data_browser::sel_study $data_browser::sel_serie ]
 222     global_window::set_window_title "$ser_data(ID_Patient_Name) - $data_browser::sel_study/$data_browser::sel_serie"
 223     LoadImages_dll
 224     set n [ GetNumberOfImages_dll ]
 225     set tkNames {}
 226     for { set i 0 } { $i < $n } { incr i } { lappend tkNames [ image create photo ] }
 227     set numbers [ GetImagesNumbers_dll ]
 228     LoadTkImages_dll $tkNames
 229     set image_browser::first_image -1
 230     set image_browser::last_image -1
 231
 232     set i 0
 233     set fN 0
 234     set lN 0
 235     foreach number $numbers {
 236
 237         if { $i == 0 } { set fN $number }
 238         set lN $number
 239         set imgTK [ lindex $tkNames $i ]
 240         $widgets(ibrw) add                    \
 241             -image $imgTK                     \
 242             -tags "id_$i delete" \
 243             -title "$number"
 244         $widgets(impp) add -image $imgTK -id "id_$i"
 245
 246         incr i
 247
 248     }
 249
 250     set image_width  [ image width $imgTK ]
 251     set image_height [ image height $imgTK ]
 252
 253     $widgets(impp) configure -initialroi "[ expr $image_width * 0.3 ] [ expr $image_height * 0.3 ] [ expr $image_width * 0.7 ] [ expr $image_height * 0.7 ]"
 254     $widgets(impp) resetroi
 255
 256     array set arr [ params_dll ]
 257
 258     $widgets(ibrw) select -tags "id_0"
 259     set image_browser::first_image $fN
 260     if { $arr(e_choose_all_slices_default) == 1 } {
 261
 262         $widgets(ibrw) select -tags "id_[ expr $i - 1 ]" -secondary
 263         set image_browser::last_image $lN
 264
 265     }
 266
 267     $widgets(btnSerie) deselect
 268     $widgets(btnMIP)   deselect
 269
 270     if { $arr(e_calculate_mip_default) == 0 } { $widgets(btnSerie) invoke }
 271     if { $arr(e_calculate_mip_default) == 1 } { $widgets(btnMIP)   invoke }
 272
 273     $widgets(sclSerie) configure                                         \
 274         -label "$string_table::str_series : $ser_data(ID_Series_Number)" \
 275         -from $fN                                                        \
 276         -to   $lN                                                        \
 277         -command "image_browser::select_first_image" \
 278         -resolution 1
 279     $widgets(sclSerie) set $fN
 280
 281 #    bind $widgets(sclSerie) <ButtonRelease-1> "image_browser::select_first_image"
 282
 283     image_browser::controls 0
 284
 285     global_window::deselect_buttons
 286     global_window::invoke_buttons [ expr \
 287         $global_window::en_clear     | \
 288         $global_window::en_intensity   \
 289     ]
 290
 291 }
 292
 293 proc image_browser::select_first_image { n } {
 294
 295     # For programming facilities
 296     upvar image_browser::widgets widgets
 297
 298 #    set n [ $widgets(sclSerie) get ]
 299     set f [ $widgets(sclSerie) cget -from ]
 300     set i [ expr $n - $f ]
 301     set i [ lindex [ split $i . ] 0 ]
 302     $widgets(impp) show -id "id_$i"
 303 #    $widgets(ibrw) select -tags "id_$i"
 304
 305 }
 306
 307 proc image_browser::cb_load_mip { } {
 308
 309     # For programming facilities
 310     upvar image_browser::widgets widgets
 311     upvar image_browser::mip_raised mip_raised
 312     upvar image_browser::actual_image actual_image
 313
 314     set mip_raised 1
 315     set datas [ $widgets(ibrw) curselection ]
 316     set images [ list ]
 317     foreach data $datas { lappend images [ lindex [ lindex $data 2 ] 2 ] }
 318     set mip [ loadMIPZ_dll $images ]
 319     set actual_image $mip
 320     set imgTK [ image create photo ]
 321     loadTKimage_dll $mip $imgTK
 322     $widgets(impp) add -image $imgTK -id mip
 323
 324 }
 325
 326 proc image_browser::cb_load_serie { } {
 327
 328     # For programming facilities
 329     upvar image_browser::widgets widgets
 330     upvar image_browser::mip_raised mip_raised
 331     upvar image_browser::actual_image actual_image
 332
 333     # $sclSerie configure -state normal
 334     set mip_raised 0
 335     set image [ $widgets(ibrw) lastimage ]
 336     set actual_image [ lindex [ lindex $image 2 ] 2 ]
 337     set id [ lindex $image 0 ]
 338     $widgets(impp) show -id $id
 339
 340 }
 341
 342 proc image_browser::select_image { i } {
 343
 344     # For programming facilities
 345     upvar image_browser::widgets widgets
 346     upvar image_browser::mip_raised mip_raised
 347
 348     if { $mip_raised == 0 } { cb_load_serie }
 349     if { $mip_raised == 1 } { cb_load_mip }
 350     set image [ $widgets(ibrw) lastimage ]
 351     set pos [ expr [ lindex [ split [ lindex [ lindex $image 2 ] 0 ] _ ] 1 ] + [ $widgets(sclSerie) cget -from ] ]
 352     $widgets(sclSerie) set $pos
 353
 354     if { $i == 0 } { set image_browser::first_image $pos }
 355     if { $i == 1 } { set image_browser::last_image $pos }
 356     puts "$image_browser::first_image : $image_browser::last_image"
 357
 358 }
 359
 360 proc image_browser::set_data2 { } {
 361
 362     # For programming facilities
 363     upvar image_browser::return_nothing return_nothing
 364
 365     set return_nothing 1
 366
 367 }
 368
 369 proc image_browser::get_data { } {
 370
 371     # For programming facilities
 372     upvar image_browser::widgets widgets
 373     upvar image_browser::mip_raised mip_raised
 374     upvar image_browser::return_nothing return_nothing
 375
 376     if { $return_nothing == 0 } {
 377
 378         set fr [ string trimleft [ $widgets(sclSerie) cget -from ] 0 ]
 379         set f  [ string trimleft $image_browser::first_image 0 ]
 380         set l  [ string trimleft $image_browser::last_image 0 ]
 381
 382         set f [ expr $f - $fr ]
 383         set l [ expr $l - $fr ]
 384
 385         set f [ expr ( $f < $l )? $f: $l ]
 386         set l [ expr ( $f > $l )? $f: $l ]
 387
 388         set data [ $widgets(ibrw) curselection ]
 389         set roi  [ $widgets(impp) roi ]
 390         set roi  [ list \
 391             [ lindex [ split [ lindex $roi 0 ] . ] 0 ] \
 392             [ lindex [ split [ lindex $roi 2 ] . ] 0 ] \
 393             [ lindex [ split [ lindex $roi 1 ] . ] 0 ] \
 394             [ lindex [ split [ lindex $roi 3 ] . ] 0 ] \
 395             [ lindex [ split $f . ] 0 ] \
 396             [ lindex [ split $l . ] 0 ] \
 397         ]
 398
 399         return $roi
 400
 401     } else { return "" }
 402
 403 }
 404
 405 proc image_browser::set_mouse_left_events { mask } {
 406
 407     # For programming facilities
 408     upvar image_browser::widgets widgets
 409
 410     if { [ expr ( $mask & 0x1 ) ] == 0x1 }  { $widgets(impp) setnone }
 411
 412 }
 413
 414 proc image_browser::set_mouse_right_events { mask } {
 415
 416     # For programming facilities
 417     upvar image_browser::widgets widgets
 418
 419     if { [ expr ( $mask & 0x1 ) ] == 0x1 }  { catch { $widgets(impp) setarea } }
 420     if { [ expr ( $mask & 0x2 ) ] == 0x2 }  { catch { $widgets(impp) setlinear } }
 421
 422 }
 423
 424 proc image_browser::clear { } {
 425
 426     # For programming facilities
 427     upvar image_browser::widgets widgets
 428
 429     catch { $widgets(impp) clean }
 430
 431 }
 432
 433 proc image_browser::do_profil { } {
 434
 435     # For programming facilities
 436     upvar image_browser::widgets widgets
 437     upvar image_browser::actual_image actual_image
 438
 439     set data [ $widgets(impp) getprofildata ]
 440
 441     if { [ lindex $data 0 ] == 1 } {
 442
 443         busy hold .
 444         update
 445
 446         set n [ $widgets(sclSerie) get ]
 447         set f [ $widgets(sclSerie) cget -from ]
 448         set i [ expr $n - $f ]
 449         set i [ lindex [ split $i . ] 0 ]
 450         set avals [ GetProfilFromTotalVolume_dll [ lindex $data 1 ] [ lindex $data 2 ] $i [ lindex $data 3 ] [ lindex $data 4 ] $i ]
 451         #avals[ 0 ] = min
 452         #avals[ 1 ] = max
 453         #avals[ 2 ] = avg
 454         #avals[ 3 ] = sd
 455         #avals[ 4 ] = size
 456         set xvals {}
 457         set yvals {}
 458         set size [ lindex $avals 4 ]
 459         for { set i 0 } { $i < $size } { incr i } {
 460
 461             lappend xvals $i
 462             lappend yvals [ lindex $avals [ expr $i + 5 ] ]
 463
 464         }
 465
 466         catch { destroy "$widgets(impp)\.fnProfil" }
 467         toplevel "$widgets(impp)\.fnProfil" -width 640 -height 480
 468
 469         graph $widgets(impp)\.fnProfil.gr \
 470             -background white \
 471             -barmode infront \
 472             -borderwidth 0 \
 473             -foreground black \
 474             -halo 8 \
 475             -height 480 \
 476             -plotpadx {8 8} \
 477             -plotpady {8 8} \
 478             -plotrelief groove \
 479             -width 640
 480         pack $widgets(impp)\.fnProfil.gr -anchor center -expand 1 -fill both -side top
 481         $widgets(impp)\.fnProfil.gr axis configure y -min 0.00
 482         $widgets(impp)\.fnProfil.gr grid configure  -hide no
 483         $widgets(impp)\.fnProfil.gr legend configure -position bottom -font {Helvetica -14 bold}
 484
 485         $widgets(impp)\.fnProfil.gr element create "Profile" \
 486             -color #0000ff \
 487             -symbol "" \
 488             -xdata $xvals \
 489             -ydata $yvals
 490
 491         set x [ expr $size / 2 ]
 492         set y [ expr [ lindex $avals 1 ] * 0.75 ]
 493         set text "$string_table::str_min = [ lindex $avals 0 ]\n$string_table::str_max = [ lindex $avals 1 ]\n$string_table::str_avg = [ lindex $avals 2 ]\n$string_table::str_std = [ lindex $avals 3 ]\n$string_table::str_nro_pix = [ lindex $avals 4 ]"
 494         $widgets(impp)\.fnProfil.gr marker create text -text $text \
 495             -coords "$x $y" -font { Helvetica 20 }
 496
 497         busy release .
 498         update
 499
 500     } elseif { [ lindex $data 0 ] == 2 } {
 501
 502         busy hold .
 503         update
 504         set n [ $widgets(sclSerie) get ]
 505         set f [ $widgets(sclSerie) cget -from ]
 506         set i [ expr $n - $f ]
 507         set i [ lindex [ split $i . ] 0 ]
 508         set avals [ GetAreaValuesFromTotalVolume_dll [ lindex $data 1 ] [ lindex $data 2 ] $i [ lindex $data 3 ] [ lindex $data 4 ] $i ]
 509         $widgets(impp) addtext "$string_table::str_min = [ lindex $avals 0 ]\n$string_table::str_max = [ lindex $avals 1 ]\n$string_table::str_avg = [ lindex $avals 2 ]\n$string_table::str_std = [ lindex $avals 3 ]\n$string_table::str_nro_pix = [ lindex $avals 4 ]" [ lindex $data 3 ] [ lindex $data 4 ]
 510         busy release .
 511         update
 512
 513     } elseif { [ lindex $data 0 ] == 3 } {
 514
 515         set n [ $widgets(sclSerie) get ]
 516         set f [ $widgets(sclSerie) cget -from ]
 517         set i [ expr $n - $f ]
 518         set i [ lindex [ split $i . ] 0 ]
 519         set val [ GetImageIntensity_dll [ lindex $data 3 ] [ lindex $data 4 ] $i ]
 520         $widgets(impp) addtext "$string_table::str_int = $val" [ lindex $data 3 ] [ lindex $data 4 ]
 521
 522     } elseif { [ lindex $data 0 ] == 4 } {
 523
 524         $widgets(impp) clean
 525
 526     }
 527
 528 }
 529
 530 proc image_browser::back { } {
 531
 532     # For programming facilities
 533     upvar image_browser::shown shown
 534
 535     set ret $shown
 536     set shown 0
 537
 538     return $ret
 539
 540 }
 541
 542 proc image_browser::controls { { id -1 } } {
 543
 544     if { $id == -1 } {
 545
 546         global_window::active_controls 0
 547
 548     } else {
 549
 550         if { $id == 0 } {
 551
 552             global_window::active_controls [   \
 553                 expr                           \
 554                 $global_window::en_3D        | \
 555                 $global_window::en_params    | \
 556                 $global_window::en_save      | \
 557                 $global_window::en_load      | \
 558                 $global_window::en_open      | \
 559                 $global_window::en_help      | \
 560                 $global_window::en_clear     | \
 561                 $global_window::en_intensity | \
 562                 $global_window::en_linear    | \
 563                 $global_window::en_area      | \
 564                 $global_window::en_back      | \
 565                 0
 566             ]
 567
 568         } elseif { $id == 1 } {
 569
 570             global_window::active_controls [   \
 571                 expr                           \
 572                 $global_window::en_params    | \
 573                 $global_window::en_save      | \
 574                 $global_window::en_load      | \
 575                 $global_window::en_open      | \
 576                 $global_window::en_help      | \
 577                 $global_window::en_clear     | \
 578                 $global_window::en_intensity | \
 579                 $global_window::en_linear    | \
 580                 $global_window::en_area      | \
 581                 $global_window::en_back      | \
 582                 0
 583             ]
 584
 585         }
 586
 587     }
 588
 589 }
 590
 591 # EOF - image_browser.tcl