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.
#
#              : Event procedures are based on the tool
#              : name. Special checks are done to see if
#              : there is a procedure for the action that
#              : happened and the tool that made the action.
#              : If the procedure exists, it does it. If it doesn't,
#              : it doesn't.
###

###
#Make sure the correct action is taken depending on the tool currently selected
###
proc conditionalCall { procName name x y } {
    if {[info procs $procName] != ""} {
	$procName $name $x $y
    }
}

###
#calls conditionalCall after a bendy point is clicked on with the left mouse 
#button and the mouse is moved while the button is still held down.
###
proc onOvalMove { name x y } {
    global tool_type
    conditionalCall onOvalMove_$tool_type $name $x $y
}

###
#action taken when using the select tool and the left mouse button is clicked 
#on a bendy point and the mouse is moved.
#So long as the button is held down, this just moves the bubble around the 
#screen.  The actual redrawing of the edge and recomputation of positions is
#done on the release of the button.
###
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]
}

###
#Calls conditionalCall when the left button is double clicked while on an edge.
###
proc onEdgeLineDbl { name x y } {
    global tool_type
    conditionalCall onEdgeLineDbl_$tool_type $name $x $y
}

###
#Called when on an edge and the left button is double clicked while using the
#select tool.  It creates a new bendy point
###
proc onEdgeLineDbl_Select { name x y } {
    global can

#
# Don't allow bends to be added for same start/end vertex edges.
if {[getEdgeSrcVert $name] == [getEdgeDstVert $name]} {
        ask "You're lucky even to have an edge that can \
start and end from the same vertex. You won't be able to \
delete additional bends once they are created, so please only move them."
        return
        }

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

# If edge is an Alter, divide the number of items in the list
# by 2 because each pair of lines counts as 2 items.
    if {[getEdgeType $name] == "Alter"} {
	set index [expr (($index / 2)) ]
	}

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

###
#Calls conditionalCall when the left mouse button is released while on a bendy
#point
###
proc onEdgeOvalUp { name x y } {
    global tool_type
    conditionalCall onEdgeOvalUp_$tool_type $name $x $y
}

###
#When the left mouse button is released while on a bendy point and using the 
#select tool.  This redraws the edge and bendy point in the new position and 
#recomputes the positions.
###
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
}

###
#This calls conditionalCall when on a bendy point and the RIGHT mouse button
#is double clicked.
###
proc onEdgeOvalDbl { name x y } {
    global tool_type
    conditionalCall onEdgeOvalDbl_$tool_type $name $x $y
}

###
#When on a bendy point and the right mouse button is double clicked while using
#the select tool.  The bendy point you are currently on is removed.
###
proc onEdgeOvalDbl_Select { name x y } {
    global can

#
# Don't allow bends to be removed for same start/end vertex edges.
if {[getEdgeSrcVert $name] == [getEdgeDstVert $name]} {
	ask "You're lucky even to have an edge that can \
start and end from the same vertex. Only move the bends please. \
What if you delete them all?"
	return
	}
    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
}

###
#Calls conditionalCall after an edge label has been clicked on and the mouse
#has been moved.
###
proc onEdgeLblMove { name x y } {
    global tool_type
    conditionalCall onEdgeLblMove_$tool_type $name $x $y
}

###
#When an edge label has been clicked on and the mouse moved while the select 
#tool is being used.  It moves the
#edge along on the screen and updates the coordinates
###
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
}

###
#Calls conditionalCall when the left mouse button is released while on an edge
###
proc onEdgeUp { name x y } {
    global tool_type
    conditionalCall onEdgeUp_$tool_type $name $x $y
}

###
#When using the delete tool, and the left mouse button is released while on 
#an edge.  This deletes the edge and updates the appropriate variables.
###
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
    }
    }
}

###
#When using the Rename tool, and the left mouse button is released while on
#an edge.  This prompts the user for a name and renames the edge.
###
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
    }
}

###
#calls conditionalCall when the left mouse button is clicked down on a vertex.
###
proc onVertDown { name x y } {
    global tool_type
    conditionalCall onVertDown_$tool_type $name $x $y
}

###
#When the left mouse button is clicked down on a vertex and the tool selected 
#is the construction edge tool.  This hilights the edge.
### 
proc onVertDown_Req_Constr_Edge { name x y } {
    vertHilite $name yellow
}

###
#when the left mouse button is clicked down on a vertex and the tool selected
#is the alternation edge tool.  If the vertex type is not of alternation then
#this simply returns without doing anything.  If it is of type vertex then the
#vertex is highlighted.
###
proc onVertDown_Req_Alter_Edge { name x y } {
    if {[getVertexType $name] != "Alter"} {
	return
    }
   vertHilite $name yellow
}

###
#Calls conditionalCall after a vertex has been clicked on with the left mouse
#button and the mouse has been moved.
###
proc onVertMove { name x y } {
    global tool_type
    conditionalCall onVertMove_$tool_type $name $x $y
}

