bindings

Abstract : Houses all the event action procedures.

Comments : As described in the toolbar.tcl, this code is pretty cool. By
           creating procedure with names that relate to the action taken
           and the tool used, checks can be made to see if there is a 
           action to be taken when a certain event occurs using a certain 
           tool. Example of how it work; the mouse is click on the canvas.
           Program jumps to the procedure of a mouse click on the canvas.
           Checks to see if a procedure is available for the tool currently 
           selected. If it is available, do that procedure....if not, do 
           nothing.
           Some of the events include; the mouse entering and leaving 
           objects on the canvas, clicks on nodes, clicks on edges, mouse 
           movement. Carefully understand how the procedure names work with 
           the procedure name checking system.


###
# This file contains the actions to be taken on bound
# events in the canvas.
###


###
# Make sure the correct action is take when the proper
# tool is selected.
###
proc conditionalCall { procName name x y } {
    if {[info procs $procName] != ""} {
	$procName $name $x $y
    }
}

proc onOvalMove { name x y } {
    global tool_type
    conditionalCall onOvalMove_$tool_type $name $x $y
}

proc onOvalMove_Select { name x y } {
    global can

    set itemID [$can find withtag current]
    if {$itemID == ""} {
	return
    }

    set crds [calcOval $x $y]
    $can coords $itemID [lindex $crds 0] [lindex $crds 1] \
	    [lindex $crds 2] [lindex $crds 3]
}

proc onEdgeLineDbl { name x y } {
    global tool_type
    conditionalCall onEdgeLineDbl_$tool_type $name $x $y
}

proc onEdgeLineDbl_Select { name x y } {
    global can
    # puts "onEdgeLineDbl $name $x $y"

    set itemID [$can find withtag current]
    set index [getEdgeItemIndex [getEdgeLineIDs $name] $itemID]

    set Coords [getEdgeNodeCoords $name]
    set Coords [linsert $Coords $index "$x $y"]
    setEdgeNodeCoords $name $Coords
    createEdge $name
}

proc onEdgeOvalUp { name x y } {
    global tool_type
    conditionalCall onEdgeOvalUp_$tool_type $name $x $y
}

proc onEdgeOvalUp_Select { name x y } {
    global can
    # puts "onEdgeOvalUp $name $x $y"

    set itemID [$can find withtag current]
    if {$itemID == ""} {
	return
    }

    set Ovals [getEdgeOvalIDs $name]
    set Coords [getEdgeNodeCoords $name]

    set index [lindex [lindex $Ovals [findListEntry $Ovals $itemID]] 1]
    incr index -1
    set Coords [lreplace $Coords $index $index "$x $y"]
    setEdgeNodeCoords $name $Coords

    createEdge $name
}

proc onEdgeOvalDbl { name x y } {
    global tool_type
    conditionalCall onEdgeOvalDbl_$tool_type $name $x $y
}

proc onEdgeOvalDbl_Select { name x y } {
    global can
    # puts "onEdgeOvalDbl $name $x $y"

    set itemID [$can find withtag current]
    if {$itemID == ""} {
	return
    }

    set Ovals [getEdgeOvalIDs $name]
    set Coords [getEdgeNodeCoords $name]

    set index [lindex [lindex $Ovals [findListEntry $Ovals $itemID]] 1]
    incr index -1
    set Coords [lreplace $Coords $index $index ]
    setEdgeNodeCoords $name $Coords

    createEdge $name
}

proc onEdgeLblMove { name x y } {
    global tool_type
    conditionalCall onEdgeLblMove_$tool_type $name $x $y
}

proc onEdgeLblMove_Select { name x y } {
    global can

    set id [getEdgeLabelID $name]
    set coords [edgeCalcMidpoint $name]
    
    set offX [expr $x - [getXCoord $coords]]
    set offY [expr $y - [getYCoord $coords]]

    setEdgeLabelOff $name "$offX $offY"
    $can coords $id $x $y
}

proc onEdgeUp { name x y } {
    global tool_type
    conditionalCall onEdgeUp_$tool_type $name $x $y
}

