#this is the same as canvas2.txt with extensions to get the edges to
#start at the node boundary, rather than using the lower command.
#this is achieved through the addition of a new procedure adjline and
#two extra global array variables nodeFirst and nodeSecond which
#record which nodes are at the begining and end of each edges.

#the next few lines kill of existing tk objects - just in case you
#want to repeat the source statement in the same wish window.
if [winfo exists .c] {destroy .c}
if [winfo exists .yscroll] {destroy .yscroll}
if [winfo exists .xscroll] {destroy .xscroll}
if [winfo exists .f] {destroy .f}

frame .f
pack .f -side top -fill both -expand 1 

#create the canvas with scroll bars .f.c and .f.yscroll are children of .f
canvas .f.c -yscrollcommand ".f.yscroll set" -xscrollcommand ".xscroll set"
scrollbar .f.yscroll -command ".f.c yview"
scrollbar .xscroll -orient horizontal -command ".f.c xview"

#pack the canvas - good examples of packing in Welch's book
pack .xscroll -side bottom -fill x -padx 1m -pady 1m -expand 1
pack .f.yscroll -side right -fill y -padx 1m -pady 1m -expand 1
pack .f.c -side left -fill both -expand 1 -padx 1m -pady 1m

#this example uses procedures - notice the use of indents
proc mkNode {x y} {
        #variables which need to be used outside the procedure need to
	# be specified as global - try to avoid global variables as
	#much as possible
	global nodeX nodeY edgeFirst edgeSecond

	#for details on tk commands look in the manual
	#when the oval is created an integer is returned, the value of
	#which is assigned to the variable new .f.c is a child of .f
	set new [.f.c create oval [expr $x-10] [expr $y-10] \
	[expr $x+10] [expr $y+10] -outline black \
	-fill white -tags node]

	#these arrays remember where the nodes and located.
	set nodeX($new) $x
	set nodeY($new) $y

	#these arrays record which lines start and finish at the node
	#they are set to null because there are no lines yet!
	set edgeFirst($new) {}
	set edgeSecond($new) {}
	}

proc mkEdge {first second} {
	#first is the start node, second is the finish node
	#Two new arrays are added nodeFirst and nodeSecond to remember 
	#which node each line goes from and to
	global nodeX nodeY edgeFirst edgeSecond nodeFirst nodeSecond \
		x1d y1d x2d y2d

	# we need to adjust the coordinates of the line begining and end.	
	adjline 10 $nodeX($first) $nodeY($first) \
			$nodeX($second) $nodeY($second)
	#the procedure modifies the values of x1d y1d x2d and y2d
	#this is not wonderful programming because it uses global variables

	#create the line and assign the integer returned to the variable edge
	set edge [.f.c create line $x1d $y1d $x2d $y2d]
	
	#record the start and end nodes
	set nodeFirst($edge) $first
	set nodeSecond($edge) $second
	

	#add the new line to the line of lines starting at the first node
	lappend edgeFirst($first) $edge

	#add the new line to the line of lines finishing at the second node
	lappend edgeSecond($second) $edge
	}

#this procedure calculates where lines join circular nodes
proc adjline {nodesize x1 y1 x2 y2} {
 	global x1d y1d x2d y2d
	set adj [expr $x1 - $x2]
	set opp [expr $y1 - $y2]
	set alpha [expr atan2 ($opp,$adj)]
	set deltax [expr $nodesize * [expr cos ($alpha)]]
	set deltay [expr $nodesize * [expr sin ($alpha)]]
	set x1d [expr $x1 - $deltax]; set y1d [expr $y1 - $deltay]
	set x2d [expr $x2 + $deltax]; set y2d [expr $y2 + $deltay]
}


proc moveNode {node xDist yDist} {
	#node the extra global variables x1d y1d x2d y2d so that I can use
	#adjline again - my use of global variables is not wonderful.
	global nodeX nodeY edgeFirst edgeSecond x1d y1d x2d y2d \
		nodeFirst nodeSecond

	#a canvas command follows see the tk manual entry for canvas
	.f.c move $node $xDist $yDist

	#next change the values of x and y to reflect the distance moved.
	incr nodeX($node) $xDist
	incr nodeY($node) $yDist

	#we have now moved the node - next we need to move all the lines
	#connected to the node
	foreach edge $edgeFirst($node) {
		set x1d $nodeX($node)
		set y1d $nodeY($node)
		set x2d $nodeX($nodeSecond($edge))
		set y2d $nodeY($nodeSecond($edge))

		#calculate the position of the line ends
		adjline 10 $x1d $y1d $x2d $y2d

		#move the start point accordingly
		.f.c coords $edge $x1d $y1d $x2d $y2d
		#lindex extracts items from a list
		.f.c coords $edge $x1d $y1d $x2d $y2d
		}
	foreach edge $edgeSecond($node) {
		set x1d $nodeX($nodeFirst($edge))
		set y1d $nodeY($nodeFirst($edge))
		set x2d $nodeX($node)
		set y2d $nodeY($node)
		adjline 10 $x1d $y1d $x2d $y2d
		
		#same idea again - move the end points
		.f.c coords $edge $x1d $y1d $x2d $y2d
		}
	}

#binding defines an action when an event occurs - in this case pressing
#button 1
bind .f.c <Button-1> {
	puts "Button 1 pressed"
	mkNode %x %y   
}

.f.c bind node <Any-Enter> {
	.f.c itemconfigure current -fill black
	}
.f.c bind node <Any-Leave> {
	.f.c itemconfigure current -fill white
}

#binding on keyboard characters "1" and "2" to select start and end nodes
#for lines
bind .f.c <KeyPress-1> {set firstNode [.f.c find withtag current]}
bind .f.c <KeyPress-2> {set curNode [.f.c find withtag current]
	if {($firstNode != {}) && ($curNode != "")} {
	mkEdge $firstNode $curNode
	}
	}

.f.c bind node <Button-3> {
	#change the colour of the node to black to indicate that it is picked
	.f.c itemconfigure current -fill black
	puts "Button 3 pressed"
	set curX %x
	set curY %y
	}

.f.c bind node <B3-Motion> {
	puts "Button 3 motion"
	moveNode [.f.c find withtag current] [expr %x-$curX] \
		[expr %y-$curY]
	set curX %x
	set curY %y
	}

focus .f.c