package require Tk
#-------
# movement handler
#-------
proc drag.canvas.item {canWin item newX newY} {
set xDiff [expr {$newX - $::x}]
set yDiff [expr {$newY - $::y}]
#test before moving
if {[inside $canWin $item $xDiff $yDiff]} {
puts inside
$canWin move $item $xDiff $yDiff
}
set ::x $newX
set ::y $newY
}
#-------
# test to see if the new position is outside the canvas viewport
#-------
proc inside {w item xDiff yDiff} {
#canvas extents
set can(minx) -1
set can(miny) -1
set can(maxx) [winfo width $w ]
set can(maxy) [winfo height $w ]
#item coords
set item [$w coords $item]
#check min values
foreach {x y} $item {
set x [expr $x + $xDiff]
set y [expr $y + $yDiff]
if {$x < $can(minx)} {
return 0
}
if {$y < $can(miny)} {
return 0
}
if {$x > $can(maxx)} {
return 0
}
if {$y > $can(maxy)} {
return 0
}
}
#puts $item
return 1
}
#-------
# test it
#-------
pack [canvas .c -bg white] -expand 1 -fill both
button .b -text "Test Button"
.c create rectangle 0 0 100 100 -fill red -tag tag
.c bind tag <1> {
set ::x %X
set ::y %Y
}
.c bind tag <B1-Motion> [list drag.canvas.item .c tag %X %Y]Category GUI Category Widget