proc onEdgeUp_Delete { name x y } {
    global iGraph flagno

    yesno "You are about to delete this edge. Do you wish to continue?"\
	$x $y

    if {$flagno == 1} {

    if {[getEdgeType $name] == "Constr"} {
	set temp1 [getEdgeLabel $name]
	set temp2 [getEdgeSrcVert $name]
	set temp3 [getEdgeDstVert $name]

	clearDocument
	$iGraph cppDelCEdge: $temp1 $temp2 $temp3
    } else {
	set temp2 [getEdgeSrcVert $name]
        set temp3 [getEdgeDstVert $name]
	clearDocument
	$iGraph cppDelAEdge: $temp2 $temp3
    }
    }
}

proc onEdgeUp_Rename { name x y } {
    global iGraph
    if {[getEdgeType $name] != "Constr"} {
	return
    }
    set newName [asklabel "Enter new label:" $x $y]
    if {$newName != ""} {
	set temp1 [getEdgeLabel $name]
	set temp2 [getEdgeSrcVert $name]
	set temp3 [getEdgeDstVert $name]
	clearDocument
	puts $name
        puts "Passing: $temp1 $temp2 $temp3 $newName"
    $iGraph cppRenEdge: $temp1 $temp2 $temp3 $newName
    }
}

proc onVertDown { name x y } {
    global tool_type
    conditionalCall onVertDown_$tool_type $name $x $y
}

proc onVertDown_Req_Constr_Edge { name x y } {
    vertHilite $name yellow
}

proc onVertDown_Req_Alter_Edge { name x y } {
    if {[getVertexType $name] != "Alter"} {
	return
    }
   vertHilite $name yellow
}

proc onVertMove { name x y } {
    global tool_type
    conditionalCall onVertMove_$tool_type $name $x $y
}

proc onVertMove_Select { name x y } {
    moveVertex $name "$x $y"
}

proc onVertMove_Req_Constr_Edge { name x y } {
    global can lastHilited

    set itemID [$can find closest $x $y]
    set tags [$can gettags $itemID]
    set dstName [lindex $tags 0]

    if {($dstName != $lastHilited) && ($lastHilited != $name)} {
	vertUnhilite $lastHilited
    }

    if {($dstName == "") || \
	    ([lsearch $tags _vertex_] == -1)} {
	return
    }
    
    vertHilite $dstName yellow
}

proc onVertMove_Req_Alter_Edge { name x y } {
    if {[getVertexType $name] != "Alter"} {
	return
    }
    onVertMove_Req_Constr_Edge $name $x $y
}

proc onVertUp { name x y } {
    global tool_type
    conditionalCall onVertUp_$tool_type $name $x $y
}

proc onVertUp_Select { name x y } {
    vertRedrawEdges $name
}

proc onVertUp_Delete { name x y } {
    global flagno iGraph
    yesno "You are about to delete this vertex and any connecting \
	    edges. Do you wish to continue?" $x $y
    if {$flagno == 1} {
	clearDocument
	puts "Passing: $name"
	$iGraph cppDelVertex: $name
    }
}

proc onVertUp_Rename { name x y } {
    global iGraph
    set newName [asklabel "Enter new label:" $x $y]
    if {$newName != ""} {
	clearDocument
	puts "Passing: $name $newName"
	$iGraph cppRenVertex: $name $newName
    }
}

proc onVertUp_Req_Constr_Edge { name x y } {
    global constrSrcName constrDstName can inform

    set itemID [$can find closest $x $y]
    set tags [$can gettags $itemID]
    set dstName [lindex $tags 0]

    if {($dstName == "") || ($name == $dstName) || \
	    ([lsearch $tags _vertex_] == -1)} {
	vertUnhilite $name
	return
    }

    set edgeName [asklabel "Enter label name:" $x $y]
    if {$edgeName != ""} {
	set inform 1
	tclCEdge $edgeName $name $dstName
	set inform 0
    }

    vertUnhilite $name
    vertUnhilite $dstName
}

