vertex

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.


###
# 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}} } {
    global Vertex bmp_Constr bmp_Alter iGraph inform changes
    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
    set Vertex($name,BmpID) -1
    set Vertex($name,LabelID) -1
    set formatted "{$coords}"
    set formatted2 "{$lblOff}"
    # here call cppAddNewVertex to put vertex in Demeter's hierarchy

	set changes yes
  if {$inform == 1} {
    if {$type == "Constr"} {
        puts "Sending: $lbl $formatted $formatted2"
	$iGraph cppCreCVertex: $lbl $formatted $formatted2
    } else {
        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.
###
proc setVertexLabel { name label } {
    global Vertex
    set Vertex($name,Label) $label
}

proc getVertexLabel { name } {
    global Vertex
    return $Vertex($name,Label)
}

proc setVertexLabelOff { name offset } {
    global Vertex iGraph
    set Vertex($name,LabelOff) $offset
    set formatted "{$offset}"
    puts "Sending: $name $formatted"
    $iGraph cppUpdVLabel: $name $formatted
}

proc getVertexLabelOff { name } {
    global Vertex
    return $Vertex($name,LabelOff)
}

proc setVertexCoords { name coords } {
    global Vertex iGraph
    set Vertex($name,Coords) $coords
    set formatted "{$coords}"
    puts "Sending: $name $formatted"
    $iGraph cppUpdVertex: $name $formatted
}

proc getVertexCoords { name } {
    global Vertex
    return $Vertex($name,Coords)
}

proc appendVertexEdgeOut { name edgeName } {
    global Vertex
    lappend Vertex($name,EdgeOut) $edgeName
}

proc getVertexEdgeOut { name } {
    global Vertex
    return $Vertex($name,EdgeOut)
}

proc appendVertexEdgeIn { name edgeName } {
    global Vertex
    lappend Vertex($name,EdgeIn) $edgeName
}

proc getVertexEdgeIn { name } {
    global Vertex
    return $Vertex($name,EdgeIn)
}

proc getVertexType { name } {
    global Vertex
    return $Vertex($name,Type)
}

proc getVertexBitmap { name } {
    global Vertex
    return $Vertex($name,Bitmap)
}

proc setVertexBmpID { name id } {
    global Vertex
    set Vertex($name,BmpID) $id
}

proc getVertexBmpID { name } {
    global Vertex
    return $Vertex($name,BmpID)
}

proc setVertexLabelID { name id } {
    global Vertex
    set Vertex($name,LabelID) $id
}

proc getVertexLabelID { name } {
    global Vertex
    return $Vertex($name,LabelID)
}

proc createVertex { name } {
    global BITMAP_PATH
    global can

    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]]]

    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

    $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 $name  "onVertEnter $name %x %y"
    $can bind $name  "onVertLeave $name %x %y"

    setVertexBmpID $name $node
    setVertexLabelID $name $nodelabel
}

proc moveVertexLabel { name {coords {0 -20}} } {
    global can

    setVertexLabelOff $name $coords

    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
}

proc moveVertex { name coords } {
    global can

    setVertexCoords $name $coords

    set id [getVertexBmpID $name]
    $can coords $id [getXCoord $coords] [getYCoord $coords]

    moveVertexLabel $name [getVertexLabelOff $name]
}

proc vertRedrawEdges { name } {
    foreach i [getVertexEdgeIn $name] { createEdge $i }
    foreach i [getVertexEdgeOut $name] { createEdge $i }
}

###
# Cool Hiliting stuff...
###
proc vertHilite { name color } {
    global can lastHilited

    $can itemconfigure [getVertexLabelID $name] -fill $color
    $can itemconfigure [getVertexBmpID $name] -background $color
    set lastHilited $name
}

proc vertUnhilite { name } {
    global can
    $can itemconfigure [getVertexLabelID $name] -fill black
    $can itemconfigure [getVertexBmpID $name] -background {}
}