###
#When a vertex has been clicked on and the mouse moved with the select tool 
#enabled.  This calls
#moveVertex to do the move the vertex around the screen.
###
proc onVertMove_Select { name x y } {
    moveVertex $name "$x $y"
}

###
#Used when the mouse has been moved after a construction edge is clicked on 
#with the left mouse button, so long as the tool selected is the construction
#edge tool.  This keeps the original vertex clicked on highlighted and 
#highlights the next closest vertex. . . so long as it is within certain 
#boundaries.  These boundaries are defined by TCL.
###
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
}

###
#Used when the mouse has been moved after an alternation edge is clicked on 
#with the left mouse button, so long as the tool selected is the construction
#edge tool.  If the vertex is not an alternation edge this procedure simple
#exits.  If it is an alternation edge onVertMove_Req_Constr_Edge is called.
###
proc onVertMove_Req_Alter_Edge { name x y } {
    if {[getVertexType $name] != "Alter"} {
	return
    }
    onVertMove_Req_Constr_Edge $name $x $y
}

###
#Calls conditionalCall when the left mouse button is released while on a 
#vertex
###
proc onVertUp { name x y } {
    global tool_type
    conditionalCall onVertUp_$tool_type $name $x $y
}

###
#If the left mouse button is released while on a vertex and the select tool
#is enabled, the command vertRedrawEdges is called to redraw the edges.
###
proc onVertUp_Select { name x y } {
    vertRedrawEdges $name
}

###
#If the left mouse button is released while on a vertex and the delete tool
#is enabled, the vertex is deleted after confirmation from the user.
###
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
    }
}

###
#If the left mouse button is released while on a vertex and the rename tool
#is enabled, a new vertex name is requested from the user and the change is
#implemented
###
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
    }
}

###
#If the left mouse button is released while near a vertex 
#(see onVertMove_Req_c#onstr_Edge) and the construction
#edge tool is enabled, a construction edge is placed between the initial node
#clicked and the other node highlighted.  Due to lack of thought from the 
#group leader (zaphod), an edge cannont be placed from a vertex and back to 
#itself.  This will be fixed in later versions.
###
# Hey, I can't think of everything................Zaphod :^)
# Just fixed it. Ha.
###
proc onVertUp_Req_Constr_Edge { name x y } {
    global constrSrcName constrDstName can inform flagno

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

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

#
# Should the user make an edge start and end at the same vertex.
    if {($name == $dstName)} {
    yesno "This edge will start and end on the same\
vertex. Do you wish to continue?" $x $y
    if {$flagno == 1} {
    set edgeName [asklabel "Enter label name:" $x $y]
	set default1 "30 30"
    set points [getVertexCoords $dstName]
    set node1 "[expr [getXCoord $points] + 0] [expr [getYCoord $points] + 20]"
    set node2 "[expr [getXCoord $points] + 20] [expr [getYCoord $points] + 20]"
    set node3 "[expr [getXCoord $points] + 20] [expr [getYCoord $points] + 0]"
    set default2 "{$node1} {$node2} {$node3}"
	set inform 1
        tclCEdge $edgeName $name $dstName $default1 $default2
	set inform 0
    }
	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
}

###
#If the left mouse button is released while near a vertex (see OnVertMove_Req_c#onstr_Edge)
#and the alternation edge tool is enabled, an alternation edge is 
#placed between the initial node clicked and the other node highlighted.  Once
#again, due
#to lack of thought by the group leader (zaphod the incompetent), an edge 
#cannot be placed from a vertex to itself.  this will be fixed in a 
#later version.
###
# Next time you write it Allanon....................Zaphod:^)
###
proc onVertUp_Req_Alter_Edge { name x y } {

#Removed vertex checking. Prop-Group wants this control.
#    if {[getVertexType $name] != "Alter"} {
#	return
#    }

    global can inform flagno

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

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

#
# Should the user make an edge start and end at the same vertex.
    if {($name == $dstName)} {
    yesno "This edge will start and end on the same\
vertex. Do you wish to continue?" $x $y
    if {$flagno == 1} {
    set points [getVertexCoords $dstName]
    set node1 "[expr [getXCoord $points] + 0] [expr [getYCoord $points] + 20]"
    set node2 "[expr [getXCoord $points] + 20] [expr [getYCoord $points] + 20]"
    set node3 "[expr [getXCoord $points] + 20] [expr [getYCoord $points] + 0]"
    set default1 "{$node1} {$node2} {$node3}"
    set inform 1
    tclAEdge $name $dstName $default1
    set inform 0
    }
        vertUnhilite $name
        return
    }

    set inform 1
    tclAEdge $name $dstName
    set inform 0
    vertUnhilite $name
    vertUnhilite $dstName
}

###
#Calls conditionalCall when a vertex label has been clicked on with the left 
#mouse button, and the mouse has been subsequently moved.
###    
proc onVertLblMove { name x y } {
    global tool_type
    conditionalCall onVertLblMove_$tool_type $name $x $y
}

###
#When a vertex label has been clicked on with the left mouse button, and the
#mouse has been subsequently moved, so long as the tool enabled is Select.
#This simply moves the label around.
###
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"
}