proc onVertUp_Req_Alter_Edge { name x y } {
    if {[getVertexType $name] != "Alter"} {
	return
    }
    global can inform

    set itemID [$can find closest $x $y]
    set tags [$can gettags $itemID]
    set dstName [lindex $tags 0]

    if {($dstName == "") || ($name == $dstName) || \
	    ([lsearch $tags _vertex_] == -1)} {
	vertUnhilite $name
	return
    }
	set inform 1
    tclAEdge $name $dstName
	set inform 0
    vertUnhilite $name
    vertUnhilite $dstName
}
    
proc onVertLblMove { name x y } {
    global tool_type
    conditionalCall onVertLblMove_$tool_type $name $x $y
}

proc onVertLblMove_Select { name x y } {
    set id [getVertexLabelID $name]

    set coords [getVertexCoords $name]
    set offX [expr $x - [getXCoord $coords]]
    set offY [expr $y - [getYCoord $coords]]

    moveVertexLabel $name "$offX $offY"
}

proc onVertEnter { name x y } {
    global tool_type
    conditionalCall onVertEnter_$tool_type $name $x $y
}

proc onVertEnter_Select { name x y } {
    vertHilite $name green
}

proc onVertEnter_Req_Alter_Edge { name x y } {
    if {[getVertexType $name] == "Alter"} {
	vertHilite $name yellow
    }
}

proc onVertEnter_Delete { name x y } {
    vertHilite $name red
}

proc onVertEnter_Rename { name x y } {
    vertHilite $name purple
}

proc onVertLeave { name x y } {
    global tool_type
    conditionalCall onVertLeave_$tool_type $name $x $y
}

proc onVertLeave_Delete { name x y } {
    onVertLeave_Select $name $x $y
}

proc onVertLeave_Select { name x y } {
    vertUnhilite $name
}

proc onVertLeave_Rename { name x y } {
    vertUnhilite $name
}

proc onVertLeave_Req_Alter_Edge { name x y } {
    vertUnhilite $name
}

proc onEdgeEnter { name x y } {
    global tool_type
    conditionalCall onEdgeEnter_$tool_type $name $x $y
}

proc onEdgeEnter_Select { name x y } {
    global can
    $can itemconfigure $name -fill blue
}

proc onEdgeEnter_Delete { name x y } {
    global can
    $can itemconfigure $name -fill red
}

proc onEdgeEnter_Rename { name x y } {
    if {[getEdgeType $name] != "Constr"} {
	return
    }
    global can
    $can itemconfigure $name -fill purple
}

proc onEdgeLeave { name x y } {
    global tool_type
    conditionalCall onEdgeLeave_$tool_type $name $x $y
}

proc onEdgeLeave_Select { name x y } {
    global can
    $can itemconfigure $name -fill black
}

proc onEdgeLeave_Delete { name x y } {
    global can
    $can itemconfigure $name -fill black
}

proc onEdgeLeave_Rename { name x y } {
    global can
    $can itemconfigure $name -fill black
}

#####
proc onBtn1Down_Canvas_Constr {x y} {
	global inform
    set name [asklabel "Enter label name:" $x $y]
    if {$name != ""} {
	set inform 1
	tclCVert $name "$x $y"
	set inform 0
    }
}

proc onBtn1Down_Canvas_Alter {x y} {
	global inform
    set name [asklabel "Enter label name:" $x $y]
    if {$name != ""} {
	set inform 1
	tclAVert $name "$x $y"
	set inform 0
    }
}

proc onBtn1Up_Node_Req_Constr_Edge { x y } {
    global name
    global NodesToNames
    global saveConstrSrcName
    
    if {$saveConstrSrcName == ""} {
	return
    }

    set itemID [.area find closest $x $y]
    if {[lsearch [.area gettags $itemID] node] == -1} {
	return
    }

    set nodeName $NodesToNames($itemID)

    if {$saveConstrSrcName == $nodeName} {
	return
    }

    asklabel "Enter label name:"
    if {$name != ""} {
	tclCEdge $name $saveConstrSrcName $nodeName
    }

    unhiliteNodes
}