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 {} }