vertex
TCL/TK UseCase3
Abstract : Contains all procedure for creating and maintaining a vertex object.
Comments : Due to time limitation the Tcl group wanted to get as much of
the code working, tested, and debugged. The only way this was going
to happen was to have the Tcl code keep a structure of the objects so
that the unwritten C++ code wasn't needed to make the GUI work.
The procedure in this file for getting and setting can easily be
converted to call propagation patterns...but time won't allow us to
complete this task.
#
# vertex.tcl
#
#Contains procedures for creating new vertices and for retrieving and setting
#data related to vertex objects.
#
###
# Where is everything?
###
set bmp_Constr "constr.xbm"
set bmp_Alter "alter.xbm"
set BITMAP_PATH "bitmaps"
###
# Set up the vertex/node "data structure."
###
proc newVertex { name type {lbl ""} {lblOff { 0 -20 }} {coords { 0 0}} } {
#Makes global vars accessible
global Vertex bmp_Constr bmp_Alter iGraph inform changes
#Initializes new vertex array
set Vertex($name,Label) $lbl
set Vertex($name,LabelOff) $lblOff
set Vertex($name,Coords) $coords
set Vertex($name,EdgeOut) {}
set Vertex($name,EdgeIn) {}
set Vertex($name,Type) $type
eval set Vertex($name,Bitmap) \$bmp_$type
# Initialize the item IDs. (Tcl will use for
set Vertex($name,BmpID) -1
set Vertex($name,LabelID) -1
#Formats data that will be sent to C++
set formatted "{$coords}"
set formatted2 "{$lblOff}"
#Inform C++ of new vertex created by user
if {$inform == 1} {
if {$type == "Constr"} {
set changes yes
puts "Sending: $lbl $formatted $formatted2"
$iGraph cppCreCVertex: $lbl $formatted $formatted2
} else {
set changes yes
puts "Sending: $lbl $formatted $formatted2"
$iGraph cppCreAVertex: $lbl $formatted $formatted2
}
}
}
###
# The following functions are used to set and obtain data
# relating to vertex objects. If the need be, these functions
# could be used to call propogation patterns that would
# set or return the item requested.
###
#
#Sets the label of a given vertex
proc setVertexLabel { name label } {
global Vertex
set Vertex($name,Label) $label
}
#
#Returns the label of a given vertex
proc getVertexLabel { name } {
global Vertex
return $Vertex($name,Label)
}
#
#Sets the offset for the label of a given vertex
proc setVertexLabelOff { name offset } {
global Vertex iGraph changes
set changes yes
set Vertex($name,LabelOff) $offset
set formatted "{$offset}"
# puts "Sending: $name $formatted"
$iGraph cppUpdVLabel: $name $formatted
}
#
#Returns the label offset fot a given vertex
proc getVertexLabelOff { name } {
global Vertex
return $Vertex($name,LabelOff)
}
#
#Sets the coordinates of a given vertex
proc setVertexCoords { name coords } {
global Vertex iGraph changes
set changes yes
set Vertex($name,Coords) $coords
set formatted "{$coords}"
# puts "Sending: $name $formatted"
$iGraph cppUpdVertex: $name $formatted
}
#
#Returns the coordinates of a given vertex
proc getVertexCoords { name } {
global Vertex
return $Vertex($name,Coords)
}
#
#Appends a new outgoing vertex to the list
proc appendVertexEdgeOut { name edgeName } {
global Vertex
lappend Vertex($name,EdgeOut) $edgeName
}
#
#Returns the list of outgoing vertices
proc getVertexEdgeOut { name } {
global Vertex
return $Vertex($name,EdgeOut)
}
#
#Appends a new incoming vertex to the list
proc appendVertexEdgeIn { name edgeName } {
global Vertex
lappend Vertex($name,EdgeIn) $edgeName
}
#
#Returns the list of incoming vertices
proc getVertexEdgeIn { name } {
global Vertex
return $Vertex($name,EdgeIn)
}
#
#Returns the type of a given vertex
proc getVertexType { name } {
global Vertex
return $Vertex($name,Type)
}
#
#Returns the bitmap of a vertex
proc getVertexBitmap { name } {
global Vertex
return $Vertex($name,Bitmap)
}
#
#Sets the bitmap id for a given vertex
proc setVertexBmpID { name id } {
global Vertex
set Vertex($name,BmpID) $id
}
#
#Returns the bitmap id of a vertex
proc getVertexBmpID { name } {
global Vertex
return $Vertex($name,BmpID)
}
#
#Sets the label id of a vertex
proc setVertexLabelID { name id } {
global Vertex
set Vertex($name,LabelID) $id
}
#
#Returns the label id of a vertex
proc getVertexLabelID { name } {
global Vertex
return $Vertex($name,LabelID)
}
###
#Creates a new vertex and label, each with the proper bindings, on the canvas
###
proc createVertex { name } {
#Makes global vars accessible
global BITMAP_PATH can
#Initializes coordinate and name vars
set shapeX [getXCoord [getVertexCoords $name]]
set shapeY [getYCoord [getVertexCoords $name]]
set bmpName [getVertexBitmap $name]
set labelName [getVertexLabel $name]
set labelX [expr $shapeX + [getXCoord [getVertexLabelOff $name]]]
set labelY [expr $shapeY + [getYCoord [getVertexLabelOff $name]]]
#Creates vertex and label objects
set node [$can create bitmap $shapeX $shapeY \
-bitmap "@$BITMAP_PATH/$bmpName" -tags "$name _vertex_"]
set nodelabel [$can create text $labelX $labelY \
-text $labelName -tags "$name _label_ _vertex_"]
$can lower $node
#Adds event bindings to the vertex and label
$can bind $node " onVertDown $name %x %y "
$can bind $node " onVertMove $name %x %y "
$can bind $node " onVertUp $name %x %y "
$can bind $nodelabel " onVertLblMove $name %x %y "
$can bind $nodelabel " onVertUp $name %x %y "
$can bind $name "onVertEnter $name %x %y"
$can bind $name "onVertLeave $name %x %y"
#Sets ids
setVertexBmpID $name $node
setVertexLabelID $name $nodelabel
setVertexLabelOff $name [getVertexLabelOff $name]
}
###
#Resets the coordinates of a vertex label after its vertex is moved
###
proc moveVertexLabel { name {coords {0 -20}} } {
global can
setVertexLabelOff $name $coords
#Calculates where the label should be moved to
set bmpX [getXCoord [getVertexCoords $name]]
set bmpY [getYCoord [getVertexCoords $name]]
set newX [expr $bmpX + [getXCoord $coords]]
set newY [expr $bmpY + [getYCoord $coords]]
set id [getVertexLabelID $name]
$can coords $id $newX $newY
}
###
#Resets the coordinates of a moved vertex
###
proc moveVertex { name coords } {
global can
setVertexCoords $name $coords
set id [getVertexBmpID $name]
$can coords $id [getXCoord $coords] [getYCoord $coords]
#Moves the label relative to the new vertex position
moveVertexLabel $name [getVertexLabelOff $name]
}
###
#Redraws the edges going in and out of a given vertex
###
proc vertRedrawEdges { name } {
foreach i [getVertexEdgeIn $name] { createEdge $i }
foreach i [getVertexEdgeOut $name] { createEdge $i }
}
# Cool Hiliting stuff...
###
#Highlights a vertex and its label
###
proc vertHilite { name color } {
global can lastHilited
$can itemconfigure [getVertexLabelID $name] -fill $color
$can itemconfigure [getVertexBmpID $name] -background $color
set lastHilited $name
}
###
#Unhighlights a vertex and label
###
proc vertUnhilite { name } {
global can
$can itemconfigure [getVertexLabelID $name] -fill black
$can itemconfigure [getVertexBmpID $name] -background {}
}