# Color : global array mapping user names to colors
# Owner : global array translating a canvas name into its owner's name
# Others : global array giving the canvases coupled to a given canvas
global Color
global Owner
global Others

# bindings to manage the telepointers
#
global lastX lastY

bind Telepointer <Enter> {
	set tag tptr-$Owner(%W)
	set lastX %x
	set lastY %y
	set color $Color($Owner(%W))
	foreach w $Others(%W) {
		# createTelepointer $w %W %x %y
#		$w create rectangle %x %y [expr %x + 5] [expr %y + 5] -tags $tag
		set arrow {{0 0} {12 0} {8 4} {16 12} {12 16} {4 8} {0 12}}
		set poly {}
		foreach p $arrow {
			set x [lindex $p 0]
			set y [lindex $p 1]
			lappend poly [expr %x + $x]
			lappend poly [expr %y + $y]
		}
		eval $w create polygon $poly -fill $color -tags $tag
	}
}

bind Telepointer <Motion> {
	set tag tptr-$Owner(%W)
	foreach w $Others(%W) {
		# moveTelepointer $w %W %x %y
		$w move $tag [expr %x - $lastX] [expr %y - $lastY]
	}
	set lastX %x
	set lastY %y
}

bind Telepointer <Leave> {
	set tag tptr-$Owner(%W)
	foreach w $Others(%W) {
		# deleteTelepointer $w %W %x %y
		$w delete $tag
	}
}

# create a shared canvas
#	c	pathname of the canvas to create
#	owner	name of canvas's owner
#	other	the pathname of another canvas to be coupled with it
proc sharedCanvas {c {owner {}} {other {}} args} {
	global Owner Others
	eval canvas $c -borderwidth 3 -relief raised $args
	bindtags $c [linsert [bindtags $c] 1 Telepointer]
	set Owner($c) $owner
	if {[string length $other] > 0} {
		set others $Others($other)
		lappend others $other
		foreach w $others {
			lappend Others($w) $c
			lappend Others($c) $w
		}
	} else {
		set Others($c) {}
	}
	return $c
}

set Color(Michel) red
set Color(Alain) green

wm geometry . [winfo screenwidth .]x[winfo screenheight .]+0+0

place [sharedCanvas .c1 Michel {} -width 150 -height 200 -bg #aaffaa] -x 50 -y 50
place [sharedCanvas .c2 Alain .c1 -width 150 -height 200 -bg #ffaaaa] -x 350 -y 50

place [sharedCanvas .c3 Michel {} -width 150 -height 150 -bg #aaff44] -x 100 -y 200
place [sharedCanvas .c4 Alain .c3 -width 150 -height 150 -bg #ffaa44] -x 400 -y 200

bind . <Key> {
	move .c2 50 10 150
	move .c4 200 -10 50
}

proc move {w y inc lim} {
	incr y $inc
	place configure $w -y $y
	if {($inc > 0 && $y < $lim) || ($inc < 0 && $y > $lim)} {
		after 100 [list move $w $y $inc $lim]
	}
	update idletasks
}