###
#When the mouse cursor enters the area of a vertex, conditionalCall is called.
###
proc onVertEnter { name x y } {
    global tool_type
    conditionalCall onVertEnter_$tool_type $name $x $y
}

###
#when the mouse cursor enters the area of a vertex and the tool enabled is 
#Select, the vertex is highlighted green.
###
proc onVertEnter_Select { name x y } {
    vertHilite $name green
}

###
#When the mouse cursor enters the area of a vertex and the tool enabled is 
#the alternation edge tool, the vertex is highlighted yellow.
###
proc onVertEnter_Req_Alter_Edge { name x y } {
    if {[getVertexType $name] == "Alter"} {
	vertHilite $name yellow
    }
}


###
#When the mouse cursor enters the area of a vertex and the tool enabled is 
#the delete tool, the vertex is highlighted red
###
proc onVertEnter_Delete { name x y } {
    vertHilite $name red
}

###
#when the mouse cursor enters the area of a vertex and the tool enabled is 
#the rename tool, the vertex is highlighted purple.
###
proc onVertEnter_Rename { name x y } {
    vertHilite $name purple
}

###
#When the mouse cursor leaves the area of a vertex, conditionalCall is called.
###
proc onVertLeave { name x y } {
    global tool_type
    conditionalCall onVertLeave_$tool_type $name $x $y
}

###
#When the mouse cursor leaves the area of a vertex and the tool enabled is
#the delete tool, the vertex is unhighlighted.  The reason zaphod calls
#onVertLeave_Select to do this instead of vertUnhilite is a mystery.  The only
#answer he could give is that, THEY told him to do it this way.  Asked who 
#they were, he would grow fearful and run from the room screaming of little
#pink mushrooms.
###
# When the men come, or when in my mind the men come in their six
# black shiny ships, do they come in your mind too?............Zaphod:^)
###
proc onVertLeave_Delete { name x y } {
    onVertLeave_Select $name $x $y
}

###
#When the mouse cursor leaves the area of a vertex and the tool enabled is
#the select tool, the vertex is unhighlighted.
###
proc onVertLeave_Select { name x y } {
    vertUnhilite $name
}

###
#When the mouse cursor leaves the area of a vertex and the tool enabled is
#the rename tool, the vertex is unhighlighted.
###
proc onVertLeave_Rename { name x y } {
    vertUnhilite $name
}

###
#When the mouse cursor leaves the area of a vertex and the tool enabled is
#the alternation edge tool, the vertex is unhighlighted
###
proc onVertLeave_Req_Alter_Edge { name x y } {
    vertUnhilite $name
}

###
#conditionalCall is called when the mouse cursor enters an edge area.
###
proc onEdgeEnter { name x y } {
    global tool_type
    conditionalCall onEdgeEnter_$tool_type $name $x $y
}

###
#when the mouse cursor is placed on an edge and the tool enabled is the select
#tool, the edge is colored blue
###
proc onEdgeEnter_Select { name x y } {
    global can
    $can itemconfigure $name -fill blue
}

###
#when the mouse cursor is placed on an edge and the tool enabled is the delete
#tool, the edge is colored red
###
proc onEdgeEnter_Delete { name x y } {
    global can
    $can itemconfigure $name -fill red
}

###
#when the mouse cursor is placed on an edge and the tool enabled is the rename
#tool, the edge is colored purple if it is a construction edge, if not it just
#returns
###
proc onEdgeEnter_Rename { name x y } {
    if {[getEdgeType $name] != "Constr"} {
	return
    }
    global can
    $can itemconfigure $name -fill purple
}

###
#when the mouse cursor moves off an edge, conditionalCall is called.
###
proc onEdgeLeave { name x y } {
    global tool_type
    conditionalCall onEdgeLeave_$tool_type $name $x $y
}

###
#when the mouse cursor moves off an edge and the tool enabled is the select 
#tool, the edge is colored back to black
###
proc onEdgeLeave_Select { name x y } {
    global can
    $can itemconfigure $name -fill black
}

###
#when the mouse cursor moves off an edge and the tool enabled is the delete 
#tool, the edge is colored back to black
###
proc onEdgeLeave_Delete { name x y } {
    global can
    $can itemconfigure $name -fill black
}

###
#when the mouse cursor moves off an edge and the tool enabled is the rename 
#tool, the edge is colored back to black
###
proc onEdgeLeave_Rename { name x y } {
    global can
    $can itemconfigure $name -fill black
}

###
#When the left mouse button is pressed down on the canvas, a construction 
#vertex is 
#created.  This is a special procedure that is not called through
#conditionalCall.  
###
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
    }
}

###
#When the left mouse button is pressed down on the canvas, an alternation 
#vertex is 
#created.  This is a special procedure that is not called through
#conditionalCall.  
###
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
    }
}

###
#this function is not used
###
# I hate when I do that..........Zaphod:^)
###
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
}