edge
TCL/TK UseCase4
Abstract : Contains all procedure for creating and maintaining an edge object.
Comments : The procedures in this file for getting and setting can easily be
converted to call propagation patterns.
For Use Case 4 we have switch from having Tcl/Tk track objects
(which was done through label name) to have C++ track them
with a unique ID number passed to Tcl/Tk. This will allow for
better tracking and object manipulation. In files edge.tcl,
vertex.tcl, and bindings.tcl, most any referrence to the
varible "name" or "$name" is actually the ID number.
#
#edge.tcl
#
#Contains procedures for creating new edges and for retrieving and setting
#data related to edge objects
#####
###
# Bend node ovels...
###
###
#Calculates how to size the bendy node ovals
###
proc calcOval { x y } {
set width 6
set left [expr $x - ($width / 2)]
set top [expr $y - ($width / 2)]
set right [expr $left + $width]
set bottom [expr $top + $width]
return "$left $top $right $bottom"
}
###
#Determines which bendy node of an edge is selected
###
proc findListEntry { theList itemID } {
set index 0
foreach i $theList {
if {[lindex $i 0] == $itemID} {
return $index
}
incr index
}
return -1
}
###
# Set up an edge "data structure."
###
proc newEdge { name lbl type srcVert dstVert {lblOff {0 -20}} {nodes {}}} {
#Makes global vars accessible
global Edge iGraph inform changes
#Makes C++ calls for new edge. Only does this for user interaction.
#Also changes global flag "changes" to yes for a save changes check.
if {$inform == 1} {
# reformats some data that will be passed to C++
puts $nodes
if {$nodes != ""} {
set formatted "{$nodes}"
} else {
set formatted " "
}
set formatted2 "{$lblOff}"
if {$type == "Constr"} {
set changes yes
puts "Sending: $lbl $srcVert $dstVert $formatted2 $formatted"
set name [$iGraph cppCreCEdge: $lbl [fixID $srcVert]\
[fixID $dstVert] $formatted2\
$formatted]
} else {
set changes yes
puts "Sending: $srcVert $dstVert $formatted2 $formatted"
set name [$iGraph cppCreAEdge: [fixID $srcVert] [fixID $dstVert]\
$formatted]
} } else {
set srcVert ID$srcVert
set dstVert ID$dstVert
}
#puts "Getting: $name $lbl"
set name ID$name
#Initializes vars in Edge array
set Edge($name,Label) $lbl
set Edge($name,LabelOff) $lblOff
set Edge($name,srcVert) $srcVert
set Edge($name,dstVert) $dstVert
set Edge($name,nodeCoords) $nodes
set Edge($name,Type) $type
#Set pointers to procedures on how to creates the edge and edge label.
#There are different was for creating different edges.
set Edge($name,cmdCreate) createEdge_$type
set Edge($name,cmdCreateLbl) createEdgeLabel_$type
# initialize the item IDs (used for Tcl/Tk binding.)
set Edge($name,LabelID) -1
set Edge($name,LineIDs) {}
set Edge($name,OvalIDs) {}
#Adds new edge to the edge lists of its source and destination
appendVertexEdgeOut $srcVert $name
appendVertexEdgeIn $dstVert $name
createEdge $name
}
###
# The following functions are used to set and obtain data
# relating to edge objects. If the need be, these functions
# could be used to call propogation patterns that would
# set or return the item requested.
###
#
#Returns the type of a given edge.
proc getEdgeType { name } {
global Edge
return $Edge($name,Type)
}
#
#Sets the label of a given edge
proc setEdgeLabel { name lbl } {
global Edge
set Edge($name,Label) $lbl
}
#
#Returns the label of an edge
proc getEdgeLabel { name } {
global Edge
return $Edge($name,Label)
}
#
# Sends label update to C++
proc setEdgeLabelOff { name offset } {
global Edge iGraph changes
set changes yes
set Edge($name,LabelOff) $offset
set formatted "{$offset}"
# puts "Sending: $name $formatted"
$iGraph cppUpdELabel: [fixID $name] $formatted
# $iGraph cppUpdELabel: $name [getEdgeSrcVert $name] [getEdgeDstVert $name]\
# $formatted
}
#
#Returns the label offset for an edge
proc getEdgeLabelOff { name } {
global Edge
return $Edge($name,LabelOff)
}
#
#Returns the comand to create an edge.
proc getEdgeCreateCmd { name } {
global Edge
return $Edge($name,cmdCreate)
}
#
#Returns the command to create an edge label
proc getEdgeCreateLblCmd { name } {
global Edge
return $Edge($name,cmdCreateLbl)
}
#
#Sets the source vertex of an edge
proc setEdgeSrcVert { name vert } {
global Edge
set Edge($name,srcVert) $vert
}
#
#Returns the source vertex of an edge
proc getEdgeSrcVert { name } {
global Edge
return $Edge($name,srcVert)
}
#
#Sets the destination vertex of an edge
proc setEdgeDstVert { name vert } {
global Edge
set Edge($name,dstVert) $vert
}
#
#Returns the destination vertex of an edge
proc getEdgeDstVert { name } {
global Edge
return $Edge($name,dstVert)
}
#
# Informs C++ of start/end node for an edge.
proc setEdgeNodeCoords { name coords } {
global Edge iGraph changes
set changes yes
set Edge($name,nodeCoords) $coords
set formatted "{$coords}"
#puts "Sending: $name $formatted"
$iGraph cppUpdEdge: [fixID $name] $formatted
}
#
#Returns the node coordinates for a bendy node
proc getEdgeNodeCoords { name } {
global Edge
return $Edge($name,nodeCoords)
}
#
#Sets the label canvas id for an edge
proc setEdgeLabelID { name id } {
global Edge
set Edge($name,LabelID) $id
}
#
#Returns the label canvas id for an edge
proc getEdgeLabelID { name } {
global Edge
return $Edge($name,LabelID)
}
#
#Sets the line canvas id for an edge
proc setEdgeLineIDs { name ids } {
global Edge
set Edge($name,LineIDs) $ids
}
#
#Returns the line canvas id for an edge
proc getEdgeLineIDs { name } {
global Edge
return $Edge($name,LineIDs)
}
#
#Sets the oval id for an edge
proc setEdgeOvalIDs { name ids } {
global Edge
set Edge($name,OvalIDs) $ids
}
#
#Returns the oval id for an edge
proc getEdgeOvalIDs { name } {
global Edge
return $Edge($name,OvalIDs)
}
#
#Clears the edge ids for an edge that is being refreshed
proc clearEdgeIDs { name } {
global Edge
set Edge($name,LineIDs) {}
set Edge($name,OvalIDs) {}
}
###
#Deletes an edge associated with a node that has been moved (screen refresh)
###
proc deleteEdgeObjects { name } {
global Edge can
#Deletes lines
foreach i $Edge($name,LineIDs) {
for {set x 0} {$x < [llength $i]} {incr x 2} {
$can delete [lindex $i $x]
}
}
#Deletes bendy point ovals
foreach i $Edge($name,OvalIDs) { $can delete [lindex $i 0] }
#Deletes the label
$can delete [getEdgeLabelID $name]
clearEdgeIDs $name
setEdgeLabelID $name -1
}
###
#Creates a construction edge on the canvas
###
proc createEdge_Constr { name srcCoords dstCoords lst index {arrow 1} } {
global can
upvar $lst List
#Creates the line
set itemID [$can create line \
[lindex $srcCoords 0] [lindex $srcCoords 1] \
[lindex $dstCoords 0] [lindex $dstCoords 1] \
-tags "$name"]
#Creates the arrow
if {$arrow != 0} {
$can itemconfigure $itemID -arrow last
}
lappend List "$itemID $index"
$can raise $itemID
$can bind $itemID " onEdgeLineDbl $name %x %y "
return $itemID
}
###
# Calulate || lines for alternation edges.
###
proc calcAlterSlope { SourceX SourceY DestX DestY } {
set space 3
if {[expr ($DestX - $SourceX)] != 0} {
#Determines the slope of the edge
set slope [expr abs((($DestY - $SourceY) * 100) / ($DestX - $SourceX))]
#For more vertically inclined edges, offsets x coords
if {[expr $slope] >= 100} {
set xspace $space
set yspace 0
} else {
#For more horizontally inclined edges, offsets y coords
set xspace 0
set yspace $space
}
} else {
set yspace 0
set xspace $space
}
return "$xspace $yspace"
}
###
#Creates an alternation edge on the canvas.
###
proc createEdge_Alter { name srcCoords dstCoords lst index {arrow 1} } {
global can
upvar $lst List
#Determine slope and offsets for lines
set slope [calcAlterSlope [getXCoord $srcCoords] [getYCoord $srcCoords] \
[getXCoord $dstCoords] [getYCoord $dstCoords]]
set xspace [getXCoord $slope]
set yspace [getYCoord $slope]
#Create first line with arrow
set itemID [$can create line \
[expr [lindex $srcCoords 0] - $xspace ] \
[expr [lindex $srcCoords 1] - $yspace ] \
[expr [lindex $dstCoords 0] - $xspace ] \
[expr [lindex $dstCoords 1] - $yspace ] \
-tags "$name"]
if {$arrow != 0} {
$can itemconfigure $itemID -arrow last
}
#Create second line with arrow
set itemID2 [$can create line \
[expr [lindex $srcCoords 0] + $xspace ] \
[expr [lindex $srcCoords 1] + $yspace ] \
[expr [lindex $dstCoords 0] + $xspace ] \
[expr [lindex $dstCoords 1] + $yspace ] \
-tags "$name"]
if {$arrow != 0} {
$can itemconfigure $itemID2 -arrow last
}
lappend List "$itemID $index $itemID2 $index"
$can raise $itemID
$can raise $itemID2
#Create bindings for removing and adding bends
$can bind $itemID " onEdgeLineDbl $name %x %y "
$can bind $itemID2 " onEdgeLineDbl $name %x %y "
return "$itemID $itemID2"
}
###
# Find midpoint between 2 nodes.
###
proc edgeCalcMidpoint { name } {
#Initialize vars
set srcVertName [getEdgeSrcVert $name]
set dstVertName [getEdgeDstVert $name]
set srcCoords [getVertexCoords $srcVertName]
set dstCoords [getVertexCoords $dstVertName]
#Calculate midpoint
set srcCoords [getVertexCoords $srcVertName]
set dstCoords [getVertexCoords $dstVertName]
set midX [expr (([getXCoord $dstCoords] - [getXCoord $srcCoords]) / 2) + \
[getXCoord $srcCoords]]
set midY [expr (([getYCoord $dstCoords] - [getYCoord $srcCoords]) / 2) + \
[getYCoord $srcCoords]]
return "$midX $midY"
}
###
#Create the label for a construction edge.
###
proc createEdgeLabel_Constr { name } {
global can
#Initialize vars
set srcVertName [getEdgeSrcVert $name]
set dstVertName [getEdgeDstVert $name]
set srcCoords [getVertexCoords $srcVertName]
set dstCoords [getVertexCoords $dstVertName]
#Calculate midpoint
set srcCoords [getVertexCoords $srcVertName]
set dstCoords [getVertexCoords $dstVertName]
set midX [expr (([getXCoord $dstCoords] - [getXCoord $srcCoords]) / 2) + \
[getXCoord $srcCoords]]
set midY [expr (([getYCoord $dstCoords] - [getYCoord $srcCoords]) / 2) + \
[getYCoord $srcCoords]]
#Determine label coordinates based on midpoint of line
set labelX [expr $midX + [getXCoord [getEdgeLabelOff $name]]]
set labelY [expr $midY + [getYCoord [getEdgeLabelOff $name]]]
#Create the label object
set labelName [getEdgeLabel $name]
set label [$can create text $labelX $labelY \
-text $labelName -tags "_label_ $name"]
#Set bindings
$can bind $label " onEdgeLblMove $name %x %y "
setEdgeLabelID $name $label
}
#
#No such thing!
proc createEdgeLabel_Alter { name } {
}
###
#Creates an edge on the canvas
###
proc createEdge { name } {
global can
#Removes any existing edge
deleteEdgeObjects $name
#Initialize vars
set createEdgeCmd [getEdgeCreateCmd $name]
set srcVertName [getEdgeSrcVert $name]
set dstVertName [getEdgeDstVert $name]
set lnCoords [getEdgeNodeCoords $name]
set lnCoords [linsert $lnCoords 0 [getVertexCoords $srcVertName]]
lappend lnCoords [getVertexCoords $dstVertName]
set srcCoords [lindex $lnCoords 0]
set Lines {}
set Ovals {}
#Create bendy nodes
for {set index 1} { $index < [expr [llength $lnCoords] - 1]} {incr index} {
#Get destination of next line
set dstCoords [lindex $lnCoords $index]
set itemID [$createEdgeCmd $name $srcCoords $dstCoords Lines $index]
# lappend Lines "$itemID $index"
#Create oval node
set ovalCoords [calcOval [lindex $dstCoords 0] [lindex $dstCoords 1]]
set itemID [$can create oval \
[lindex $ovalCoords 0] [lindex $ovalCoords 1] \
[lindex $ovalCoords 2] [lindex $ovalCoords 3] \
-fill red]
lappend Ovals "$itemID $index"
$can raise $itemID
#Create bindings for bend points
# $can bind $itemID { onOvalDown %x %y }
$can bind $itemID " onOvalMove $name %x %y "
$can bind $itemID " onEdgeOvalUp $name %x %y "
$can bind $itemID " onEdgeOvalDbl $name %x %y "
set srcCoords $dstCoords
}
#Create edge
set dstCoords [lindex $lnCoords $index]
set itemID [$createEdgeCmd $name $srcCoords $dstCoords Lines $index 0]
# lappend Lines "$itemID $index"
#Add arrows to lines
if {$index == 1} {
foreach i $itemID {
$can itemconfigure $i -arrow last
}
}
#Set ids for lines and nodes
setEdgeLineIDs $name $Lines
setEdgeOvalIDs $name $Ovals
#Create edge label
set cmdCreateLabel [getEdgeCreateLblCmd $name]
$cmdCreateLabel $name
#Add bindings for edges
$can bind $name " onEdgeEnter $name %x %y "
$can bind $name " onEdgeLeave $name %x %y "
$can bind $name " onEdgeUp $name %x %y "
}
###
#Generic loop to search through a list of edge items
###
proc getEdgeItemIndex { theList itemID } {
set index 0
foreach i $theList {
for {set x 0} {$x < [llength $i]} {incr x 2} {
if {[lindex $i $x] == $itemID} {
return $index
}
incr index
}
}
return -1
}
