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