lib/maracasVisuLib/src/interface/tcl/tkwidgets/imagepp.tcl

   1 #*************************************************************************
   2 #*                                  *                                    *
   3 #* NAME     : imagepp.tcl           * PROJECT  : MARACAS                 *
   4 #* AUTHOR   : Leonardo Flórez/Kyron * TYPE     : TCL/TK widget def.      *
   5 #* VERSION  : v1.0                  * CREATION : 06/05/2001              *
   6 #* LANGUAGE : TCL                   * REVISION : 16/07/2001              *
   7 #*                                  *                                    *
   8 #*************************************************************************
   9 #*                                                                       *
  10 #*  Description : This file defines a new TCL/TK widget that allows the  *
  11 #*                user to work with an image, it's a viewer. It has a    *
  12 #*                dinamical scroll bar, so, don't worry about use one.   *
  13 #*                                                                       *
  14 #*  The basic use of this widget is:                                     *
  15 #*                                                                       *
  16 #*      1. Create a new widget: "imagepp <name> <options>"               *
  17 #*         Options given are a list of '-<option> <value>' pairs.        *
  18 #*         Supported options are:                                        *
  19 #*         +-----------------+--------------------------------------+    *
  20 #*         | OPTION          | DESCRIPTION                          |    *
  21 #*         +-----------------+--------------------------------------+    *
  22 #*         |  -background    | Background color.                    |    *
  23 #*         |  -borderwidth   | Border width.                        |    *
  24 #*         |  -height        | Height.                              |    *
  25 #*         +-----------------+--------------------------------------+    *
  26 #*         |  -initialroi    | Initial Region Of Interest.          |    *
  27 #*         |  -relief        | Relief.                              |    *
  28 #*         |  -takefocus     | Take focus?                          |    *
  29 #*         +-----------------+--------------------------------------+    *
  30 #*         |  -width         | Width                                |    *
  31 #*         +-----------------+--------------------------------------+    *
  32 #*                                                                       *
  33 #*      2. Pack this new widget in your hierarchy:                       *
  34 #*         (pack/place/grid) <name> <pack options>                       *
  35 #*                                                                       *
  36 #*      3. Interact with the new widget by using their sub-commands      *
  37 #*         interface. Sub-commands defined are:                          *
  38 #*         add , addtext, cget, clean, configure, delete,                *
  39 #*         find, getprofildata, resetroi, roi, show,                     *
  40 #*         setlinear, setarea, setnone.                                  *
  41 #*                                                                       *
  42 #*      4. Optional: use the <<AfterProfil>> event definition to         *
  43 #*         grab mouse interaction. Mouse events supported are:           *
  44 #*         Button1, Button3                                              *
  45 #*                                                                       *
  46 #*************************************************************************
  47 #*                                                                       *
  48 #*  USED MODULES :                                                       *
  49 #*                     TK >= v8.0                                        *
  50 #*                                                                       *
  51 #*************************************************************************
  52 #*                                                                       *
  53 #* REVISIONS :                                                           *
  54 #* (NOTE: Please, don't let this file became a mess. ;-) )               *
  55 #*                                                                       *
  56 #* +------------+----------------+-------------------------------------+ *
  57 #* | DATE       | AUTHOR         | DESCRIPTION                         | *
  58 #* +------------+----------------+-------------------------------------+ *
  59 #* | 06/05/2001 | Kyron          | Initial implementation.             | *
  60 #* +------------+----------------+-------------------------------------+ *
  61 #* | 16/07/2001 | Kyron          | Documentation & conflicts revision. | *
  62 #* +------------+----------------+-------------------------------------+ *
  63 #*                                                                       *
  64 #*************************************************************************
  65
  66 package require Tk 8.0
  67
  68 #* NAMESPACE DESCRIPTION *************************************************
  69 #*                                                                       *
  70 #* ::imagepp (namespace)                                                 *
  71 #*                                                                       *
  72 #* DESCRIPTION : Global namespace that contains all imagepp widgets in   *
  73 #*               current interpreter (actual TCL work instance).         *
  74 #*                                                                       *
  75 #* SYNTAX : -NONE-                                                       *
  76 #*                                                                       *
  77 #* RETURN :                                                              *
  78 #*        EXPORTS : proc imagepp { name options }                        *
  79 #*                                                                       *
  80 #* PARAMETERS :                                                          *
  81 #*            Namespace components :                                     *
  82 #*              widgetOptions  : list. List of supported options.        *
  83 #*              widgetCommands : list. List of supported sub-commands.   *
  84 #*                                                                       *
  85 #******************************************************* END DESCRIPTION *
  86 package provide imagepp 1.0
  87 namespace eval ::imagepp {
  88
  89     # public interface
  90     namespace export imagepp
  91
  92     # variables
  93     variable widgetOptions
  94     variable widgetCommands
  95
  96 }
  97
  98 #* PROCEDURE DESCRIPTION *************************************************
  99 #*                                                                       *
 100 #* ::imagepp::imagepp (procedure)                                        *
 101 #*                                                                       *
 102 #* DESCRIPTION : Creator of new widgets. Call it in an TK hierarchy      *
 103 #*               creation process.                                       *
 104 #*                                                                       *
 105 #* SYNTAX : imagepp <name> -<option1> <value1> ... -<optionn> <valuen>   *
 106 #*                                                                       *
 107 #* RETURN : New widget name, if success.                                 *
 108 #*                                                                       *
 109 #* PARAMETERS :                                                          *
 110 #*      name : string. Name for the new widget. To use it in a TK widget *
 111 #*                     hierarchy, this name should be ".<f1>.<f2>...<n>" *
 112 #*                                                                       *
 113 #******************************************************* END DESCRIPTION *
 114 proc ::imagepp::imagepp { name args } {
 115
 116     # Namespace variables used in this procedure
 117     upvar ::imagepp::widgetOptions widgetOptions
 118
 119     # If global namespace doesn't exists yet then initialize it
 120     if { ![ info exists widgetOptions ] } initImagePP
 121
 122     # Given name exists?. If so, raise an error and finish
 123     if { [ winfo exists $name ] } {
 124         error "Widget \"$name\" already exists."
 125     }
 126
 127     # Create the new command and return success
 128     set name [ eval ::imagepp::buildImagePP $name $args ]
 129     return $name
 130
 131 }
 132
 133 #* PROCEDURE DESCRIPTION *************************************************
 134 #*                                                                       *
 135 #* ::imagepp::initImagePP (procedure)                                    *
 136 #*                                                                       *
 137 #* DESCRIPTION : Initializes the class manager, i.e., creates the global *
 138 #*               namespace.                                              *
 139 #*               This is a dummy proc, don't call it in your code.       *
 140 #*                                                                       *
 141 #* SYNTAX : ::imagepp::initImagePP                                       *
 142 #*                                                                       *
 143 #* RETURN : -NONE-                                                       *
 144 #*                                                                       *
 145 #* PARAMETERS :                                                          *
 146 #*      -NONE-                                                           *
 147 #*                                                                       *
 148 #******************************************************* END DESCRIPTION *
 149 proc ::imagepp::initImagePP { } {
 150
 151     # Namespace variables used in this procedure
 152     upvar ::imagepp::widgetOptions  widgetOptions
 153     upvar ::imagepp::widgetCommands widgetCommands
 154
 155     # All posible options for the widget
 156     array set widgetOptions [ list               \
 157         -background  { background Background }   \
 158         -borderwidth { borderWidth BorderWidth } \
 159         -height      { height Height }           \
 160         -initialroi  { initialROI InitialROI }   \
 161         -relief      { relief Relief }           \
 162         -takefocus   { takeFocus TakeFocus }     \
 163         -width       { width Width }             \
 164     ]
 165
 166     # All posible commands for the widget
 167     set widgetCommands [ list                     \
 168         add         addtext cget    clean         \
 169         configure   delete  find    getprofildata \
 170         resetroi    roi     show    setlinear     \
 171         setarea     setnone                       \
 172     ]
 173
 174     event add <<AfterProfil>> \
 175         <ButtonRelease-1> \
 176         <ButtonRelease-3>
 177
 178     # Default initialization... only if Tk exists
 179     if { [ lsearch -exact [ package names ] "Tk" ] != -1 } {
 180
 181         option add *ImagePP.background  #c0c0c0       widgetDefault
 182         option add *ImagePP.borderWidth 0             widgetDefault
 183         option add *ImagePP.height      100           widgetDefault
 184         option add *ImagePP.initialROI  "-1 -1 -1 -1" widgetDefault
 185         option add *ImagePP.relief      flat          widgetDefault
 186         option add *ImagePP.takeFocus   0             widgetDefault
 187         option add *ImagePP.width       100           widgetDefault
 188
 189     }
 190
 191     # set global bindings
 192     ::imagepp::setClassImagePPBindings
 193
 194 }
 195
 196 #* PROCEDURE DESCRIPTION *************************************************
 197 #*                                                                       *
 198 #* ::imagepp::setClassImagePPBindings (procedure)                        *
 199 #*                                                                       *
 200 #* DESCRIPTION : Default namespace bindings.                             *
 201 #*               This is a dummy proc, don't call it in your code.       *
 202 #*                                                                       *
 203 #* SYNTAX : ::imagepp::setClassImagePPBindings                           *
 204 #*                                                                       *
 205 #* RETURN : -NONE-                                                       *
 206 #*                                                                       *
 207 #* PARAMETERS :                                                          *
 208 #*      -NONE-                                                           *
 209 #*                                                                       *
 210 #******************************************************* END DESCRIPTION *
 211 proc ::imagepp::setClassImagePPBindings { } {
 212
 213     bind ImagePP <Destroy> [ list ::imagepp::imagePPDestroyHandler %W ]
 214
 215 }
 216
 217 #* PROCEDURE DESCRIPTION *************************************************
 218 #*                                                                       *
 219 #* ::imagepp::buildImagePP (procedure)                                   *
 220 #*                                                                       *
 221 #* DESCRIPTION : This does all of the work necessary to create a basic   *
 222 #*               imagepp widget. Creates a new command (widget) with     *
 223 #*               the given name. Also creates a new namespace as a child *
 224 #*               namespace of ::imagepp.                                 *
 225 #*               This is a dummy proc, don't call it in your code.       *
 226 #*                                                                       *
 227 #* SYNTAX : set wname [ ::imagepp::buildImagePP $name $options ]         *
 228 #*                                                                       *
 229 #* RETURN : New widget hierarchy name                                    *
 230 #*                                                                       *
 231 #* PARAMETERS :                                                          *
 232 #*      w    : string. New widget name.                                  *
 233 #*      args : list. Option/value pairs list.                            *
 234 #*                                                                       *
 235 #******************************************************* END DESCRIPTION *
 236 proc ::imagepp::buildImagePP { w args } {
 237
 238     variable widgetOptions
 239
 240     # New namespace...
 241     namespace eval ::imagepp::$w {
 242
 243         variable this
 244         variable options
 245         variable widgets
 246         variable localIds {}
 247         variable hNeed    0
 248         variable vNeed    0
 249         variable actROI   {}
 250         variable lastX    -1
 251         variable lastY    -1
 252         variable s_width  0
 253         variable s_height 0
 254
 255     }
 256
 257     # import variables, for programming facilities
 258     upvar ::imagepp::${w}::widgets widgets
 259     upvar ::imagepp::${w}::options options
 260
 261     # definition of TK widgets...
 262     set widgets(this)   [ frame  $w -class ImagePP \
 263                                     -takefocus 0   \
 264                                     -relief flat   \
 265                                     -borderwidth 0 \
 266     ]
 267     set widgets(canvas) [ canvas $w.canvas -takefocus 1 ]
 268     set widgets(hs) ""
 269     set widgets(vs) ""
 270     set widgets(profildata) ""
 271     set widgets(movingroi) 0
 272
 273     # set all the default values...
 274     foreach name [ array names widgetOptions ] {
 275
 276         set optName  [ lindex $widgetOptions($name) 0 ]
 277         set optClass [ lindex $widgetOptions($name) 1 ]
 278         set value [ option get $w $optName $optClass ]
 279         set options($name) $value
 280
 281     }
 282
 283     # set user values...
 284     if { [ llength $args ] > 0 } { array set options $args }
 285
 286     # move the name to imagepp class' namespace...
 287     set widgets(frame) ::imagepp::${w}::$w
 288     rename ::$w $widgets(frame)
 289
 290     # set canvas options...
 291     $widgets(canvas) configure -background  $options(-background)
 292     $widgets(canvas) configure -borderwidth $options(-borderwidth)
 293     $widgets(canvas) configure -height      $options(-height)
 294     $widgets(canvas) configure -relief      $options(-relief)
 295     $widgets(canvas) configure -takefocus   $options(-takefocus)
 296     $widgets(canvas) configure -width       $options(-width)
 297
 298     # pack the canvas...
 299     pack $widgets(canvas) -fill both -expand 1
 300
 301     # local event stuff...
 302     bind $widgets(canvas) <Configure> "::imagepp::resize  $widgets(this) %w %h"
 303
 304     # >>>>>>>>>>>>>>>>>>> HERE, AT LAST, THE NEW COMMAND IS DEFINED <<<<<<<<<<<<<<<<<< #
 305     proc ::$w { command args } "eval ::imagepp::imagePPWidgetProc $w \$command \$args"
 306     # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< #
 307
 308     # Last configuration stuff
 309     if { [ catch "::imagepp::configureImagePP $widgets(this) [ array get options ]" \
 310            error \
 311     ] } {
 312
 313         catch { destroy $w }
 314         error $error
 315
 316     }
 317
 318     # have fun ;-)
 319     return ""
 320
 321 }
 322
 323 #* PROCEDURE DESCRIPTION *************************************************
 324 #*                                                                       *
 325 #* ::imagepp::configureImagePP (procedure)                               *
 326 #*                                                                       *
 327 #* DESCRIPTION : This does the configuration process, i.e., change of    *
 328 #*               any option.                                             *
 329 #*               This is a dummy proc, don't call it in your code.       *
 330 #*                                                                       *
 331 #* SYNTAX : set ret [ ::imagepp::configureImagePP $widget $options ]     *
 332 #*                                                                       *
 333 #* RETURN : All options, if args is empty. If length args == 1 then      *
 334 #*          returns current value. Empty string otherwise.               *
 335 #*                                                                       *
 336 #* PARAMETERS :                                                          *
 337 #*      w    : string. Widget name.                                      *
 338 #*      args : list. Option/value pairs list.                            *
 339 #*                                                                       *
 340 #******************************************************* END DESCRIPTION *
 341 proc ::imagepp::configureImagePP { w args } {
 342
 343     variable widgetOptions
 344
 345     # For namespace access
 346     upvar ::imagepp::${w}::options  options
 347     upvar ::imagepp::${w}::widgets  widgets
 348     upvar ::imagepp::${w}::localIds localIds
 349     upvar ::imagepp::${w}::hNeed    hNeed
 350     upvar ::imagepp::${w}::vNeed    vNeed
 351     upvar ::imagepp::${w}::actROI   actROI
 352     upvar ::imagepp::${w}::lastX    lastX
 353     upvar ::imagepp::${w}::lastY    lastY
 354
 355     # Sends all information to the user...
 356     if { [ llength $args ] == 0 } {
 357
 358         set results {}
 359         foreach opt [ lsort [ array names widgetOptions ] ] {
 360
 361             if { [ llength $widgetOptions($opt) ] == 1 } {
 362
 363                 set alias $widgetOptions($opt)
 364                 set optName $widgetOptions($alias)
 365                 lappend results [ list $opt $optName ]
 366
 367             } else {
 368
 369                 set optName     [ lindex $widgetOptions($opt) 0 ]
 370                 set optClass    [ lindex $widgetOptions($opt) 1 ]
 371                 set default     [ option get $w $optName $optClass ]
 372                 lappend results [ list $opt $optName $optClass $default $options($opt) ]
 373
 374             }
 375
 376         }
 377         return $results
 378
 379     }
 380
 381     # or single information...
 382     if { [ llength $args ] == 1 } {
 383
 384         set opt      [ ::imagepp::canonizeImagePP $w option [ lindex $args 0 ] ]
 385         set optName  [ lindex $widgetOptions($opt) 0 ]
 386         set optClass [ lindex $widgetOptions($opt) 1 ]
 387         set default  [ option get $w $optName $optClass ]
 388         set results  [ list $opt $optName $optClass $default $options($opt) ]
 389         return $results
 390
 391     }
 392
 393     if { [ expr { [ llength $args ] % 2 } ] == 1 } {
 394     error "some values for \"$args\" are missing"
 395     }
 396
 397     # check if all given options exists...
 398     foreach { name value } $args {
 399
 400         set name [ ::imagepp::canonizeImagePP $w option $name ]
 401         set opts($name) $value
 402
 403     }
 404
 405     # and set values...
 406     foreach option [ array names opts ] {
 407
 408         set newValue $opts($option)
 409         switch -- $option {
 410
 411             -initialroi {
 412
 413                 if { [ llength $newValue ] == 4 } {
 414                 set options(-initialroi) $newValue
 415                 } else { error "wrong ROI value" }
 416
 417             }
 418             default  { eval "$widgets(canvas) configure $option $newValue" }
 419
 420         }
 421
 422     }
 423
 424 }
 425
 426 #* PROCEDURE DESCRIPTION *************************************************
 427 #*                                                                       *
 428 #* ::imagepp::canonizeImagePP (procedure)                                *
 429 #*                                                                       *
 430 #* DESCRIPTION : Takes a option or command and canonizes it. Returns     *
 431 #*               either the canonical form of an option or command, or   *
 432 #*               raises an error if the option or command is unknown or  *
 433 #*               ambiguous.                                              *
 434 #*               This is a dummy proc, don't call it in your code.       *
 435 #*                                                                       *
 436 #* SYNTAX : set c [ ::imagepp::canonizeImagePP $w option $args ]         *
 437 #*                                                                       *
 438 #* RETURN : Option or command canonical form                             *
 439 #*                                                                       *
 440 #* PARAMETERS :                                                          *
 441 #*      w      : string. Widget name.                                    *
 442 #*      object : string. option/command id.                              *
 443 #*      opt    : string. Option/command value.                           *
 444 #*                                                                       *
 445 #******************************************************* END DESCRIPTION *
 446 proc ::imagepp::canonizeImagePP { w object opt } {
 447
 448     variable widgetOptions
 449     variable widgetCommands
 450
 451     switch $object {
 452
 453         command {
 454
 455             if { [ lsearch -exact $widgetCommands $opt ] >= 0 } { return $opt }
 456             set list $widgetCommands
 457             foreach element $list { set tmp($element) "" }
 458             set matches [ array names tmp ${opt}* ]
 459
 460         }
 461         option {
 462
 463             if { [ info exists widgetOptions($opt) ] && \
 464                  [ llength $widgetOptions($opt) ] == 2 \
 465             } { return $opt }
 466             set list [ array names widgetOptions ]
 467             set matches [ array names widgetOptions ${opt}* ]
 468
 469         }
 470
 471     }
 472     if { [ llength $matches ] == 0 } {
 473     error "unknown $object \"$opt\"; must be one of $list"
 474     } elseif { [ llength $matches ] == 1 } {
 475
 476         set opt [ lindex $matches 0 ]
 477
 478         switch $object {
 479
 480             option {
 481
 482                 set opt [ lindex $matches 0 ]
 483                 if { [ llength $widgetOptions($opt) ] == 1 } { set opt $widgetOptions($opt) }
 484
 485             }
 486
 487         }
 488         return $opt
 489
 490     } else { error "ambiguous $object \"$opt\"; must be one of $list" }
 491
 492 }
 493
 494 #* PROCEDURE DESCRIPTION *************************************************
 495 #*                                                                       *
 496 #* ::imagepp::imagePPDestroyHandler (procedure)                          *
 497 #*                                                                       *
 498 #* DESCRIPTION : Handles the destroy event.                              *
 499 #*               This is a dummy proc, don't call it in your code.       *
 500 #*                                                                       *
 501 #* SYNTAX : ::imagepp::imagePPDestroyHandler $w                          *
 502 #*                                                                       *
 503 #* RETURN : -NONE-                                                       *
 504 #*                                                                       *
 505 #* PARAMETERS :                                                          *
 506 #*      w      : string. Widget name.                                    *
 507 #*                                                                       *
 508 #******************************************************* END DESCRIPTION *
 509 proc ::imagepp::imagePPDestroyHandler { w } {
 510
 511     if { [ string compare [ winfo class $w ] "ImagePP" ] == 0 } {
 512
 513         # For namespace access
 514         upvar ::imagepp::${w}::options  options
 515         upvar ::imagepp::${w}::widgets  widgets
 516         upvar ::imagepp::${w}::localIds localIds
 517         upvar ::imagepp::${w}::hNeed    hNeed
 518         upvar ::imagepp::${w}::vNeed    vNeed
 519         upvar ::imagepp::${w}::actROI   actROI
 520         upvar ::imagepp::${w}::lastX    lastX
 521         upvar ::imagepp::${w}::lastY    lastY
 522
 523
 524         namespace delete ::imagepp::$w
 525         rename $w {}
 526
 527     }
 528     return ""
 529
 530 }
 531
 532 #* PROCEDURE DESCRIPTION *************************************************
 533 #*                                                                       *
 534 #* ::imagepp::imagePPWidgetProc (procedure)                              *
 535 #*                                                                       *
 536 #* DESCRIPTION : Main procedure. This executes all sub-commands for the  *
 537 #*               actual widget.                                          *
 538 #*                                                                       *
 539 #* SYNTAX : ::imagepp::imagePPWidgetProc $widget $command $args          *
 540 #*               This is a dummy proc, don't call it in your code.       *
 541 #*                                                                       *
 542 #* RETURN : Depends on each sub-command                                  *
 543 #*                                                                       *
 544 #* PARAMETERS :                                                          *
 545 #*      w       : string. Widget name.                                   *
 546 #*      command : string. Sub-command name.                              *
 547 #*      args    : list. Arguments for sub-command.                       *
 548 #*                                                                       *
 549 #******************************************************* END DESCRIPTION *
 550 proc ::imagepp::imagePPWidgetProc { w command args } {
 551
 552     # For namespace access
 553     upvar ::imagepp::${w}::options  options
 554     upvar ::imagepp::${w}::widgets  widgets
 555     upvar ::imagepp::${w}::localIds localIds
 556     upvar ::imagepp::${w}::hNeed    hNeed
 557     upvar ::imagepp::${w}::vNeed    vNeed
 558     upvar ::imagepp::${w}::actROI   actROI
 559     upvar ::imagepp::${w}::lastX    lastX
 560     upvar ::imagepp::${w}::lastY    lastY
 561
 562     # given command exists?
 563     set command [ ::imagepp::canonizeImagePP $w command $command ]
 564
 565     set result {}
 566
 567     # execute subcommands
 568     switch $command {
 569
 570         add           { set result [ eval ::imagepp::addImagePP           {$w} $args ] }
 571         addtext       { set result [ eval ::imagepp::addTextImagePP       {$w} $args ] }
 572         cget          { set result [ eval ::imagepp::cgetImagePP          {$w} $args ] }
 573         clean         { set result [ eval ::imagepp::cleanImagePP         {$w} $args ] }
 574         configure     { set result [ eval ::imagepp::configureImagePP     {$w} $args ] }
 575         delete        { set result [ eval ::imagepp::deleteImagePP        {$w} $args ] }
 576         find          { set result [ eval ::imagepp::findImagePP          {$w} $args ] }
 577         getprofildata { set result [ eval ::imagepp::getprofildataImagePP {$w} $args ] }
 578         resetroi      { set result [ eval ::imagepp::resetROIImagePP      {$w} $args ] }
 579         roi           { set result [ eval ::imagepp::ROIImagePP           {$w} $args ] }
 580         setroi        { set result [ eval ::imagepp::setROIImagePP        {$w} $args ] }
 581         show          { set result [ eval ::imagepp::showImagePP          {$w} $args ] }
 582         setlinear     { set result [ eval ::imagepp::setlinearImagePP     {$w} $args ] }
 583         setarea       { set result [ eval ::imagepp::setareaImagePP       {$w} $args ] }
 584         setnone       { set result [ eval ::imagepp::setnoneImagePP       {$w} $args ] }
 585
 586     }
 587     return $result
 588
 589 }
 590
 591 #* PROCEDURE DESCRIPTION *************************************************
 592 #*                                                                       *
 593 #* ::imagepp::addImagePP (procedure)                                     *
 594 #*                                                                       *
 595 #* DESCRIPTION : Executes the "add" sub-command. This can add a tkimage, *
 596 #*               load an image from disk, make references with id's.     *
 597 #*               This is a dummy proc, don't call it in your code.       *
 598 #*               Use your widget definition and the sub-command.         *
 599 #*                                                                       *
 600 #* SYNTAX : set ret [ ::imagepp::addImagePP $w $args ]                   *
 601 #*          <widget> add                                                 *
 602 #*                       ?-image <tkimage>?                              *
 603 #*                       ?-file <filename> -format <fileformat>?         *
 604 #*                       ?-id <id>?                                      *
 605 #*                                                                       *
 606 #* RETURN : Empty string on error.                                       *
 607 #*                                                                       *
 608 #* PARAMETERS :                                                          *
 609 #*      w    : string. Widget name.                                      *
 610 #*      args : list. Arguments for sub-command.                          *
 611 #*                                                                       *
 612 #******************************************************* END DESCRIPTION *
 613 proc ::imagepp::addImagePP { w args } {
 614
 615     # For namespace access
 616     upvar ::imagepp::${w}::options  options
 617     upvar ::imagepp::${w}::widgets  widgets
 618     upvar ::imagepp::${w}::localIds localIds
 619     upvar ::imagepp::${w}::hNeed    hNeed
 620     upvar ::imagepp::${w}::vNeed    vNeed
 621     upvar ::imagepp::${w}::actROI   actROI
 622     upvar ::imagepp::${w}::lastX    lastX
 623     upvar ::imagepp::${w}::lastY    lastY
 624     upvar ::imagepp::${w}::s_width  s_width
 625     upvar ::imagepp::${w}::s_height s_height
 626
 627     # arguments parsing...
 628     if { [ llength $args ] == 4 } {
 629
 630         array set opc $args
 631         set l_opc [ array names opc ]
 632         if { [ lsearch -exact $l_opc "-image" ] != -1 && \
 633              [ lsearch -exact $l_opc "-id" ] != -1       \
 634         } {
 635
 636             set new_img $opc(-image)
 637             set new_id $opc(-id)
 638
 639         } else { error "error in \"add\" command arguments" }
 640
 641     } elseif { [ llength $args ] == 6 } {
 642
 643         array set opc $args
 644         set l_opc [ array names opc ]
 645         if { [ lsearch -exact $l_opc "-file" ] != -1 &&   \
 646              [ lsearch -exact $l_opc "-format" ] != -1 && \
 647              [ lsearch -exact $l_opc "-id" ] != -1        \
 648         } {
 649
 650             set new_img [ image create photo -file $opc(-file) -format $opc(-format) ]
 651             set new_id $opc(-id)
 652
 653         } else { error "error in \"add\" command arguments" }
 654
 655     } else { error "error in \"add\" command arguments" }
 656
 657     # given id already exists?
 658     array set ids $localIds
 659     set l_localIds [ array names ids ]
 660     if { [ lsearch -exact $l_localIds $new_id ] == -1 } {
 661
 662         # ok, do it
 663         set s_width  [ image width  $new_img ]
 664         set s_height [ image height $new_img ]
 665         set canvas_id [ \
 666             $widgets(canvas) create image 0 0 \
 667             -image $new_img \
 668             -anchor nw \
 669             -tags "id_$new_id"
 670         ]
 671         lappend localIds $new_id
 672         lappend localIds $canvas_id
 673         set hNeed [ expr ( $s_width  > $hNeed )? $s_width : $hNeed ]
 674         set vNeed [ expr ( $s_height > $vNeed )? $s_height: $vNeed ]
 675         $widgets(canvas) configure -scrollregion "0 0 $hNeed $vNeed"
 676         foreach e $actROI { $widgets(canvas) raise $e }
 677
 678     } else {
 679
 680         set item [ $widgets(canvas) find withtag "id_$new_id" ]
 681         $widgets(canvas) itemconfigure $item -image $new_img
 682         $widgets(canvas) raise $item
 683         foreach e $actROI { $widgets(canvas) raise $e }
 684
 685     }
 686     return ""
 687
 688 }
 689
 690 #* PROCEDURE DESCRIPTION *************************************************
 691 #*                                                                       *
 692 #* ::imagepp::addTextImagePP (procedure)                                 *
 693 #*                                                                       *
 694 #* DESCRIPTION : Executes the "addtext" sub-command.                     *
 695 #*               This is a dummy proc, don't call it in your code.       *
 696 #*               Use your widget definition and the sub-command.         *
 697 #*                                                                       *
 698 #* SYNTAX : set ret [ ::imagepp::addTextImagePP $w $args ]               *
 699 #*          <widget> addtext <text> <x> <y>                              *
 700 #*                                                                       *
 701 #* RETURN : -NONE-                                                       *
 702 #*                                                                       *
 703 #* PARAMETERS :                                                          *
 704 #*      w    : string. Widget name.                                      *
 705 #*      args : list. Arguments for sub-command.                          *
 706 #*                                                                       *
 707 #******************************************************* END DESCRIPTION *
 708 proc ::imagepp::addTextImagePP { w args } {
 709
 710     # For namespace access
 711     upvar ::imagepp::${w}::options  options
 712     upvar ::imagepp::${w}::widgets  widgets
 713     upvar ::imagepp::${w}::localIds localIds
 714     upvar ::imagepp::${w}::hNeed    hNeed
 715     upvar ::imagepp::${w}::vNeed    vNeed
 716     upvar ::imagepp::${w}::actROI   actROI
 717     upvar ::imagepp::${w}::lastX    lastX
 718     upvar ::imagepp::${w}::lastY    lastY
 719
 720     catch { $widgets(canvas) delete "textErase" }
 721     $widgets(canvas) create text     \
 722         [ lindex $args 1 ]           \
 723         [ lindex $args 2 ]           \
 724         -text [ lindex $args 0 ]     \
 725         -tags "textErase"            \
 726         -fill yellow                 \
 727         -justify left                \
 728         -anchor nw                   \
 729         -font { Helvetica -12 bold }
 730
 731 }
 732
 733 #* PROCEDURE DESCRIPTION *************************************************
 734 #*                                                                       *
 735 #* ::imagepp::cgetImagePP (procedure)                                    *
 736 #*                                                                       *
 737 #* DESCRIPTION : Executes the "cget" sub-command. Returns information    *
 738 #*               about certain widget option.                            *
 739 #*               This is a dummy proc, don't call it in your code.       *
 740 #*               Use your widget definition and the sub-command.         *
 741 #*                                                                       *
 742 #* SYNTAX : set ret [ ::imagepp::cgetImagePP $w $args ]                  *
 743 #*          <widget> cget ?-<option>?                                    *
 744 #*                                                                       *
 745 #* RETURN : Option value.                                                *
 746 #*                                                                       *
 747 #* PARAMETERS :                                                          *
 748 #*      w    : string. Widget name.                                      *
 749 #*      args : list. Arguments for sub-command.                          *
 750 #*                                                                       *
 751 #******************************************************* END DESCRIPTION *
 752 proc ::imagepp::cgetImagePP { w args } {
 753
 754     # For namespace access
 755     upvar ::imagepp::${w}::options  options
 756     upvar ::imagepp::${w}::widgets  widgets
 757     upvar ::imagepp::${w}::localIds localIds
 758     upvar ::imagepp::${w}::hNeed    hNeed
 759     upvar ::imagepp::${w}::vNeed    vNeed
 760     upvar ::imagepp::${w}::actROI   actROI
 761     upvar ::imagepp::${w}::lastX    lastX
 762     upvar ::imagepp::${w}::lastY    lastY
 763
 764     set ret {}
 765     if { [ llength $args ] == 1 } {
 766
 767         set opt [ ::imagepp::canonizeImagePP $w option $args ]
 768         set ret $options($opt)
 769
 770     } else { error "\"cget\" command only accepts one argument" }
 771     return $ret
 772
 773 }
 774
 775 #* PROCEDURE DESCRIPTION *************************************************
 776 #*                                                                       *
 777 #* ::imagepp::cleanImagePP (procedure)                                   *
 778 #*                                                                       *
 779 #* DESCRIPTION : Executes the "clean" sub-command.                       *
 780 #*               This is a dummy proc, don't call it in your code.       *
 781 #*               Use your widget definition and the sub-command.         *
 782 #*                                                                       *
 783 #* SYNTAX : set ret [ ::imagepp::cleanImagePP $w $args ]                 *
 784 #*          <widget> clean                                               *
 785 #*                                                                       *
 786 #* RETURN : -NONE-                                                       *
 787 #*                                                                       *
 788 #* PARAMETERS :                                                          *
 789 #*      w    : string. Widget name.                                      *
 790 #*      args : list. Arguments for sub-command.                          *
 791 #*                                                                       *
 792 #******************************************************* END DESCRIPTION *
 793 proc ::imagepp::cleanImagePP { w args } {
 794
 795     # For namespace access
 796     upvar ::imagepp::${w}::options  options
 797     upvar ::imagepp::${w}::widgets  widgets
 798     upvar ::imagepp::${w}::localIds localIds
 799     upvar ::imagepp::${w}::hNeed    hNeed
 800     upvar ::imagepp::${w}::vNeed    vNeed
 801     upvar ::imagepp::${w}::actROI   actROI
 802     upvar ::imagepp::${w}::lastX    lastX
 803     upvar ::imagepp::${w}::lastY    lastY
 804
 805     catch { $widgets(canvas) delete $widgets(actual_line) }
 806     catch { $widgets(canvas) delete "textErase" }
 807
 808 }
 809
 810 #* PROCEDURE DESCRIPTION *************************************************
 811 #*                                                                       *
 812 #* ::imagepp::deleteImagePP (procedure)                                  *
 813 #*                                                                       *
 814 #* DESCRIPTION : Executes the "delete" sub-command.                      *
 815 #*               This is a dummy proc, don't call it in your code.       *
 816 #*               Use your widget definition and the sub-command.         *
 817 #*                                                                       *
 818 #* SYNTAX : set ret [ ::imagepp::deleteImagePP $w $args ]                *
 819 #*          <widget> delete -id <id/all>                                 *
 820 #*                                                                       *
 821 #* RETURN : -NONE-                                                       *
 822 #*                                                                       *
 823 #* PARAMETERS :                                                          *
 824 #*      w    : string. Widget name.                                      *
 825 #*      args : list. Arguments for sub-command.                          *
 826 #*                                                                       *
 827 #******************************************************* END DESCRIPTION *
 828 proc ::imagepp::deleteImagePP { w args } {
 829
 830     # For namespace access
 831     upvar ::imagepp::${w}::options  options
 832     upvar ::imagepp::${w}::widgets  widgets
 833     upvar ::imagepp::${w}::localIds localIds
 834     upvar ::imagepp::${w}::hNeed    hNeed
 835     upvar ::imagepp::${w}::vNeed    vNeed
 836     upvar ::imagepp::${w}::actROI   actROI
 837     upvar ::imagepp::${w}::lastX    lastX
 838     upvar ::imagepp::${w}::lastY    lastY
 839
 840     set ret -1
 841
 842     # arguments parsing...
 843     if { [ llength $args ] == 2 } {
 844
 845         if { [ string compare [ lindex $args 0 ] "-id" ] == 0 } {
 846
 847             if { [ string compare [ lindex $args 1 ] "all" ] == 0 } {
 848
 849                 set all_items [ $widgets(canvas) find withtag all ]
 850                 foreach item $all_items { $widgets(canvas) delete $item }
 851
 852             } else {
 853             }
 854
 855         } else { error "wrong argument for \"delete\" command" }
 856
 857     } else { error "wrong number of arguments for \"delete\" command" }
 858     return ""
 859
 860 }
 861
 862 #* PROCEDURE DESCRIPTION *************************************************
 863 #*                                                                       *
 864 #* ::imagepp::findImagePP (procedure)                                    *
 865 #*                                                                       *
 866 #* DESCRIPTION : Executes the "find" sub-command.                        *
 867 #*               This is a dummy proc, don't call it in your code.       *
 868 #*               Use your widget definition and the sub-command.         *
 869 #*                                                                       *
 870 #* SYNTAX : set ret [ ::imagepp::findImagePP $w $args ]                  *
 871 #*          <widget> delete -id <id>                                     *
 872 #*                                                                       *
 873 #* RETURN : Index.                                                       *
 874 #*                                                                       *
 875 #* PARAMETERS :                                                          *
 876 #*      w    : string. Widget name.                                      *
 877 #*      args : list. Arguments for sub-command.                          *
 878 #*                                                                       *
 879 #******************************************************* END DESCRIPTION *
 880 proc ::imagepp::findImagePP { w args } {
 881
 882     # For namespace access
 883     upvar ::imagepp::${w}::options  options
 884     upvar ::imagepp::${w}::widgets  widgets
 885     upvar ::imagepp::${w}::localIds localIds
 886     upvar ::imagepp::${w}::hNeed    hNeed
 887     upvar ::imagepp::${w}::vNeed    vNeed
 888     upvar ::imagepp::${w}::actROI   actROI
 889     upvar ::imagepp::${w}::lastX    lastX
 890     upvar ::imagepp::${w}::lastY    lastY
 891
 892     set ret -1
 893
 894     # arguments parsing...
 895     if { [ llength $args ] == 2 } {
 896
 897         if { [ string compare [ lindex $args 0 ] "-id" ] == 0 } {
 898
 899             array set ids $localIds
 900             set l_localIds [ array names ids ]
 901             set ret [ lsearch -exact $l_localIds [ lindex $args 1 ] ]
 902
 903         } else { error "wrong argument for \"find\" command" }
 904
 905     } else { error "wrong number of arguments for \"find\" command" }
 906     return $ret
 907
 908 }
 909
 910 #* PROCEDURE DESCRIPTION *************************************************
 911 #*                                                                       *
 912 #* ::imagepp::getprofildataImagePP (procedure)                           *
 913 #*                                                                       *
 914 #* DESCRIPTION : Executes the "find" sub-command.                        *
 915 #*               This is a dummy proc, don't call it in your code.       *
 916 #*               Use your widget definition and the sub-command.         *
 917 #*                                                                       *
 918 #* SYNTAX : set ret [ ::imagepp::getprofildataImagePP $w $args ]         *
 919 #*          <widget> getprofildata -id <id>                              *
 920 #*                                                                       *
 921 #* RETURN : Limits for a profil measure.                                 *
 922 #*                                                                       *
 923 #* PARAMETERS :                                                          *
 924 #*      w    : string. Widget name.                                      *
 925 #*      args : list. Arguments for sub-command.                          *
 926 #*                                                                       *
 927 #******************************************************* END DESCRIPTION *
 928 proc ::imagepp::getprofildataImagePP { w args } {
 929
 930     # For namespace access
 931     upvar ::imagepp::${w}::options  options
 932     upvar ::imagepp::${w}::widgets  widgets
 933     upvar ::imagepp::${w}::localIds localIds
 934     upvar ::imagepp::${w}::hNeed    hNeed
 935     upvar ::imagepp::${w}::vNeed    vNeed
 936     upvar ::imagepp::${w}::actROI   actROI
 937     upvar ::imagepp::${w}::lastX    lastX
 938     upvar ::imagepp::${w}::lastY    lastY
 939
 940     return $widgets(profildata)
 941
 942 }
 943
 944 #* PROCEDURE DESCRIPTION *************************************************
 945 #*                                                                       *
 946 #* ::imagepp::resetROIImagePP (procedure)                                *
 947 #*                                                                       *
 948 #* DESCRIPTION : Executes the "resetroi" sub-command.                    *
 949 #*               This is a dummy proc, don't call it in your code.       *
 950 #*               Use your widget definition and the sub-command.         *
 951 #*                                                                       *
 952 #* SYNTAX : set ret [ ::imagepp::resetROIImagePP $w $args ]              *
 953 #*          <widget> resetroi                                            *
 954 #*                                                                       *
 955 #* RETURN : -NONE-                                                       *
 956 #*                                                                       *
 957 #* PARAMETERS :                                                          *
 958 #*      w    : string. Widget name.                                      *
 959 #*      args : list. Arguments for sub-command.                          *
 960 #*                                                                       *
 961 #******************************************************* END DESCRIPTION *
 962 proc ::imagepp::resetROIImagePP { w args } {
 963
 964     # For namespace access
 965     upvar ::imagepp::${w}::options  options
 966     upvar ::imagepp::${w}::widgets  widgets
 967     upvar ::imagepp::${w}::localIds localIds
 968     upvar ::imagepp::${w}::hNeed    hNeed
 969     upvar ::imagepp::${w}::vNeed    vNeed
 970     upvar ::imagepp::${w}::actROI   actROI
 971     upvar ::imagepp::${w}::lastX    lastX
 972     upvar ::imagepp::${w}::lastY    lastY
 973
 974     # erase
 975     foreach e $actROI { $widgets(canvas) delete $e }
 976
 977     # coordinates
 978     set ux [ lindex $options(-initialroi) 0 ]
 979     set uy [ lindex $options(-initialroi) 1 ]
 980     set bx [ lindex $options(-initialroi) 2 ]
 981     set by [ lindex $options(-initialroi) 3 ]
 982
 983     # four rectangles...
 984     set actROI [ list ]
 985
 986     # 1) ux, uy
 987     lappend actROI [ $widgets(canvas) create rectangle \
 988         [ expr $ux - 6 ] [ expr $uy - 6 ]      \
 989         [ expr $ux + 0 ] [ expr $uy + 0 ]      \
 990         -fill #ffff00                          \
 991         -tags "rect_fill"                      \
 992     ]
 993
 994     # 2) bx, uy
 995     lappend actROI [ $widgets(canvas) create rectangle \
 996         [ expr $bx - 0 ] [ expr $uy - 6 ]      \
 997         [ expr $bx + 6 ] [ expr $uy + 0 ]      \
 998         -fill #ffff00                          \
 999         -tags "rect_fill"                      \
1000     ]
1001
1002     # 3) bx, by
1003     lappend actROI [ $widgets(canvas) create rectangle \
1004         [ expr $bx - 0 ] [ expr $by - 0 ]      \
1005         [ expr $bx + 6 ] [ expr $by + 6 ]      \
1006         -fill #ffff00                          \
1007         -tags "rect_fill"                      \
1008     ]
1009
1010     # 4) ux, by
1011     lappend actROI [ $widgets(canvas) create rectangle \
1012         [ expr $ux - 6 ] [ expr $by - 0 ]      \
1013         [ expr $ux + 0 ] [ expr $by + 6 ]      \
1014         -fill #ffff00                          \
1015         -tags "rect_fill"                      \
1016     ]
1017
1018     # rectangle for area
1019     lappend actROI [ $widgets(canvas) create rectangle \
1020         [ expr $ux ] [ expr $uy ]      \
1021         [ expr $bx ] [ expr $by ]      \
1022         -outline #ffff00               \
1023         -width 2                       \
1024         -tags "rect_area"              \
1025     ]
1026
1027     # item binds
1028     $widgets(canvas) bind [ lindex $actROI 0 ] <Enter>     "$widgets(canvas) itemconfigure current -fill #ff0000"
1029     $widgets(canvas) bind [ lindex $actROI 0 ] <Leave>     "$widgets(canvas) itemconfigure current -fill #ffff00"
1030     $widgets(canvas) bind [ lindex $actROI 0 ] <Button-1>  "::imagepp::startMotion $w %x %y"
1031     $widgets(canvas) bind [ lindex $actROI 0 ] <B1-Motion> "::imagepp::moveCorner $w %x %y 0"
1032
1033     $widgets(canvas) bind [ lindex $actROI 1 ] <Enter>     "$widgets(canvas) itemconfigure current -fill #ff0000"
1034     $widgets(canvas) bind [ lindex $actROI 1 ] <Leave>     "$widgets(canvas) itemconfigure current -fill #ffff00"
1035     $widgets(canvas) bind [ lindex $actROI 1 ] <Button-1>  "::imagepp::startMotion $w %x %y"
1036     $widgets(canvas) bind [ lindex $actROI 1 ] <B1-Motion> "::imagepp::moveCorner $w %x %y 1"
1037
1038     $widgets(canvas) bind [ lindex $actROI 2 ] <Enter>     "$widgets(canvas) itemconfigure current -fill #ff0000"
1039     $widgets(canvas) bind [ lindex $actROI 2 ] <Leave>     "$widgets(canvas) itemconfigure current -fill #ffff00"
1040     $widgets(canvas) bind [ lindex $actROI 2 ] <Button-1>  "::imagepp::startMotion $w %x %y"
1041     $widgets(canvas) bind [ lindex $actROI 2 ] <B1-Motion> "::imagepp::moveCorner $w %x %y 2"
1042
1043     $widgets(canvas) bind [ lindex $actROI 3 ] <Enter>     "$widgets(canvas) itemconfigure current -fill #ff0000"
1044     $widgets(canvas) bind [ lindex $actROI 3 ] <Leave>     "$widgets(canvas) itemconfigure current -fill #ffff00"
1045     $widgets(canvas) bind [ lindex $actROI 3 ] <Button-1>  "::imagepp::startMotion $w %x %y"
1046     $widgets(canvas) bind [ lindex $actROI 3 ] <B1-Motion> "::imagepp::moveCorner $w %x %y 3"
1047
1048     $widgets(canvas) bind [ lindex $actROI 4 ] <Enter>     "$widgets(canvas) itemconfigure current -outline #ff0000"
1049     $widgets(canvas) bind [ lindex $actROI 4 ] <Leave>     "$widgets(canvas) itemconfigure current -outline #ffff00"
1050     $widgets(canvas) bind [ lindex $actROI 4 ] <Button-1>  "::imagepp::startMotion $w %x %y"
1051     $widgets(canvas) bind [ lindex $actROI 4 ] <B1-Motion> "::imagepp::moveRect $w %x %y"
1052
1053     foreach e $actROI { $widgets(canvas) raise $e }
1054
1055 }
1056
1057 #* PROCEDURE DESCRIPTION *************************************************
1058 #*                                                                       *
1059 #* ::imagepp::ROIImagePP (procedure)                                     *
1060 #*                                                                       *
1061 #* DESCRIPTION : Executes the "roi" sub-command.                         *
1062 #*               This is a dummy proc, don't call it in your code.       *
1063 #*               Use your widget definition and the sub-command.         *
1064 #*                                                                       *
1065 #* SYNTAX : set ret [ ::imagepp::ROIImagePP $w $args ]                   *
1066 #*          <widget> roi                                                 *
1067 #*                                                                       *
1068 #* RETURN : Actual Region Of Interest.                                   *
1069 #*                                                                       *
1070 #* PARAMETERS :                                                          *
1071 #*      w    : string. Widget name.                                      *
1072 #*      args : list. Arguments for sub-command.                          *
1073 #*                                                                       *
1074 #******************************************************* END DESCRIPTION *
1075 proc ::imagepp::ROIImagePP { w args } {
1076
1077     # For namespace access
1078     upvar ::imagepp::${w}::options  options
1079     upvar ::imagepp::${w}::widgets  widgets
1080     upvar ::imagepp::${w}::localIds localIds
1081     upvar ::imagepp::${w}::hNeed    hNeed
1082     upvar ::imagepp::${w}::vNeed    vNeed
1083     upvar ::imagepp::${w}::actROI   actROI
1084     upvar ::imagepp::${w}::lastX    lastX
1085     upvar ::imagepp::${w}::lastY    lastY
1086     upvar ::imagepp::${w}::s_width  s_width
1087     upvar ::imagepp::${w}::s_height s_height
1088
1089     set ux $s_width; set uy $s_height
1090     set bx -1; set by -1
1091         set c  [ $widgets(canvas) coords [ lindex $actROI 4 ] ]
1092     set ux [ expr ( [ lindex $c 0 ] < $ux )? [ lindex $c 0 ]: $ux ]
1093     set uy [ expr ( [ lindex $c 1 ] < $uy )? [ lindex $c 1 ]: $uy ]
1094     set bx [ expr ( [ lindex $c 2 ] > $bx )? [ lindex $c 2 ]: $bx ]
1095     set by [ expr ( [ lindex $c 3 ] > $by )? [ lindex $c 3 ]: $by ]
1096
1097     set ux [ expr ( $ux < 0 )? 0: $ux ]
1098     set uy [ expr ( $uy < 0 )? 0: $uy ]
1099     set bx [ expr ( $bx > $s_width )? $s_width - 1: $bx ]
1100     set by [ expr ( $by > $s_height )? $s_height - 1: $by ]
1101
1102     set ret [ list $ux $uy $bx $by ]
1103     return $ret
1104
1105 }
1106
1107 #* PROCEDURE DESCRIPTION *************************************************
1108 #*                                                                       *
1109 #* ::imagepp::showImagePP (procedure)                                    *
1110 #*                                                                       *
1111 #* DESCRIPTION : Executes the "show" sub-command.                        *
1112 #*               This is a dummy proc, don't call it in your code.       *
1113 #*               Use your widget definition and the sub-command.         *
1114 #*                                                                       *
1115 #* SYNTAX : set ret [ ::imagepp::showImagePP $w $args ]                  *
1116 #*          <widget> roi                                                 *
1117 #*                                                                       *
1118 #* RETURN : -NONE-                                                       *
1119 #*                                                                       *
1120 #* PARAMETERS :                                                          *
1121 #*      w    : string. Widget name.                                      *
1122 #*      args : list. Arguments for sub-command.                          *
1123 #*                                                                       *
1124 #******************************************************* END DESCRIPTION *
1125 proc ::imagepp::showImagePP { w args } {
1126
1127     # For namespace access
1128     upvar ::imagepp::${w}::options  options
1129     upvar ::imagepp::${w}::widgets  widgets
1130     upvar ::imagepp::${w}::localIds localIds
1131     upvar ::imagepp::${w}::hNeed    hNeed
1132     upvar ::imagepp::${w}::vNeed    vNeed
1133     upvar ::imagepp::${w}::actROI   actROI
1134     upvar ::imagepp::${w}::lastX    lastX
1135     upvar ::imagepp::${w}::lastY    lastY
1136
1137     # arguments parsing...
1138     if { [ llength $args ] == 2 } {
1139
1140         if { [ string compare [ lindex $args 0 ] "-id" ] == 0 } {
1141
1142             array set ids $localIds
1143             set l_localIds [ array names ids ]
1144             set local_id [ lindex $args 1 ]
1145             if { [ lsearch -exact $l_localIds $local_id ] != -1 } {
1146
1147                 $widgets(canvas) raise $ids($local_id)
1148                 foreach e $actROI { $widgets(canvas) raise $e }
1149
1150             }
1151
1152         } else { error "wrong argument for \"show\" command" }
1153
1154     } else { error "wrong number of arguments for \"show\" command" }
1155     return ""
1156
1157 }
1158
1159 #* PROCEDURE DESCRIPTION *************************************************
1160 #*                                                                       *
1161 #* ::imagepp::setlinearImagePP (procedure)                               *
1162 #*                                                                       *
1163 #* DESCRIPTION : Executes the "setlinear" sub-command.                   *
1164 #*               This is a dummy proc, don't call it in your code.       *
1165 #*               Use your widget definition and the sub-command.         *
1166 #*                                                                       *
1167 #* SYNTAX : set ret [ ::imagepp::setlinearImagePP $w $args ]             *
1168 #*          <widget> setlinear                                           *
1169 #*                                                                       *
1170 #* RETURN : -NONE-                                                       *
1171 #*                                                                       *
1172 #* PARAMETERS :                                                          *
1173 #*      w    : string. Widget name.                                      *
1174 #*      args : list. Arguments for sub-command.                          *
1175 #*                                                                       *
1176 #******************************************************* END DESCRIPTION *
1177 proc ::imagepp::setlinearImagePP { w args } {
1178
1179     # For namespace access
1180     upvar ::imagepp::${w}::options  options
1181     upvar ::imagepp::${w}::widgets  widgets
1182     upvar ::imagepp::${w}::localIds localIds
1183     upvar ::imagepp::${w}::hNeed    hNeed
1184     upvar ::imagepp::${w}::vNeed    vNeed
1185     upvar ::imagepp::${w}::actROI   actROI
1186     upvar ::imagepp::${w}::lastX    lastX
1187     upvar ::imagepp::${w}::lastY    lastY
1188
1189     catch { $widgets(canvas) delete $widgets(actual_line) }
1190     catch { $widgets(canvas) delete "textErase" }
1191     bind $widgets(canvas) <ButtonPress-3>   "::imagepp::startMotion $widgets(this) %x %y 1"
1192     bind $widgets(canvas) <B3-Motion>       "::imagepp::goMotion $widgets(this) %x %y 1"
1193     bind $widgets(canvas) <ButtonRelease-3> "::imagepp::finishMotion $widgets(this) %x %y 1"
1194
1195 }
1196
1197 #* PROCEDURE DESCRIPTION *************************************************
1198 #*                                                                       *
1199 #* ::imagepp::setareaImagePP (procedure)                                 *
1200 #*                                                                       *
1201 #* DESCRIPTION : Executes the "setarea" sub-command.                     *
1202 #*               This is a dummy proc, don't call it in your code.       *
1203 #*               Use your widget definition and the sub-command.         *
1204 #*                                                                       *
1205 #* SYNTAX : set ret [ ::imagepp::setareaImagePP $w $args ]               *
1206 #*          <widget> setarea                                             *
1207 #*                                                                       *
1208 #* RETURN : -NONE-                                                       *
1209 #*                                                                       *
1210 #* PARAMETERS :                                                          *
1211 #*      w    : string. Widget name.                                      *
1212 #*      args : list. Arguments for sub-command.                          *
1213 #*                                                                       *
1214 #******************************************************* END DESCRIPTION *
1215 proc ::imagepp::setareaImagePP { w args } {
1216
1217     # For namespace access
1218     upvar ::imagepp::${w}::options  options
1219     upvar ::imagepp::${w}::widgets  widgets
1220     upvar ::imagepp::${w}::localIds localIds
1221     upvar ::imagepp::${w}::hNeed    hNeed
1222     upvar ::imagepp::${w}::vNeed    vNeed
1223     upvar ::imagepp::${w}::actROI   actROI
1224     upvar ::imagepp::${w}::lastX    lastX
1225     upvar ::imagepp::${w}::lastY    lastY
1226
1227     catch { $widgets(canvas) delete $widgets(actual_line) }
1228     catch { $widgets(canvas) delete "textErase" }
1229     bind $widgets(canvas) <ButtonPress-3>   "::imagepp::startMotion $widgets(this) %x %y 2"
1230     bind $widgets(canvas) <B3-Motion>       "::imagepp::goMotion $widgets(this) %x %y 2"
1231     bind $widgets(canvas) <ButtonRelease-3> "::imagepp::finishMotion $widgets(this) %x %y 2"
1232
1233 }
1234
1235 #* PROCEDURE DESCRIPTION *************************************************
1236 #*                                                                       *
1237 #* ::imagepp::setnoneImagePP (procedure)                                 *
1238 #*                                                                       *
1239 #* DESCRIPTION : Executes the "setnone" sub-command.                     *
1240 #*               This is a dummy proc, don't call it in your code.       *
1241 #*               Use your widget definition and the sub-command.         *
1242 #*                                                                       *
1243 #* SYNTAX : set ret [ ::imagepp::setnoneImagePP $w $args ]               *
1244 #*          <widget> setnone                                             *
1245 #*                                                                       *
1246 #* RETURN : -NONE-                                                       *
1247 #*                                                                       *
1248 #* PARAMETERS :                                                          *
1249 #*      w    : string. Widget name.                                      *
1250 #*      args : list. Arguments for sub-command.                          *
1251 #*                                                                       *
1252 #******************************************************* END DESCRIPTION *
1253 proc ::imagepp::setnoneImagePP { w args } {
1254
1255     # For namespace access
1256     upvar ::imagepp::${w}::options  options
1257     upvar ::imagepp::${w}::widgets  widgets
1258     upvar ::imagepp::${w}::localIds localIds
1259     upvar ::imagepp::${w}::hNeed    hNeed
1260     upvar ::imagepp::${w}::vNeed    vNeed
1261     upvar ::imagepp::${w}::actROI   actROI
1262     upvar ::imagepp::${w}::lastX    lastX
1263     upvar ::imagepp::${w}::lastY    lastY
1264
1265     catch { $widgets(canvas) delete $widgets(actual_line) }
1266     catch { $widgets(canvas) delete "textErase" }
1267     bind $widgets(canvas) <ButtonPress-1>   "::imagepp::startMotion $widgets(this) %x %y 3"
1268     bind $widgets(canvas) <B1-Motion>       "::imagepp::goMotion $widgets(this) %x %y 3"
1269     bind $widgets(canvas) <ButtonRelease-1> "::imagepp::finishMotion $widgets(this) %x %y 3"
1270
1271 }
1272
1273 #* PROCEDURE DESCRIPTION *************************************************
1274 #*                                                                       *
1275 #* ::imagepp::resize (procedure)                                         *
1276 #*                                                                       *
1277 #* DESCRIPTION : Event callback. Resize widget.                          *
1278 #*               This is a dummy proc, don't call it in your code.       *
1279 #*                                                                       *
1280 #* SYNTAX : ::imagepp::resize %W %w %h                                   *
1281 #*                                                                       *
1282 #* RETURN : -NONE-                                                       *
1283 #*                                                                       *
1284 #* PARAMETERS :                                                          *
1285 #*      w      : string. Widget name.                                    *
1286 #*      width  : string. Widget width.                                   *
1287 #*      height : string. Widget height.                                  *
1288 #*                                                                       *
1289 #******************************************************* END DESCRIPTION *
1290 proc ::imagepp::resize { w width height } {
1291
1292     # For namespace access
1293     upvar ::imagepp::${w}::options  options
1294     upvar ::imagepp::${w}::widgets  widgets
1295     upvar ::imagepp::${w}::localIds localIds
1296     upvar ::imagepp::${w}::hNeed    hNeed
1297     upvar ::imagepp::${w}::vNeed    vNeed
1298     upvar ::imagepp::${w}::actROI   actROI
1299     upvar ::imagepp::${w}::lastX    lastX
1300     upvar ::imagepp::${w}::lastY    lastY
1301
1302     if { $options(-width) != $width || $options(-height) != $height } {
1303
1304         set options(-width)  $width
1305         set options(-height) $height
1306         $widgets(canvas) configure -width $options(-width)
1307         ::imagepp::configureSlider $w
1308
1309     }
1310
1311 }
1312
1313 #* PROCEDURE DESCRIPTION *************************************************
1314 #*                                                                       *
1315 #* ::imagepp::configureSlider (procedure)                                *
1316 #*                                                                       *
1317 #* DESCRIPTION : Puts or erases a slider, if necessary.                  *
1318 #*               This is a dummy proc, don't call it in your code.       *
1319 #*                                                                       *
1320 #* SYNTAX : ::imagepp::configureSlider $widget                           *
1321 #*                                                                       *
1322 #* RETURN : -NONE-                                                       *
1323 #*                                                                       *
1324 #* PARAMETERS :                                                          *
1325 #*      w      : string. Widget name.                                    *
1326 #*                                                                       *
1327 #******************************************************* END DESCRIPTION *
1328 proc ::imagepp::configureSlider { w } {
1329
1330     # For namespace access
1331     upvar ::imagepp::${w}::options  options
1332     upvar ::imagepp::${w}::widgets  widgets
1333     upvar ::imagepp::${w}::localIds localIds
1334     upvar ::imagepp::${w}::hNeed    hNeed
1335     upvar ::imagepp::${w}::vNeed    vNeed
1336     upvar ::imagepp::${w}::actROI   actROI
1337     upvar ::imagepp::${w}::lastX    lastX
1338     upvar ::imagepp::${w}::lastY    lastY
1339
1340     set rh $options(-height)
1341     set rw $options(-width)
1342
1343     if { $vNeed >= $rh && ! [ winfo exists $w.vs ] } {
1344
1345         set widgets(vs) [ scrollbar $w.vs -command "$widgets(canvas) yview" ]
1346         $widgets(canvas) configure -yscrollcommand "$widgets(vs) set"
1347         grid $widgets(canvas) \
1348             -in $widgets(this) \
1349             -row 0 \
1350             -column 0 \
1351             -rowspan 1 \
1352             -columnspan 1 \
1353             -sticky news
1354         grid $widgets(vs) -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
1355         grid rowconfig    $widgets(this) 0 -weight 1 -minsize 0
1356         grid columnconfig $widgets(this) 0 -weight 1 -minsize 0
1357
1358     } elseif { $vNeed < $rh && [ winfo exists $w.vs ] } {
1359
1360         $widgets(canvas) configure -yscrollcommand ""
1361         destroy $w.vs
1362         set widgets(vs) ""
1363
1364     }
1365
1366     if { $hNeed >= $rw && ! [ winfo exists $w.hs ] } {
1367
1368         set widgets(hs) [ scrollbar $w.hs -orient horizontal -command "$widgets(canvas) xview" ]
1369         $widgets(canvas) configure -xscrollcommand "$widgets(hs) set"
1370         grid $widgets(canvas) \
1371             -in $widgets(this) \
1372             -row 0 \
1373             -column 0 \
1374             -rowspan 1 \
1375             -columnspan 1 \
1376             -sticky news
1377         grid $widgets(hs) -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
1378         grid rowconfig    $widgets(this) 0 -weight 1 -minsize 0
1379         grid columnconfig $widgets(this) 0 -weight 1 -minsize 0
1380
1381     } elseif { $hNeed < $rw && [ winfo exists $w.hs ] } {
1382
1383         $widgets(canvas) configure -xscrollcommand ""
1384         destroy $w.hs
1385         set widgets(hs) ""
1386
1387     }
1388
1389 }
1390
1391 #* PROCEDURE DESCRIPTION *************************************************
1392 #*                                                                       *
1393 #* ::imagepp::startMotion (procedure)                                    *
1394 #*                                                                       *
1395 #* DESCRIPTION : Event callback. Start mouse motion.                     *
1396 #*               This is a dummy proc, don't call it in your code.       *
1397 #*                                                                       *
1398 #* SYNTAX : ::imagepp::startMotion %W %x %y $typ                         *
1399 #*                                                                       *
1400 #* RETURN : -NONE-                                                       *
1401 #*                                                                       *
1402 #* PARAMETERS :                                                          *
1403 #*      w   : string. Widget name.                                       *
1404 #*      x   : string. x-coordinate.                                      *
1405 #*      y   : string. y-coordinate.                                      *
1406 #*      typ : string. (optional) Motion type.                            *
1407 #*                                                                       *
1408 #******************************************************* END DESCRIPTION *
1409 proc ::imagepp::startMotion { w x y { typ 0 } } {
1410
1411     # For namespace access
1412     upvar ::imagepp::${w}::options  options
1413     upvar ::imagepp::${w}::widgets  widgets
1414     upvar ::imagepp::${w}::localIds localIds
1415     upvar ::imagepp::${w}::hNeed    hNeed
1416     upvar ::imagepp::${w}::vNeed    vNeed
1417     upvar ::imagepp::${w}::actROI   actROI
1418     upvar ::imagepp::${w}::lastX    lastX
1419     upvar ::imagepp::${w}::lastY    lastY
1420
1421     set lastX $x
1422     set lastY $y
1423
1424     catch { $widgets(canvas) delete $widgets(actual_line) }
1425     catch { $widgets(canvas) delete "textErase" }
1426     if { $widgets(movingroi) == 0 } {
1427
1428         if { $typ == 1 } {
1429
1430             set widgets(actual_line) [ \
1431                 $widgets(canvas) create line $lastX $lastY $lastX $lastY \
1432                     -arrow both   \
1433                     -fill #0000ff \
1434                     -width 1 \
1435             ]
1436
1437         } elseif { $typ == 2 } {
1438
1439             set widgets(actual_line) [ \
1440                 $widgets(canvas) create rectangle \
1441                     $lastX $lastY $lastX $lastY   \
1442                     -outline #0000ff              \
1443                     -width 1                      \
1444             ]
1445
1446         }
1447
1448     }
1449
1450 }
1451
1452 #* PROCEDURE DESCRIPTION *************************************************
1453 #*                                                                       *
1454 #* ::imagepp::goMotion (procedure)                                       *
1455 #*                                                                       *
1456 #* DESCRIPTION : Event callback. Do mouse motion.                        *
1457 #*               This is a dummy proc, don't call it in your code.       *
1458 #*                                                                       *
1459 #* SYNTAX : ::imagepp::goMotion %W %x %y $typ                            *
1460 #*                                                                       *
1461 #* RETURN : -NONE-                                                       *
1462 #*                                                                       *
1463 #* PARAMETERS :                                                          *
1464 #*      w   : string. Widget name.                                       *
1465 #*      x   : string. x-coordinate.                                      *
1466 #*      y   : string. y-coordinate.                                      *
1467 #*      typ : string. (optional) Motion type.                            *
1468 #*                                                                       *
1469 #******************************************************* END DESCRIPTION *
1470 proc ::imagepp::goMotion { w x y typ } {
1471
1472     # For namespace access
1473     upvar ::imagepp::${w}::options  options
1474     upvar ::imagepp::${w}::widgets  widgets
1475     upvar ::imagepp::${w}::localIds localIds
1476     upvar ::imagepp::${w}::hNeed    hNeed
1477     upvar ::imagepp::${w}::vNeed    vNeed
1478     upvar ::imagepp::${w}::actROI   actROI
1479     upvar ::imagepp::${w}::lastX    lastX
1480     upvar ::imagepp::${w}::lastY    lastY
1481
1482     if { $widgets(movingroi) == 0 } {
1483
1484         if { $typ == 1 || $typ == 2 } {
1485
1486             $widgets(canvas) coords \
1487                 $widgets(actual_line) \
1488                 $lastX $lastY $x $y
1489
1490         } elseif { $typ == 3 } {
1491
1492             set widgets(profildata) [ list 3 $lastX $lastY $x $y ]
1493             event generate $widgets(this) <<AfterProfil>>
1494
1495         }
1496
1497     }
1498 }
1499
1500 #* PROCEDURE DESCRIPTION *************************************************
1501 #*                                                                       *
1502 #* ::imagepp::finishMotion (procedure)                                   *
1503 #*                                                                       *
1504 #* DESCRIPTION : Event callback. Finish mouse motion.                    *
1505 #*               This is a dummy proc, don't call it in your code.       *
1506 #*                                                                       *
1507 #* SYNTAX : ::imagepp::finishMotion %W %x %y $typ                        *
1508 #*                                                                       *
1509 #* RETURN : -NONE-                                                       *
1510 #*                                                                       *
1511 #* PARAMETERS :                                                          *
1512 #*      w   : string. Widget name.                                       *
1513 #*      x   : string. x-coordinate.                                      *
1514 #*      y   : string. y-coordinate.                                      *
1515 #*      typ : string. (optional) Motion type.                            *
1516 #*                                                                       *
1517 #******************************************************* END DESCRIPTION *
1518 proc ::imagepp::finishMotion { w x y typ } {
1519
1520     # For namespace access
1521     upvar ::imagepp::${w}::options  options
1522     upvar ::imagepp::${w}::widgets  widgets
1523     upvar ::imagepp::${w}::localIds localIds
1524     upvar ::imagepp::${w}::hNeed    hNeed
1525     upvar ::imagepp::${w}::vNeed    vNeed
1526     upvar ::imagepp::${w}::actROI   actROI
1527     upvar ::imagepp::${w}::lastX    lastX
1528     upvar ::imagepp::${w}::lastY    lastY
1529
1530     if { $widgets(movingroi) == 0 } {
1531
1532         if { $typ == 3 } { incr typ }
1533         set widgets(profildata) [ list $typ $lastX $lastY $x $y ]
1534
1535         event generate $widgets(this) <<AfterProfil>>
1536
1537     }
1538     set widgets(movingroi) 0
1539
1540 }
1541
1542 #* PROCEDURE DESCRIPTION *************************************************
1543 #*                                                                       *
1544 #* ::imagepp::moveRect (procedure)                                       *
1545 #*                                                                       *
1546 #* DESCRIPTION : Event callback. Move a rectangle.                       *
1547 #*               This is a dummy proc, don't call it in your code.       *
1548 #*                                                                       *
1549 #* SYNTAX : ::imagepp::moveRect %W %x %y                                 *
1550 #*                                                                       *
1551 #* RETURN : -NONE-                                                       *
1552 #*                                                                       *
1553 #* PARAMETERS :                                                          *
1554 #*      w   : string. Widget name.                                       *
1555 #*      x   : string. x-coordinate.                                      *
1556 #*      y   : string. y-coordinate.                                      *
1557 #*                                                                       *
1558 #******************************************************* END DESCRIPTION *
1559 proc ::imagepp::moveRect { w x y } {
1560
1561     # For namespace access
1562     upvar ::imagepp::${w}::options  options
1563     upvar ::imagepp::${w}::widgets  widgets
1564     upvar ::imagepp::${w}::localIds localIds
1565     upvar ::imagepp::${w}::hNeed    hNeed
1566     upvar ::imagepp::${w}::vNeed    vNeed
1567     upvar ::imagepp::${w}::actROI   actROI
1568     upvar ::imagepp::${w}::lastX    lastX
1569     upvar ::imagepp::${w}::lastY    lastY
1570
1571     set widgets(movingroi) 1
1572     $widgets(canvas) move [ lindex $actROI 4 ] \
1573         [ expr $x - $lastX ] \
1574         [ expr $y - $lastY ]
1575     $widgets(canvas) move [ lindex $actROI 0 ] \
1576         [ expr $x - $lastX ] \
1577         [ expr $y - $lastY ]
1578     $widgets(canvas) move [ lindex $actROI 1 ] \
1579         [ expr $x - $lastX ] \
1580         [ expr $y - $lastY ]
1581     $widgets(canvas) move [ lindex $actROI 2 ] \
1582         [ expr $x - $lastX ] \
1583         [ expr $y - $lastY ]
1584     $widgets(canvas) move [ lindex $actROI 3 ] \
1585         [ expr $x - $lastX ] \
1586         [ expr $y - $lastY ]
1587
1588     set lastX $x
1589     set lastY $y
1590
1591 }
1592
1593 #* PROCEDURE DESCRIPTION *************************************************
1594 #*                                                                       *
1595 #* ::imagepp::moveCorner (procedure)                                     *
1596 #*                                                                       *
1597 #* DESCRIPTION : Event callback. Move a rectangle corner.                *
1598 #*               This is a dummy proc, don't call it in your code.       *
1599 #*                                                                       *
1600 #* SYNTAX : ::imagepp::moveCorner %W %x %y $i                            *
1601 #*                                                                       *
1602 #* RETURN : -NONE-                                                       *
1603 #*                                                                       *
1604 #* PARAMETERS :                                                          *
1605 #*      w   : string. Widget name.                                       *
1606 #*      x   : string. x-coordinate.                                      *
1607 #*      y   : string. y-coordinate.                                      *
1608 #*      i   : string. Corner index.                                      *
1609 #*                                                                       *
1610 #******************************************************* END DESCRIPTION *
1611 proc ::imagepp::moveCorner { w x y i } {
1612
1613     # For namespace access
1614     upvar ::imagepp::${w}::options  options
1615     upvar ::imagepp::${w}::widgets  widgets
1616     upvar ::imagepp::${w}::localIds localIds
1617     upvar ::imagepp::${w}::hNeed    hNeed
1618     upvar ::imagepp::${w}::vNeed    vNeed
1619     upvar ::imagepp::${w}::actROI   actROI
1620     upvar ::imagepp::${w}::lastX    lastX
1621     upvar ::imagepp::${w}::lastY    lastY
1622
1623     set widgets(movingroi) 1
1624
1625     $widgets(canvas) move [ lindex $actROI $i ] \
1626         [ expr $x - $lastX ] \
1627         [ expr $y - $lastY ]
1628
1629     if { $i == 0 } {
1630
1631         $widgets(canvas) move [ lindex $actROI 1 ] \
1632             0 [ expr $y - $lastY ]
1633
1634         $widgets(canvas) move [ lindex $actROI 3 ] \
1635             [ expr $x - $lastX ] 0
1636
1637     } elseif { $i == 1 } {
1638
1639         $widgets(canvas) move [ lindex $actROI 0 ] \
1640             0 [ expr $y - $lastY ]
1641
1642         $widgets(canvas) move [ lindex $actROI 2 ] \
1643             [ expr $x - $lastX ] 0
1644
1645     } elseif { $i == 2 } {
1646
1647         $widgets(canvas) move [ lindex $actROI 3 ] \
1648             0 [ expr $y - $lastY ]
1649
1650         $widgets(canvas) move [ lindex $actROI 1 ] \
1651             [ expr $x - $lastX ] 0
1652
1653     } elseif { $i == 3 } {
1654
1655         $widgets(canvas) move [ lindex $actROI 2 ] \
1656             0 [ expr $y - $lastY ]
1657
1658         $widgets(canvas) move [ lindex $actROI 0 ] \
1659             [ expr $x - $lastX ] 0
1660
1661     }
1662
1663     # set area
1664     set c0 [ $widgets(canvas) coords [ lindex $actROI 0 ] ]
1665     set ux [ lindex $c0 0 ]; set uy [ lindex $c0 1 ]
1666     set bx [ lindex $c0 2 ]; set by [ lindex $c0 3 ]
1667
1668     set c0 [ $widgets(canvas) coords [ lindex $actROI 1 ] ]
1669     set ux [ expr ( [ lindex $c0 0 ] < $ux )? [ lindex $c0 0 ]: $ux ]
1670     set uy [ expr ( [ lindex $c0 1 ] < $uy )? [ lindex $c0 1 ]: $uy ]
1671     set bx [ expr ( [ lindex $c0 2 ] > $bx )? [ lindex $c0 2 ]: $bx ]
1672     set by [ expr ( [ lindex $c0 3 ] > $by )? [ lindex $c0 3 ]: $by ]
1673
1674     set c0 [ $widgets(canvas) coords [ lindex $actROI 2 ] ]
1675     set ux [ expr ( [ lindex $c0 0 ] < $ux )? [ lindex $c0 0 ]: $ux ]
1676     set uy [ expr ( [ lindex $c0 1 ] < $uy )? [ lindex $c0 1 ]: $uy ]
1677     set bx [ expr ( [ lindex $c0 2 ] > $bx )? [ lindex $c0 2 ]: $bx ]
1678     set by [ expr ( [ lindex $c0 3 ] > $by )? [ lindex $c0 3 ]: $by ]
1679
1680     set c0 [ $widgets(canvas) coords [ lindex $actROI 3 ] ]
1681     set ux [ expr ( [ lindex $c0 0 ] < $ux )? [ lindex $c0 0 ]: $ux ]
1682     set uy [ expr ( [ lindex $c0 1 ] < $uy )? [ lindex $c0 1 ]: $uy ]
1683     set bx [ expr ( [ lindex $c0 2 ] > $bx )? [ lindex $c0 2 ]: $bx ]
1684     set by [ expr ( [ lindex $c0 3 ] > $by )? [ lindex $c0 3 ]: $by ]
1685
1686     $widgets(canvas) coords [ lindex $actROI 4 ] \
1687         [ expr $ux + 6 ] \
1688         [ expr $uy + 6 ] \
1689         [ expr $bx - 6 ] \
1690         [ expr $by - 6 ]
1691
1692     set lastX $x
1693     set lastY $y
1694
1695 }
1696
1697 # EOF - imagepp.tcl