#this example shows the joint movement of circles with text that overlap #wm title . "Circles with text example - copyright C.Hicks 2/2001" #wm minsize . 500 300 #first canvas with the specified dimensions as a child of the frame .f canvas .c -height 10c -width 10c pack .c #initialise the variables set nodeno 0; #this procedure based upon Ousterhout's book p213 proc mkNode {x y} { #puts "into mkNode" #nodeno is the number of each node #nodetext is the id for the text associated with the node #nodeX and nodeY are the coordinates of the text global nodeno nodetext nodeX nodeY nodeNum #get the next available integer to number the node incr nodeno #create the node and store and record the object id in variable new set new [.c create oval [expr $x-10] [expr $y-10] \ [expr $x+10] [expr $y+10] -outline black -fill white -tags node] set nodeX($new) $x set nodeY($new) $y #store the node number associated with the node id in an array set nodeNum($new) $nodeno #create the text and locate it in the centre of the node set newtext [.c create text $x $y -text $nodeno -tags textno] set nodeX($newtext) $x set nodeY($newtext) $y #store the the id of the text associated with the circle in an array. #index is the node id the value is the textid set nodetext($new) $newtext #produce some tcl output so we know what is happening puts "circle $nodeno has id $new with text id $newtext" set xlist [array names nodeX] puts "xlist = $xlist" set ylist [array names nodeY] puts "ylist = $ylist" } #another procedure based upon Ousterhout proc moveNode {node xDist yDist} { puts "moveNode item = $node" #pick up the global variables generated by mkNode global nodetext nodeX nodeY .c move $node $xDist $yDist #next we have to look up which text to move and move it #we need an error check because it seems that this proc is #sometimes called by mistake if tk is confused which object is current set nodelist [array names nodetext] puts "nodelist = $nodelist" #now search through the list arraylist to see if the element exists #lsearch returns either the position in the array or -1 if it does not #exist if {[lsearch $nodelist $node] >= 0} { puts "node $node exists" .c move $nodetext($node) $xDist $yDist } else {puts "node $node is not a node!" #we know the node id is always equal to the textid -1 set propernode [expr $node -1] #puts "propernode=$propernode" #puts "nodeX($propernode)=$nodeX($propernode), $nodeY($propernode)" #puts "nodeX($node) = $nodeX($node), $nodeY($node)" set ratio 0.01 .c move $propernode $xDist $yDist .c move $node [expr $xDist*$ratio] [expr $yDist*$ratio] } } #now a new procedure for moving cicles with text proc moveText {txt xDist yDist} { puts "move text item = $txt" .c move $txt $xDist $yDist } puts "program running" #define the action to be taken when mouse button 1 is pressed bind .c { puts "Button 1" mkNode %x %y } .c bind node { set curX %x set curY %y } .c bind node { puts "Item located is [.c find withtag current]" moveNode [.c find withtag current] [expr %x - $curX] \ [expr %y -$curY] set curX %x set curY %y } .c bind textno { set curX %x set curY %y puts "In textno button-2: curX=$curX, curY=$curY" } .c bind textno { puts "Item located is [.c find withtag current]" puts "%x - curX= [expr %x - $curX], %y-curY=[expr %y-$curY]" moveNode [.c find withtag current] [expr %x - $curX] \ [expr %y -$curY] set curX %x set curY %y } focus .c