#866 Canvas 'scale' command seems to disable item bindings

[Brent B. Welch]

OriginalBugID: 2461 Bug
Version: 8.1
SubmitDate: '1999-07-28'
LastModified: '1999-10-22'
Severity: SER
Status: UnAssn
Submitter: techsupp
ChangedBy: hobbs
OS: Solaris
OSVersion: SunOS polaris 5.7 Generic sun4u sparc SUNW,Ultra-5_10
Machine: Other

Name:David F. Skoll

ReproducibleScript:
Sorry for the long script which follows. When you run it, it creates a
green circle in a black canvas. If you move the pointer into the
circle, it prints "Ouch!" on stdout.

To zoom the canvas, click Button-1 somewhere, move the mouse and click
Button-1 again. This scales items on the canvas. Now (usually!) when
the mouse pointer enters the circle, nothing is printed on stdout -- the
binding on the "oval" tag seems to have been dropped.

Usage:
wish
% source tagbug.tcl

--- tagbug.tcl follows ---
proc fit { w } {
set bbox [$w bbox zoom]
if {$bbox == ""} {
set bbox [$w bbox all]
}
if {$bbox == ""} {
return
}
foreach {x1 y1 x2 y2} $bbox {break}
$w move all [expr -1*$x1] [expr -1*$y1]
set bbox [$w bbox zoom]
if {$bbox == ""} {
set bbox [$w bbox all]
}
foreach {x1 y1 x2 y2} $bbox {break}
set width [winfo width $w]
set height [winfo height $w]

set dx [expr $x2 - $x1]
set dy [expr $y2 - $y1]
set xscale [expr (1.0 * $width) / (1.0 * $dx)]
set yscale [expr (1.0 * $height) / (1.0 * $dy)]
if {$xscale < $yscale} {
set scale $xscale
} else {
set scale $yscale
}
$w scale all 0 0 $scale $scale
}

set zoombox {}
canvas .c -width 500 -height 500 -bg black
pack .c

.c create oval 100 100 150 150 -outline red -fill green -tags oval
.c bind oval <Enter> [list puts "Ouch!"]
bind .c <ButtonPress-1> [list press %x %y]
bind .c <Motion> [list move %x %y]

proc press { x y } {
variable zoombox
if {$zoombox == ""} {
set zoombox [list $x $y]
return
}
foreach {x1 y1} $zoombox {break}
set zoombox {}
.c delete withtag rubber
zoom $x1 $y1 $x $y
}

proc move { x y } {
variable zoombox
if {$zoombox == ""} {
return
}
foreach {x1 y1} $zoombox {break}
.c delete withtag rubber
.c create rectangle $x1 $y1 $x $y -outline green -tags rubber
}

proc zoom {x1 y1 x2 y2} {
.c delete withtag zoom
.c create rectangle $x1 $y1 $x2 $y2 -outline {} -tags zoom
fit .c
}

ObservedBehavior:
It seems that scaling items in a canvas sometimes cancels item bindings.

DesiredBehavior:
I expect item bindings to remain regardless of scaling

[Donal K. Fellows]

It doesn't really cancel the bindings. Nothing so simple to track down. When I ran the code, the first zoom in caused the <Enter> binding not to fire, but the second zoom in let it do so again. Bizarre!

[Donal K. Fellows]

Logged In: YES
user_id=79902

The problem seems to be the stacking order of the rectangle
with tag name 'zoom'! This is in fact not a Tk bug, but
rather a script bug. (Invisible items can still affect
bindings by design; invisible areas are useful in scenarios
rather like HTML image maps.)

Either lower the zoom item after creating it or delete it
after running the fit proc. Or dispense with passing the
zoom area like that and pass it as coordinates (which you
have already!)