bindings

Abstract : Houses all the event action procedures.

Comments : For Use Case 4 we have switch from having Tcl/Tk track objects
           (which was done through label name) to have C++ track them
           with a unique ID number passed to Tcl/Tk. This will allow for
           better tracking and object manipulation. In files edge.tcl,
           vertex.tcl, and bindings.tcl, most any referrence to the
           varible "name" or "$name" is actually the ID number.


###
# 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"} {
	clearDocument
#	puts "Sending: $name"
	$iGraph cppDelCEdge: [fixID $name]
    } else {
#	puts "Sending: $name"
	clearDocument
	$iGraph cppDelAEdge: [fixID $name]
    }
    }
}

###
#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 != "") && ([checkElabel [getEdgeSrcVert $name] $newName]\
	 == 1)} {
	clearDocument
#	puts "Sending: $name $newName"
    $iGraph cppRenEdge: [fixID $name] $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: [fixID $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 != "") && ([checkVlabel $newName] == 1)} {
	clearDocument
#	puts "Passing: $name $newName"
	$iGraph cppRenVertex: [fixID $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 cannot 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 iGraph

    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
    }

    if {([$iGraph cppCheckCEdge: [fixID $name] ] != 1)} {
        vertUnhilite $name
        vertUnhilite $dstName
	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]
    if {($edgeName != "") && ([checkElabel $name $edgeName] == 1)} {
    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 fakeid $edgeName $name $dstName $default1 $default2
#	setEdgeNodeCoords $name $default2
	set inform 0
	}
    }
	vertUnhilite $name
	return
    }

    set edgeName [asklabel "Enter label name:" $x $y]
    if {($edgeName != "") && ([checkElabel $name $edgeName] == 1)} {
	set inform 1
	tclCEdge fakeid $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 iGraph

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

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

    if {([$iGraph cppCheckAEdge: [fixID $name] ] != 1)} {

# Circular Inheridance checking not ready yet.
# || ([$iGraph cppCheckCircInher: [fixID $name]  [fixID $dstName]] != 1)

	vertUnhilite $name
	vertUnhilite $dstName
        return
    }

    set inform 1
    tclAEdge fakeid $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
#puts "That is object: $name"
    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.   fakeid is a dummy ID until C++ assigns it one.
###
proc onBtn1Down_Canvas_Constr {x y} {
	global inform
    set name [asklabel "Enter label name:" $x $y]
    if {( $name != "" ) && ( [checkVlabel $name] == 1 )} {
	set inform 1
	tclCVert fakeid $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.  fakeid is a dummy ID until C++ assigns it one.
###
proc onBtn1Down_Canvas_Alter {x y} {
	global inform
    set name [asklabel "Enter label name:" $x $y]
    if {($name != "") && ([checkVlabel $name] == 1)} {
	set inform 1
	tclAVert fakeid $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
}