global clock_seconds
if { [clock seconds] == $clock_seconds } {
- update
- return
+ update
+ return
}
set clock_seconds [clock seconds]
if { $cursorState } {
- .c config -cursor watch
- set cursorState 0
+ .c config -cursor watch
+ set cursorState 0
} else {
- .c config -cursor pirate
- set cursorState 1
+ .c config -cursor pirate
+ set cursorState 1
}
update
return
set node1 [lindex $nodes 0]
set node2 [lindex $nodes 1]
if { [nodeType $node1] == "pseudo" } {
- removeLink [getLinkMirror $link]
- removeLink $link
- removeNode [getNodeMirror $node1]
- removeNode $node1
- .c delete $node1
+ removeLink [getLinkMirror $link]
+ removeLink $link
+ removeNode [getNodeMirror $node1]
+ removeNode $node1
+ .c delete $node1
} elseif { [nodeType $node2] == "pseudo" } {
- removeLink [getLinkMirror $link]
- removeLink $link
- removeNode [getNodeMirror $node2]
- removeNode $node2
- .c delete $node2
+ removeLink [getLinkMirror $link]
+ removeLink $link
+ removeNode [getNodeMirror $node2]
+ removeNode $node2
+ .c delete $node2
} else {
- removeLink $link
+ removeLink $link
}
.c delete $link
if { $atomic == "atomic" } {
- set changed 1
- updateUndoLog
+ set changed 1
+ updateUndoLog
}
return
}
proc removeGUINode { node } {
set type [nodeType $node]
foreach ifc [ifcList $node] {
- set peer [peerByIfc $node $ifc]
- set link [lindex [.c gettags "link && $node && $peer"] 1]
- removeGUILink $link non-atomic
+ set peer [peerByIfc $node $ifc]
+ set link [lindex [.c gettags "link && $node && $peer"] 1]
+ removeGUILink $link non-atomic
}
if { $type != "pseudo" } {
- removeNode $node
- .c delete $node
+ removeNode $node
+ .c delete $node
}
return
}
global changed undolog undolevel redolevel
if { $changed } {
- global t_undolog undolog
- set t_undolog ""
- dumpCfg string t_undolog
- incr undolevel
- set undolog($undolevel) $t_undolog
- set redolevel $undolevel
- set changed 0
+ global t_undolog undolog
+ set t_undolog ""
+ dumpCfg string t_undolog
+ incr undolevel
+ set undolog($undolevel) $t_undolog
+ set redolevel $undolevel
+ set changed 0
}
return
}
global undolevel undolog oper_mode
if {$oper_mode == "edit" && $undolevel > 0} {
- incr undolevel -1
- loadCfg $undolog($undolevel)
- switchCanvas none
+ incr undolevel -1
+ loadCfg $undolog($undolevel)
+ switchCanvas none
}
return
}
global undolevel redolevel undolog oper_mode
if {$oper_mode == "edit" && $redolevel > $undolevel} {
- incr undolevel
- loadCfg $undolog($undolevel)
- switchCanvas none
+ incr undolevel
+ loadCfg $undolog($undolevel)
+ switchCanvas none
}
return
}
.c delete all
set background [.c create rectangle 0 0 $sizex $sizey \
- -fill white -tags "background"]
+ -fill white -tags "background"]
.c lower $background
foreach node $node_list {
- if { [getNodeCanvas $node] == $curcanvas } {
- drawNode $node
- }
+ if { [getNodeCanvas $node] == $curcanvas } {
+ drawNode $node
+ }
}
foreach link $link_list {
- set nodes [linkPeers $link]
- if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas ||
- [getNodeCanvas [lindex $nodes 1]] != $curcanvas } {
- continue
- }
- drawLink $link
- redrawLink $link
- updateLinkLabel $link
+ set nodes [linkPeers $link]
+ if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas ||
+ [getNodeCanvas [lindex $nodes 1]] != $curcanvas } {
+ continue
+ }
+ drawLink $link
+ redrawLink $link
+ updateLinkLabel $link
}
return
}
set x [lindex $coords 0]
set y [lindex $coords 1]
.c create image $x $y -image [set $type] \
- -tags "node $node"
+ -tags "node $node"
set coords [getNodeLabelCoords $node]
set x [lindex $coords 0]
set y [lindex $coords 1]
if { [nodeType $node] != "pseudo" } {
- set label [.c create text $x $y -fill blue \
- -text "[getNodeName $node]" \
- -tags "nodelabel $node"]
+ set label [.c create text $x $y -fill blue \
+ -text "[getNodeName $node]" \
+ -tags "nodelabel $node"]
+ } else {
+ set pnode [getNodeName $node]
+ set pcanvas [getNodeCanvas $pnode]
+ set ifc [ifcByPeer $pnode [getNodeMirror $node]]
+ if { $pcanvas != $curcanvas } {
+ set label [.c create text $x $y -fill blue \
+ -text "[getNodeName $pnode]:$ifc\r@[getCanvasName $pcanvas]" \
+ -tags "nodelabel $node" -justify center]
} else {
- set pnode [getNodeName $node]
- set pcanvas [getNodeCanvas $pnode]
- set ifc [ifcByPeer $pnode [getNodeMirror $node]]
- if { $pcanvas != $curcanvas } {
- set label [.c create text $x $y -fill blue \
- -text "[getNodeName $pnode]:$ifc\r@[getCanvasName $pcanvas]" \
- -tags "nodelabel $node" -justify center]
- } else {
- set label [.c create text $x $y -fill blue \
- -text "[getNodeName $pnode]:$ifc" \
- -tags "nodelabel $node" -justify center]
- }
+ set label [.c create text $x $y -fill blue \
+ -text "[getNodeName $pnode]:$ifc" \
+ -tags "nodelabel $node" -justify center]
+ }
}
if { $showNodeLabels == 0} {
- .c itemconfigure $label -state hidden
+ .c itemconfigure $label -state hidden
}
# XXX Invisible pseudo-node labels
global invisible
if { $invisible == 1 && [nodeType $node] == "pseudo" } {
- .c itemconfigure $label -state hidden
+ .c itemconfigure $label -state hidden
}
return
}
set lnode1 [lindex $nodes 0]
set lnode2 [lindex $nodes 1]
if { [getLinkMirror $link] != "" } {
- set newlink [.c create line 0 0 0 0 \
- -fill $defLinkColor -width $defLinkWidth \
- -tags "link $link $lnode1 $lnode2" \
- -arrow both]
+ set newlink [.c create line 0 0 0 0 \
+ -fill $defLinkColor -width $defLinkWidth \
+ -tags "link $link $lnode1 $lnode2" \
+ -arrow both]
} else {
- set newlink [.c create line 0 0 0 0 \
- -fill $defLinkColor -width $defLinkWidth \
- -tags "link $link $lnode1 $lnode2"]
+ set newlink [.c create line 0 0 0 0 \
+ -fill $defLinkColor -width $defLinkWidth \
+ -tags "link $link $lnode1 $lnode2"]
}
# XXX Invisible pseudo-liks
global invisible
if { $invisible == 1 && [getLinkMirror $link] != "" } {
- .c itemconfigure $link -state hidden
+ .c itemconfigure $link -state hidden
}
.c raise $newlink background
set newlink [.c create line 0 0 0 0 \
- -fill white -width [expr $defLinkWidth * 3 ] \
- -tags "link $link $lnode1 $lnode2"]
+ -fill white -width [expr $defLinkWidth * 3 ] \
+ -tags "link $link $lnode1 $lnode2"]
.c raise $newlink background
.c create text 0 0 -tags "linklabel $link" -justify center
.c create text 0 0 -tags "interface $lnode1 $link" -justify center
global $lnode1 $lnode2
switch -exact -- [nodeType $lnode1] {
- pc {
- return eth
- }
- host {
- return eth
- }
- hub {
- return e
- }
- lanswitch {
- return e
- }
- frswitch {
- return f
- }
- router {
- if { [nodeType $lnode2] == "router" || \
- [nodeType $lnode2] == "frswitch" } {
- #return ser
- return eth
- } else {
- return eth
- }
- }
- rj45 {
- return
- }
+ pc {
+ return eth
+ }
+ host {
+ return eth
+ }
+ hub {
+ return e
+ }
+ lanswitch {
+ return e
+ }
+ frswitch {
+ return f
+ }
+ router {
+ if { [nodeType $lnode2] == "router" || \
+ [nodeType $lnode2] == "frswitch" } {
+ #return ser
+ return eth
+ } else {
+ return eth
+ }
+ }
+ rj45 {
+ return
+ }
}
}
proc listLANnodes { l2node l2peers } {
lappend l2peers $l2node
foreach ifc [ifcList $l2node] {
- set peer [logicalPeerByIfc $l2node $ifc]
- set type [nodeType $peer]
- if { [ lsearch {lanswitch hub} $type] != -1 } {
- if { [lsearch $l2peers $peer] == -1 } {
- set l2peers [listLANnodes $peer $l2peers]
- }
- }
+ set peer [logicalPeerByIfc $l2node $ifc]
+ set type [nodeType $peer]
+ if { [ lsearch {lanswitch hub} $type] != -1 } {
+ if { [lsearch $l2peers $peer] == -1 } {
+ set l2peers [listLANnodes $peer $l2peers]
+ }
+ }
}
return $l2peers
}
upvar dy y
switch -exact -- [nodeType $lnode] {
- frswitch {
- set x 1.8
- set y 1.8
- }
- hub {
- set x 1.5
- set y 2.6
- }
- lanswitch {
- set x 1.5
- set y 2.6
- }
- router {
- set x 1
- set y 2
- }
- pc {
- if { $showIfIPaddrs || $showIfIPv6addrs } {
- set x 1.1
- } else {
- set x 1.4
- }
- set y 1.5
- }
- host {
- if { $showIfIPaddrs || $showIfIPv6addrs } {
- set x 1.0
- } else {
- set x 1.5
- }
- set y 1.5
- }
- rj45 {
- set x 1
- set y 1
- }
+ frswitch {
+ set x 1.8
+ set y 1.8
+ }
+ hub {
+ set x 1.5
+ set y 2.6
+ }
+ lanswitch {
+ set x 1.5
+ set y 2.6
+ }
+ router {
+ set x 1
+ set y 2
+ }
+ pc {
+ if { $showIfIPaddrs || $showIfIPv6addrs } {
+ set x 1.1
+ } else {
+ set x 1.4
+ }
+ set y 1.5
+ }
+ host {
+ if { $showIfIPaddrs || $showIfIPv6addrs } {
+ set x 1.0
+ } else {
+ set x 1.5
+ }
+ set y 1.5
+ }
+ rj45 {
+ set x 1
+ set y 1
+ }
}
return
}
set ifipv4addr [getIfcIPv4addr $lnode1 $ifc]
set ifipv6addr [getIfcIPv6addr $lnode1 $ifc]
if { $ifc == 0 } {
- set ifc ""
+ set ifc ""
}
if { [getIfcOperState $lnode1 $ifc] == "down" } {
- set labelstr "*"
+ set labelstr "*"
} else {
- set labelstr ""
+ set labelstr ""
}
if { $showIfNames } {
- set labelstr "$labelstr$ifc\r"
+ set labelstr "$labelstr$ifc\r"
}
if { $showIfIPaddrs && $ifipv4addr != "" } {
- set labelstr "$labelstr$ifipv4addr\r"
+ set labelstr "$labelstr$ifipv4addr\r"
}
if { $showIfIPv6addrs && $ifipv6addr != "" } {
- set labelstr "$labelstr$ifipv6addr\r"
+ set labelstr "$labelstr$ifipv6addr\r"
}
set labelstr \
- [string range $labelstr 0 [expr [string length $labelstr] - 2]]
+ [string range $labelstr 0 [expr [string length $labelstr] - 2]]
.c itemconfigure "interface && $lnode1 && $link" \
- -text "$labelstr"
+ -text "$labelstr"
return
}
set dup [getLinkDup $link]
set labelstr "$labelstr[getLinkBandwidthString $link]\r"
if { "$delstr" != "" } {
- set labelstr "$labelstr$delstr\r"
+ set labelstr "$labelstr$delstr\r"
}
if { "$ber" != "" } {
- set berstr "ber=$ber"
- set labelstr "$labelstr$berstr\r"
+ set berstr "ber=$ber"
+ set labelstr "$labelstr$berstr\r"
}
if { "$dup" != "" } {
- set dupstr "dup=$dup%"
- set labelstr "$labelstr$dupstr\r"
+ set dupstr "dup=$dup%"
+ set labelstr "$labelstr$dupstr\r"
}
set labelstr [string range $labelstr 0 [expr [string length $labelstr] - 2]]
.c itemconfigure "linklabel && $link" -text "$labelstr"
if { $showLinkLabels == 0} {
- .c itemconfigure "linklabel && $link" -state hidden
+ .c itemconfigure "linklabel && $link" -state hidden
}
return
}
global link_list curcanvas
foreach link $link_list {
- set nodes [linkPeers $link]
- if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas ||
- [getNodeCanvas [lindex $nodes 1]] != $curcanvas } {
- continue
- }
- redrawLink $link
+ set nodes [linkPeers $link]
+ if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas ||
+ [getNodeCanvas [lindex $nodes 1]] != $curcanvas } {
+ continue
+ }
+ redrawLink $link
}
return
}
.c coords "linklabel && $link" $lx $ly
set n [expr sqrt (($x1 - $x2) * ($x1 - $x2) + \
- ($y1 - $y2) * ($y1 - $y2)) * 0.015]
+ ($y1 - $y2) * ($y1 - $y2)) * 0.015]
if { $n < 1 } { set n 1 }
calcDxDy $lnode1
set y2 [lindex [getNodeCoords $orig_node2] 1]
setNodeCoords $new_node1 \
- "[expr $x1 + 0.4 * ($x2 - $x1)] [expr $y1 + 0.4 * ($y2 - $y1)]"
+ "[expr $x1 + 0.4 * ($x2 - $x1)] [expr $y1 + 0.4 * ($y2 - $y1)]"
setNodeCoords $new_node2 \
- "[expr $x1 + 0.6 * ($x2 - $x1)] [expr $y1 + 0.6 * ($y2 - $y1)]"
+ "[expr $x1 + 0.6 * ($x2 - $x1)] [expr $y1 + 0.6 * ($y2 - $y1)]"
setNodeLabelCoords $new_node1 [getNodeCoords $new_node1]
setNodeLabelCoords $new_node2 [getNodeCoords $new_node2]
set node [lindex [$c gettags $obj] 1]
$c addtag selected withtag "node && $node"
if { [nodeType $node] == "pseudo" } {
- set bbox [$c bbox "nodelabel && $node"]
+ set bbox [$c bbox "nodelabel && $node"]
} else {
- set bbox [$c bbox "node && $node"]
+ set bbox [$c bbox "node && $node"]
}
set bx1 [expr [lindex $bbox 0] - 2]
set by1 [expr [lindex $bbox 1] - 2]
set by2 [expr [lindex $bbox 3] + 1]
$c delete -withtags "selectmark && $node"
$c create line $bx1 $by1 $bx2 $by1 $bx2 $by2 $bx1 $by2 $bx1 $by1 \
- -dash {6 4} -fill black -width 1 -tags "selectmark $node"
+ -dash {6 4} -fill black -width 1 -tags "selectmark $node"
return
}
set link [lindex [$c gettags {link && current}] 1]
if { $link == "" } {
- set link [lindex [$c gettags {linklabel && current}] 1]
- if { $link == "" } {
- return
- }
+ set link [lindex [$c gettags {linklabel && current}] 1]
+ if { $link == "" } {
+ return
+ }
}
.button3menu delete 0 end
# Configure link
#
.button3menu add command -label "Configure" \
- -command "popupConfigDialog $c"
+ -command "popupConfigDialog $c"
#
# Delete link
#
if { $oper_mode != "exec" } {
- .button3menu add command -label "Delete" \
- -command "removeGUILink $link atomic"
+ .button3menu add command -label "Delete" \
+ -command "removeGUILink $link atomic"
} else {
- .button3menu add command -label "Delete" \
- -state disabled
+ .button3menu add command -label "Delete" \
+ -state disabled
}
#
# Split link
#
if { $oper_mode != "exec" && [getLinkMirror $link] == "" } {
- .button3menu add command -label "Split" \
- -command "splitGUILink $link"
+ .button3menu add command -label "Split" \
+ -command "splitGUILink $link"
} else {
- .button3menu add command -label "Split" \
- -state disabled
+ .button3menu add command -label "Split" \
+ -state disabled
}
#
# Merge two pseudo nodes / links
#
if { $oper_mode != "exec" && [getLinkMirror $link] != "" &&
- [getNodeCanvas [getNodeMirror [lindex [linkPeers $link] 1]]] ==
- $curcanvas } {
- .button3menu add command -label "Merge" \
- -command "mergeGUINode [lindex [linkPeers $link] 1]"
+ [getNodeCanvas [getNodeMirror [lindex [linkPeers $link] 1]]] ==
+ $curcanvas } {
+ .button3menu add command -label "Merge" \
+ -command "mergeGUINode [lindex [linkPeers $link] 1]"
} else {
- .button3menu add command -label "Merge" \
- -state disabled
+ .button3menu add command -label "Merge" \
+ -state disabled
}
set x [winfo pointerx .]
set selected_nodes {}
foreach obj [.c find withtag "node && selected"] {
- set node [lindex [.c gettags $obj] 1]
- lappend selected_nodes $node
- setNodeCanvas $node $canvas
- set changed 1
+ set node [lindex [.c gettags $obj] 1]
+ lappend selected_nodes $node
+ setNodeCanvas $node $canvas
+ set changed 1
}
foreach obj [.c find withtag "linklabel"] {
- set link [lindex [.c gettags $obj] 1]
- set link_peers [linkPeers $link]
- set peer1 [lindex $link_peers 0]
- set peer2 [lindex $link_peers 1]
- set peer1_in_selected [lsearch $selected_nodes $peer1]
- set peer2_in_selected [lsearch $selected_nodes $peer2]
- if { ($peer1_in_selected == -1 && $peer2_in_selected != -1) ||
- ($peer1_in_selected != -1 && $peer2_in_selected == -1) } {
- if { [nodeType $peer2] == "pseudo" } {
- setNodeCanvas $peer2 $canvas
- if { [getNodeCanvas [getNodeMirror $peer2]] == $canvas } {
- mergeLink $link
- }
- continue
- }
- set new_nodes [splitLink $link pseudo]
- set new_node1 [lindex $new_nodes 0]
- set new_node2 [lindex $new_nodes 1]
- setNodeMirror $new_node1 $new_node2
- setNodeMirror $new_node2 $new_node1
- setNodeName $new_node1 $peer2
- setNodeName $new_node2 $peer1
- set link1 [linkByPeers $peer1 $new_node1]
- set link2 [linkByPeers $peer2 $new_node2]
- setLinkMirror $link1 $link2
- setLinkMirror $link2 $link1
- }
+ set link [lindex [.c gettags $obj] 1]
+ set link_peers [linkPeers $link]
+ set peer1 [lindex $link_peers 0]
+ set peer2 [lindex $link_peers 1]
+ set peer1_in_selected [lsearch $selected_nodes $peer1]
+ set peer2_in_selected [lsearch $selected_nodes $peer2]
+ if { ($peer1_in_selected == -1 && $peer2_in_selected != -1) ||
+ ($peer1_in_selected != -1 && $peer2_in_selected == -1) } {
+ if { [nodeType $peer2] == "pseudo" } {
+ setNodeCanvas $peer2 $canvas
+ if { [getNodeCanvas [getNodeMirror $peer2]] == $canvas } {
+ mergeLink $link
+ }
+ continue
+ }
+ set new_nodes [splitLink $link pseudo]
+ set new_node1 [lindex $new_nodes 0]
+ set new_node2 [lindex $new_nodes 1]
+ setNodeMirror $new_node1 $new_node2
+ setNodeMirror $new_node2 $new_node1
+ setNodeName $new_node1 $peer2
+ setNodeName $new_node2 $peer1
+ set link1 [linkByPeers $peer1 $new_node1]
+ set link2 [linkByPeers $peer2 $new_node2]
+ setLinkMirror $link1 $link2
+ setLinkMirror $link2 $link1
+ }
}
updateUndoLog
redrawAll
set node [lindex [$c gettags {node && current}] 1]
if { $node == "" } {
- set node [lindex [$c gettags {nodelabel && current}] 1]
- if { $node == "" } {
- return
- }
+ set node [lindex [$c gettags {nodelabel && current}] 1]
+ if { $node == "" } {
+ return
+ }
}
set mirror_node [getNodeMirror $node]
if { [$c gettags "node && $node && selected"] == "" } {
- $c dtag node selected
- $c delete -withtags selectmark
- selectNode $c [$c find withtag "current"]
+ $c dtag node selected
+ $c delete -withtags selectmark
+ selectNode $c [$c find withtag "current"]
}
.button3menu delete 0 end
# Configure node
#
if { [nodeType $node] != "pseudo" } {
- .button3menu add command -label "Configure" \
- -command "popupConfigDialog $c"
+ .button3menu add command -label "Configure" \
+ -command "popupConfigDialog $c"
} else {
- .button3menu add command -label "Configure" \
- -command "popupConfigDialog $c" -state disabled
+ .button3menu add command -label "Configure" \
+ -command "popupConfigDialog $c" -state disabled
}
#
#
.button3menu.connect delete 0 end
if { $oper_mode == "exec" || [nodeType $node] == "pseudo" } {
- .button3menu add cascade -label "Create link to" \
- -menu .button3menu.connect -state disabled
+ .button3menu add cascade -label "Create link to" \
+ -menu .button3menu.connect -state disabled
} else {
- .button3menu add cascade -label "Create link to" \
- -menu .button3menu.connect
+ .button3menu add cascade -label "Create link to" \
+ -menu .button3menu.connect
}
.button3menu.connect add command -label "Canvas:" -state disabled
foreach canvas $canvas_list {
- destroy .button3menu.connect.$canvas
- menu .button3menu.connect.$canvas -tearoff 0
- .button3menu.connect.$canvas add command \
- -label "Node:" -state disabled
- .button3menu.connect add cascade -label [getCanvasName $canvas] \
- -menu .button3menu.connect.$canvas
+ destroy .button3menu.connect.$canvas
+ menu .button3menu.connect.$canvas -tearoff 0
+ .button3menu.connect.$canvas add command \
+ -label "Node:" -state disabled
+ .button3menu.connect add cascade -label [getCanvasName $canvas] \
+ -menu .button3menu.connect.$canvas
}
foreach peer_node $node_list {
- set canvas [getNodeCanvas $peer_node]
- if { $node != $peer_node && [nodeType $node] != "rj45" &&
- [lsearch {pseudo rj45} [nodeType $peer_node]] < 0 &&
- [ifcByLogicalPeer $node $peer_node] == "" } {
- .button3menu.connect.$canvas add command \
- -label [getNodeName $peer_node] \
- -command "newGUILink $node $peer_node"
- } elseif { [nodeType $peer_node] != "pseudo" } {
- .button3menu.connect.$canvas add command \
- -label [getNodeName $peer_node] \
- -state disabled
- }
+ set canvas [getNodeCanvas $peer_node]
+ if { $node != $peer_node && [nodeType $node] != "rj45" &&
+ [lsearch {pseudo rj45} [nodeType $peer_node]] < 0 &&
+ [ifcByLogicalPeer $node $peer_node] == "" } {
+ .button3menu.connect.$canvas add command \
+ -label [getNodeName $peer_node] \
+ -command "newGUILink $node $peer_node"
+ } elseif { [nodeType $peer_node] != "pseudo" } {
+ .button3menu.connect.$canvas add command \
+ -label [getNodeName $peer_node] \
+ -state disabled
+ }
}
#
#
.button3menu.moveto delete 0 end
if { $oper_mode == "exec" || [nodeType $node] == "pseudo" } {
- .button3menu add cascade -label "Move to" \
- -menu .button3menu.moveto -state disabled
+ .button3menu add cascade -label "Move to" \
+ -menu .button3menu.moveto -state disabled
} else {
- .button3menu add cascade -label "Move to" \
- -menu .button3menu.moveto
+ .button3menu add cascade -label "Move to" \
+ -menu .button3menu.moveto
}
.button3menu.moveto add command -label "Canvas:" -state disabled
foreach canvas $canvas_list {
- if { $canvas != $curcanvas } {
- .button3menu.moveto add command \
- -label [getCanvasName $canvas] \
- -command "movetoCanvas $canvas"
- } else {
- .button3menu.moveto add command \
- -label [getCanvasName $canvas] -state disabled
- }
+ if { $canvas != $curcanvas } {
+ .button3menu.moveto add command \
+ -label [getCanvasName $canvas] \
+ -command "movetoCanvas $canvas"
+ } else {
+ .button3menu.moveto add command \
+ -label [getCanvasName $canvas] -state disabled
+ }
}
#
# Merge two pseudo nodes / links
#
if { $oper_mode != "exec" && [nodeType $node] == "pseudo" && \
- [getNodeCanvas $mirror_node] == $curcanvas } {
- .button3menu add command -label "Merge" \
- -command "mergeGUINode $node"
+ [getNodeCanvas $mirror_node] == $curcanvas } {
+ .button3menu add command -label "Merge" \
+ -command "mergeGUINode $node"
} else {
- .button3menu add command -label "Merge" \
- -state disabled
+ .button3menu add command -label "Merge" \
+ -state disabled
}
#
# Delete selection
#
if { $oper_mode != "exec" } {
- .button3menu add command -label "Delete" -command deleteSelection
+ .button3menu add command -label "Delete" -command deleteSelection
} else {
- .button3menu add command -label "Delete" -state disabled
+ .button3menu add command -label "Delete" -state disabled
}
#
#
.button3menu.shell delete 0 end
if { $oper_mode == "exec" && [[typemodel $node].layer] == "NETWORK" } {
- .button3menu add cascade -label "Shell window" \
- -menu .button3menu.shell
- set cmd [[typemodel $node].shellcmd $node]
- if { $cmd != "/bin/sh" && $cmd != "" } {
- .button3menu.shell add command -label "$cmd" \
- -command "spawnShell $node $cmd"
- }
- .button3menu.shell add command -label "/bin/sh" \
- -command "spawnShell $node /bin/sh"
+ .button3menu add cascade -label "Shell window" \
+ -menu .button3menu.shell
+ set cmd [[typemodel $node].shellcmd $node]
+ if { $cmd != "/bin/sh" && $cmd != "" } {
+ .button3menu.shell add command -label "$cmd" \
+ -command "spawnShell $node $cmd"
+ }
+ .button3menu.shell add command -label "/bin/sh" \
+ -command "spawnShell $node /bin/sh"
} else {
- .button3menu add cascade -label "Shell window" \
- -menu .button3menu.shell -state disabled
+ .button3menu add cascade -label "Shell window" \
+ -menu .button3menu.shell -state disabled
}
#
#
.button3menu.ethereal delete 0 end
if { $oper_mode == "exec" && [[typemodel $node].layer] == "NETWORK" } {
- .button3menu add cascade -label "Ethereal" \
- -menu .button3menu.ethereal
- foreach ifc [ifcList $node] {
- set label "$ifc"
- if { [getIfcIPv4addr $node $ifc] != "" } {
- set label "$label ([getIfcIPv4addr $node $ifc])"
- }
- if { [getIfcIPv6addr $node $ifc] != "" } {
- set label "$label ([getIfcIPv6addr $node $ifc])"
- }
- .button3menu.ethereal add command -label $label \
- -command "startethereal $node $ifc"
- }
- .button3menu add command -label Start \
- -command "[typemodel $node].start $eid $node"
- .button3menu add command -label Stop \
- -command "[typemodel $node].shutdown $eid $node"
+ .button3menu add cascade -label "Ethereal" \
+ -menu .button3menu.ethereal
+ foreach ifc [ifcList $node] {
+ set label "$ifc"
+ if { [getIfcIPv4addr $node $ifc] != "" } {
+ set label "$label ([getIfcIPv4addr $node $ifc])"
+ }
+ if { [getIfcIPv6addr $node $ifc] != "" } {
+ set label "$label ([getIfcIPv6addr $node $ifc])"
+ }
+ .button3menu.ethereal add command -label $label \
+ -command "startethereal $node $ifc"
+ }
+ .button3menu add command -label Start \
+ -command "[typemodel $node].start $eid $node"
+ .button3menu add command -label Stop \
+ -command "[typemodel $node].shutdown $eid $node"
} else {
- .button3menu add cascade -label "Ethereal" \
- -menu .button3menu.ethereal -state disabled
- .button3menu add command -label start \
- -command "[typemodel $node].start $eid $node" -state disabled
- .button3menu add command -label stop \
- -command "[typemodel $node].stop $eid $node" -state disabled
+ .button3menu add cascade -label "Ethereal" \
+ -menu .button3menu.ethereal -state disabled
+ .button3menu add command -label start \
+ -command "[typemodel $node].start $eid $node" -state disabled
+ .button3menu add command -label stop \
+ -command "[typemodel $node].stop $eid $node" -state disabled
}
#
nexec vimageShellServer.sh $node_id 1234 $cmd &
if { $gui_unix } {
exec xterm -sb -rightbar \
- -T "IMUNES: [getNodeName $node] (console)" \
- -e "nc $exec_host 1234" &
+ -T "IMUNES: [getNodeName $node] (console)" \
+ -e "nc $exec_host 1234" &
} else {
exec cmd /c nc $exec_host 1234 &
}
} else {
nexec xterm -sb -rightbar \
- -T "IMUNES: [getNodeName $node] (console)" \
- -e "vimage $node_id $cmd" &
+ -T "IMUNES: [getNodeName $node] (console)" \
+ -e "vimage $node_id $cmd" &
}
}
set curobj [$c find withtag current]
set curtype [lindex [$c gettags current] 0]
if { $curtype == "node" || ( $curtype == "nodelabel" &&
- [nodeType [lindex [$c gettags $curobj] 1]] == "pseudo") } {
- set node [lindex [$c gettags current] 1]
- set wasselected \
- [expr [lsearch [$c find withtag "selected"] \
- [$c find withtag "node && $node"]] > -1]
- if { $button == "ctrl" } {
- if { $wasselected } {
- $c dtag $node selected
- $c delete -withtags "selectmark && $node"
- }
- } elseif { !$wasselected } {
- $c dtag node selected
- $c delete -withtags selectmark
- }
- if { $activetool == "select" && !$wasselected} {
- selectNode $c $curobj
- }
+ [nodeType [lindex [$c gettags $curobj] 1]] == "pseudo") } {
+ set node [lindex [$c gettags current] 1]
+ set wasselected \
+ [expr [lsearch [$c find withtag "selected"] \
+ [$c find withtag "node && $node"]] > -1]
+ if { $button == "ctrl" } {
+ if { $wasselected } {
+ $c dtag $node selected
+ $c delete -withtags "selectmark && $node"
+ }
+ } elseif { !$wasselected } {
+ $c dtag node selected
+ $c delete -withtags selectmark
+ }
+ if { $activetool == "select" && !$wasselected} {
+ selectNode $c $curobj
+ }
} elseif { $button != "ctrl" || $activetool != "select" } {
- $c dtag node selected
- $c delete -withtags selectmark
+ $c dtag node selected
+ $c delete -withtags selectmark
}
if { $curobj == $background } {
- if { [lsearch {select link} $activetool] < 0 } {
- set node [newNode $activetool]
- setNodeCanvas $node $curcanvas
- setNodeCoords $node "$x $y"
- set dy 32
- if { [lsearch {router hub lanswitch rj45} $activetool] >= 0 } {
- set dy 24
- }
- setNodeLabelCoords $node "$x [expr $y + $dy]"
- drawNode $node
- selectNode $c [$c find withtag "node && $node"]
- set changed 1
- } elseif { $activetool == "select" \
- && $curtype != "node" && $curtype != "nodelabel"} {
- $c config -cursor cross
- set lastX $x
- set lastY $y
- if {$selectbox != ""} {
- # We actually shouldn't get here!
- $c delete $selectbox
- set selectbox ""
- }
- }
+ if { [lsearch {select link} $activetool] < 0 } {
+ set node [newNode $activetool]
+ setNodeCanvas $node $curcanvas
+ setNodeCoords $node "$x $y"
+ set dy 32
+ if { [lsearch {router hub lanswitch rj45} $activetool] >= 0 } {
+ set dy 24
+ }
+ setNodeLabelCoords $node "$x [expr $y + $dy]"
+ drawNode $node
+ selectNode $c [$c find withtag "node && $node"]
+ set changed 1
+ } elseif { $activetool == "select" \
+ && $curtype != "node" && $curtype != "nodelabel"} {
+ $c config -cursor cross
+ set lastX $x
+ set lastY $y
+ if {$selectbox != ""} {
+ # We actually shouldn't get here!
+ $c delete $selectbox
+ set selectbox ""
+ }
+ }
} else {
- if {$curtype == "node" || $curtype == "nodelabel"} {
- $c config -cursor fleur
- }
- if {$activetool == "link" && $curtype == "node"} {
- $c config -cursor cross
- set lastX [lindex [$c coords $curobj] 0]
- set lastY [lindex [$c coords $curobj] 1]
- set newlink [$c create line $lastX $lastY $x $y \
- -fill $defLinkColor -width $defLinkWidth \
- -tags "link"]
- }
+ if {$curtype == "node" || $curtype == "nodelabel"} {
+ $c config -cursor fleur
+ }
+ if {$activetool == "link" && $curtype == "node"} {
+ $c config -cursor cross
+ set lastX [lindex [$c coords $curobj] 0]
+ set lastY [lindex [$c coords $curobj] 1]
+ set newlink [$c create line $lastX $lastY $x $y \
+ -fill $defLinkColor -width $defLinkWidth \
+ -tags "link"]
+ }
}
$c raise link background
$c raise linklabel "link || background"
set curobj [$c find withtag current]
set curtype [lindex [$c gettags current] 0]
if {$activetool == "link" && $newlink != ""} {
- $c coords $newlink $lastX $lastY $x $y
+ $c coords $newlink $lastX $lastY $x $y
} elseif { $activetool == "select" && \
( $curobj == $selectbox || $curobj == $background )} {
- if {$selectbox == ""} {
- set selectbox [$c create line \
- $lastX $lastY $x $lastY $x $y $lastX $y $lastX $lastY \
- -dash {10 4} -fill black -width 1 -tags "selectbox"]
- $c raise $selectbox "background || link || linklabel || interface"
- } else {
- $c coords $selectbox \
- $lastX $lastY $x $lastY $x $y $lastX $y $lastX $lastY
- }
+ if {$selectbox == ""} {
+ set selectbox [$c create line \
+ $lastX $lastY $x $lastY $x $y $lastX $y $lastX $lastY \
+ -dash {10 4} -fill black -width 1 -tags "selectbox"]
+ $c raise $selectbox "background || link || linklabel || interface"
+ } else {
+ $c coords $selectbox \
+ $lastX $lastY $x $lastY $x $y $lastX $y $lastX $lastY
+ }
} elseif { $activetool == "select" && $curtype == "nodelabel" \
- && [nodeType [lindex [$c gettags $curobj] 1]] != "pseudo" } {
- $c move $curobj [expr $x-$lastX] [expr $y-$lastY]
- set changed 1
- set lastX $x
- set lastY $y
+ && [nodeType [lindex [$c gettags $curobj] 1]] != "pseudo" } {
+ $c move $curobj [expr $x-$lastX] [expr $y-$lastY]
+ set changed 1
+ set lastX $x
+ set lastY $y
} else {
- foreach img [$c find withtag "selected"] {
- set node [lindex [$c gettags $img] 1]
+ foreach img [$c find withtag "selected"] {
+ set node [lindex [$c gettags $img] 1]
set img [$c find withtag "selectmark && $node"]
- $c move $img [expr $x-$lastX] [expr $y-$lastY]
+ $c move $img [expr $x-$lastX] [expr $y-$lastY]
set img [$c find withtag "node && $node"]
- $c move $img [expr $x-$lastX] [expr $y-$lastY]
- set img [$c find withtag "nodelabel && $node"]
- $c move $img [expr $x-$lastX] [expr $y-$lastY]
- $c addtag need_redraw withtag "link && $node"
- }
- foreach link [$c find withtag "link && need_redraw"] {
- redrawLink [lindex [$c gettags $link] 1]
- }
- $c dtag link need_redraw
- set changed 1
- set lastX $x
- set lastY $y
+ $c move $img [expr $x-$lastX] [expr $y-$lastY]
+ set img [$c find withtag "nodelabel && $node"]
+ $c move $img [expr $x-$lastX] [expr $y-$lastY]
+ $c addtag need_redraw withtag "link && $node"
+ }
+ foreach link [$c find withtag "link && need_redraw"] {
+ redrawLink [lindex [$c gettags $link] 1]
+ }
+ $c dtag link need_redraw
+ set changed 1
+ set lastX $x
+ set lastY $y
}
return
}
set link [newLink $lnode1 $lnode2]
if { $link == "" } {
- return
+ return
}
if { [getNodeCanvas $lnode1] != [getNodeCanvas $lnode2] } {
- set new_nodes [splitLink $link pseudo]
- set orig_nodes [linkPeers $link]
- set new_node1 [lindex $new_nodes 0]
- set new_node2 [lindex $new_nodes 1]
- set orig_node1 [lindex $orig_nodes 0]
- set orig_node2 [lindex $orig_nodes 1]
- set new_link1 [linkByPeers $orig_node1 $new_node1]
- set new_link2 [linkByPeers $orig_node2 $new_node2]
- setNodeMirror $new_node1 $new_node2
- setNodeMirror $new_node2 $new_node1
- setNodeName $new_node1 $orig_node2
- setNodeName $new_node2 $orig_node1
- setLinkMirror $new_link1 $new_link2
- setLinkMirror $new_link2 $new_link1
+ set new_nodes [splitLink $link pseudo]
+ set orig_nodes [linkPeers $link]
+ set new_node1 [lindex $new_nodes 0]
+ set new_node2 [lindex $new_nodes 1]
+ set orig_node1 [lindex $orig_nodes 0]
+ set orig_node2 [lindex $orig_nodes 1]
+ set new_link1 [linkByPeers $orig_node1 $new_node1]
+ set new_link2 [linkByPeers $orig_node2 $new_node2]
+ setNodeMirror $new_node1 $new_node2
+ setNodeMirror $new_node2 $new_node1
+ setNodeName $new_node1 $orig_node2
+ setNodeName $new_node2 $orig_node1
+ setLinkMirror $new_link1 $new_link2
+ setLinkMirror $new_link2 $new_link1
}
redrawAll
set changed 1
$c config -cursor left_ptr
if {$activetool == "link" && $newlink != ""} {
- $c delete $newlink
- set newlink ""
- set destobj ""
- foreach obj [$c find overlapping $x $y $x $y] {
- if {[lindex [$c gettags $obj] 0] == "node"} {
- set destobj $obj
- break
- }
- }
- if {$destobj != "" && $curobj != "" && $destobj != $curobj} {
- set lnode1 [lindex [$c gettags $curobj] 1]
- set lnode2 [lindex [$c gettags $destobj] 1]
- if { [ifcByLogicalPeer $lnode1 $lnode2] == "" } {
- set link [newLink $lnode1 $lnode2]
- if { $link != "" } {
- drawLink $link
- redrawLink $link
- updateLinkLabel $link
- set changed 1
- }
- }
- }
+ $c delete $newlink
+ set newlink ""
+ set destobj ""
+ foreach obj [$c find overlapping $x $y $x $y] {
+ if {[lindex [$c gettags $obj] 0] == "node"} {
+ set destobj $obj
+ break
+ }
+ }
+ if {$destobj != "" && $curobj != "" && $destobj != $curobj} {
+ set lnode1 [lindex [$c gettags $curobj] 1]
+ set lnode2 [lindex [$c gettags $destobj] 1]
+ if { [ifcByLogicalPeer $lnode1 $lnode2] == "" } {
+ set link [newLink $lnode1 $lnode2]
+ if { $link != "" } {
+ drawLink $link
+ redrawLink $link
+ updateLinkLabel $link
+ set changed 1
+ }
+ }
+ }
}
if { $changed == 1 } {
- set regular true
- if { [lindex [$c gettags $curobj] 0] == "nodelabel" } {
- set node [lindex [$c gettags $curobj] 1]
- selectNode $c [$c find withtag "node && $node"]
- }
- set selected {}
- foreach img [$c find withtag "selected"] {
- set node [lindex [$c gettags $img] 1]
- lappend selected $node
- set coords [$c coords $img]
- set x [lindex $coords 0]
- set y [lindex $coords 1]
- if { $autorearrange_enabled } {
- set dx 0
- set dy 0
- } else {
- set dx [expr int($x / $grid + 0.5) * $grid - $x]
- set dy [expr int($y / $grid + 0.5) * $grid - $y]
- }
- $c move $img $dx $dy
- set coords [$c coords $img]
- set x [lindex $coords 0]
- set y [lindex $coords 1]
- setNodeCoords $node "$x $y"
- if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} {
- set regular false
- }
- $c move "nodelabel && $node" $dx $dy
- set coords [$c coords "nodelabel && $node"]
- set x [lindex $coords 0]
- set y [lindex $coords 1]
- setNodeLabelCoords $node "$x $y"
- if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} {
- set regular false
- }
- $c move "selectmark && $node" $dx $dy
- $c addtag need_redraw withtag "link && $node"
- }
- if {$regular == "true"} {
- foreach link [$c find withtag "link && need_redraw"] {
- redrawLink [lindex [$c gettags $link] 1]
- }
- } else {
- loadCfg $undolog($undolevel)
- redrawAll
- foreach node $selected {
- selectNode $c [$c find withtag "node && $node"]
- }
- set changed 0
- }
- $c dtag link need_redraw
+ set regular true
+ if { [lindex [$c gettags $curobj] 0] == "nodelabel" } {
+ set node [lindex [$c gettags $curobj] 1]
+ selectNode $c [$c find withtag "node && $node"]
+ }
+ set selected {}
+ foreach img [$c find withtag "selected"] {
+ set node [lindex [$c gettags $img] 1]
+ lappend selected $node
+ set coords [$c coords $img]
+ set x [lindex $coords 0]
+ set y [lindex $coords 1]
+ if { $autorearrange_enabled } {
+ set dx 0
+ set dy 0
+ } else {
+ set dx [expr int($x / $grid + 0.5) * $grid - $x]
+ set dy [expr int($y / $grid + 0.5) * $grid - $y]
+ }
+ $c move $img $dx $dy
+ set coords [$c coords $img]
+ set x [lindex $coords 0]
+ set y [lindex $coords 1]
+ setNodeCoords $node "$x $y"
+ if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} {
+ set regular false
+ }
+ $c move "nodelabel && $node" $dx $dy
+ set coords [$c coords "nodelabel && $node"]
+ set x [lindex $coords 0]
+ set y [lindex $coords 1]
+ setNodeLabelCoords $node "$x $y"
+ if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} {
+ set regular false
+ }
+ $c move "selectmark && $node" $dx $dy
+ $c addtag need_redraw withtag "link && $node"
+ }
+ if {$regular == "true"} {
+ foreach link [$c find withtag "link && need_redraw"] {
+ redrawLink [lindex [$c gettags $link] 1]
+ }
+ } else {
+ loadCfg $undolog($undolevel)
+ redrawAll
+ foreach node $selected {
+ selectNode $c [$c find withtag "node && $node"]
+ }
+ set changed 0
+ }
+ $c dtag link need_redraw
} elseif {$activetool == "select" } {
- if {$selectbox == ""} {
- set x1 $x
- set y1 $y
- set autorearrange_enabled 0
- } else {
- set coords [$c coords $selectbox]
- set x [lindex $coords 0]
- set y [lindex $coords 1]
- set x1 [lindex $coords 4]
- set y1 [lindex $coords 5]
- $c delete $selectbox
- set selectbox ""
- }
- set enclosed {}
- foreach obj [$c find enclosed $x $y $x1 $y1] {
- set tags [$c gettags $obj]
- if {[lindex $tags 0] == "node" && [lsearch $tags selected] == -1} {
- lappend enclosed $obj
- }
- }
- foreach obj $enclosed {
- selectNode $c $obj
- }
+ if {$selectbox == ""} {
+ set x1 $x
+ set y1 $y
+ set autorearrange_enabled 0
+ } else {
+ set coords [$c coords $selectbox]
+ set x [lindex $coords 0]
+ set y [lindex $coords 1]
+ set x1 [lindex $coords 4]
+ set y1 [lindex $coords 5]
+ $c delete $selectbox
+ set selectbox ""
+ }
+ set enclosed {}
+ foreach obj [$c find enclosed $x $y $x1 $y1] {
+ set tags [$c gettags $obj]
+ if {[lindex $tags 0] == "node" && [lsearch $tags selected] == -1} {
+ lappend enclosed $obj
+ }
+ }
+ foreach obj $enclosed {
+ selectNode $c $obj
+ }
}
$c raise link background
$c raise linklabel "link || background"
set name [getNodeName $node]
set model [getNodeModel $node]
if { $model != "" } {
- set line "{$node} $name ($model):"
+ set line "{$node} $name ($model):"
} else {
- set line "{$node} $name:"
+ set line "{$node} $name:"
}
if { $type != "rj45" } {
- foreach ifc [ifcList $node] {
- set line "$line $ifc:[getIfcIPv4addr $node $ifc]"
- }
+ foreach ifc [ifcList $node] {
+ set line "$line $ifc:[getIfcIPv4addr $node $ifc]"
+ }
}
.bottom.textbox config -text "$line"
return
set link [lindex [$c gettags current] 1]
if { [lsearch $link_list $link] == -1 } {
- return
+ return
}
set line "$link: [getLinkBandwidthString $link] [getLinkDelayString $link]"
.bottom.textbox config -text "$line"
#****
proc checkIntRange { str low high } {
if { $str == "" } {
- return 1
+ return 1
}
set str [string trimleft $str 0]
if { $str == "" } {
- set str 0
+ set str 0
}
if { ![string is integer $str] } {
- return 0
+ return 0
}
if { $str < $low || $str > $high } {
- return 0
+ return 0
}
return 1
}
set bg white
if { $badentry == -1 } {
- return
+ return
} else {
- set badentry 1
+ set badentry 1
}
focus -force $W
if {$count<1} {
- $W configure -foreground $fg -background $bg
- set badentry 0
+ $W configure -foreground $fg -background $bg
+ set badentry 0
} else {
- if {$count%2} {
- $W configure -foreground $bg -background $fg
- } else {
- $W configure -foreground $fg -background $bg
- }
- after 200 [list focusAndFlash $W [expr {$count-1}]]
+ if {$count%2} {
+ $W configure -foreground $bg -background $fg
+ } else {
+ $W configure -foreground $fg -background $bg
+ }
+ after 200 [list focusAndFlash $W [expr {$count-1}]]
}
return
}
set tk_type [lindex [$c gettags current] 0]
set target [lindex [$c gettags current] 1]
if { [lsearch {node nodelabel interface} $tk_type] > -1 } {
- set object_type node
+ set object_type node
}
if { [lsearch {link linklabel} $tk_type] > -1 } {
- set object_type link
+ set object_type link
}
if { "$object_type" == ""} {
- destroy $wi
- return
+ destroy $wi
+ return
}
if { $object_type == "link" } {
- set n0 [lindex [linkPeers $target] 0]
- set n1 [lindex [linkPeers $target] 1]
- if { [nodeType $n0] == "rj45" || [nodeType $n1] == "rj45" } {
- destroy $wi
- return
- }
+ set n0 [lindex [linkPeers $target] 0]
+ set n1 [lindex [linkPeers $target] 1]
+ if { [nodeType $n0] == "rj45" || [nodeType $n1] == "rj45" } {
+ destroy $wi
+ return
+ }
}
$c dtag node selected
$c delete -withtags selectmark
switch -exact -- $object_type {
- node {
- set type [nodeType $target]
- if { $type == "pseudo" } {
- #
- # Hyperlink to another canvas
- #
- destroy $wi
- set curcanvas [getNodeCanvas [getNodeMirror $target]]
- switchCanvas none
- return
- }
- set model [getNodeModel $target]
- set router_model $model
- wm title $wi "$type configuration"
- frame $wi.ftop -borderwidth 4
- if { $type == "rj45" } {
- label $wi.ftop.name_label -text "Physical interface:"
- } else {
- label $wi.ftop.name_label -text "Node name:"
- }
- entry $wi.ftop.name -bg white -width 16 \
- -validate focus -invcmd "focusAndFlash %W"
- $wi.ftop.name insert 0 [getNodeName $target]
- pack $wi.ftop.name $wi.ftop.name_label -side right -padx 4 -pady 4
- pack $wi.ftop -side top
- if { $type == "router" } {
- frame $wi.model -borderwidth 4
- label $wi.model.label -text "Model:"
- if { $oper_mode == "edit" } {
- eval tk_optionMenu $wi.model.menu router_model \
- $supp_router_models
- } else {
- tk_optionMenu $wi.model.menu router_model $model
- }
- pack $wi.model.menu $wi.model.label -side right -padx 0 -pady 0
- pack $wi.model -side top
- }
-
- if { $type != "rj45" } {
- foreach ifc [lsort -ascii [ifcList $target]] {
- labelframe $wi.if$ifc -padx 4 -pady 4
- frame $wi.if$ifc.label
- label $wi.if$ifc.label.txt -text "Interface $ifc:"
- pack $wi.if$ifc.label.txt -side left -anchor w
- if {[[typemodel $target].layer] == "NETWORK"} {
- global ifoper$ifc
- set ifoper$ifc [getIfcOperState $target $ifc]
- radiobutton $wi.if$ifc.label.up -text "up" \
- -variable ifoper$ifc -value up
- radiobutton $wi.if$ifc.label.down -text "down" \
- -variable ifoper$ifc -value down
- label $wi.if$ifc.label.mtul -text "MTU" \
- -anchor e -width 5
- spinbox $wi.if$ifc.label.mtuv -bg white -width 4 \
- -validate focus -invcmd "focusAndFlash %W"
- $wi.if$ifc.label.mtuv insert 0 \
- [getIfcMTU $target $ifc]
- if {![string first eth $ifc]} {
- $wi.if$ifc.label.mtuv configure \
- -from 256 -to 1500 -increment 2 \
- -vcmd {checkIntRange %P 256 1500}
- } else {
- $wi.if$ifc.label.mtuv configure \
- -from 256 -to 2044 -increment 2 \
- -vcmd {checkIntRange %P 256 2044}
- }
- pack $wi.if$ifc.label.up $wi.if$ifc.label.down \
- $wi.if$ifc.label.mtul $wi.if$ifc.label.mtuv \
- -side left -anchor w
- }
- pack $wi.if$ifc.label -side top -anchor w
- frame $wi.if$ifc.tab -width 10
- frame $wi.if$ifc.cfg
-
- #
- # Queue config
- #
- global ifqdisc$ifc ifqdrop$ifc
- set ifqdisc$ifc [getIfcQDisc $target $ifc]
- set ifqdrop$ifc [getIfcQDrop $target $ifc]
- frame $wi.if$ifc.cfg.q
- label $wi.if$ifc.cfg.q.l1 -text "Queue" \
- -anchor w
- tk_optionMenu $wi.if$ifc.cfg.q.disc ifqdisc$ifc \
- FIFO DRR WFQ
- tk_optionMenu $wi.if$ifc.cfg.q.drop ifqdrop$ifc \
- drop-tail drop-head
- label $wi.if$ifc.cfg.q.l2 -text "len" \
- -anchor e -width 3
- spinbox $wi.if$ifc.cfg.q.len -bg white -width 4 \
- -validate focus -invcmd "focusAndFlash %W"
- $wi.if$ifc.cfg.q.len insert 0 [getIfcQLen $target $ifc]
- $wi.if$ifc.cfg.q.len configure \
- -from 5 -to 4096 -increment 1 \
- -vcmd {checkIntRange %P 5 4096}
- pack $wi.if$ifc.cfg.q.l1 $wi.if$ifc.cfg.q.disc \
- $wi.if$ifc.cfg.q.drop -side left -anchor w
- pack $wi.if$ifc.cfg.q.l2 $wi.if$ifc.cfg.q.len \
- -side left -anchor e
- pack $wi.if$ifc.cfg.q -side top -anchor w
-
- if {[lsearch {router pc host} $type] >= 0} {
- #
- # IPv4 address
- #
- frame $wi.if$ifc.cfg.ipv4
- label $wi.if$ifc.cfg.ipv4.addrl -text "IPv4 address" \
- -anchor w
- entry $wi.if$ifc.cfg.ipv4.addrv -bg white -width 30 \
- -validate focus -invcmd "focusAndFlash %W"
- $wi.if$ifc.cfg.ipv4.addrv insert 0 \
- [getIfcIPv4addr $target $ifc]
- $wi.if$ifc.cfg.ipv4.addrv configure \
- -vcmd {checkIPv4Net %P}
- pack $wi.if$ifc.cfg.ipv4.addrl \
- $wi.if$ifc.cfg.ipv4.addrv -side left
- pack $wi.if$ifc.cfg.ipv4 -side top -anchor w
-
- #
- # IPv6 address
- #
- frame $wi.if$ifc.cfg.ipv6
- label $wi.if$ifc.cfg.ipv6.addrl -text "IPv6 address" \
- -anchor w
- entry $wi.if$ifc.cfg.ipv6.addrv -bg white -width 30 \
- -validate focus -invcmd "focusAndFlash %W"
- $wi.if$ifc.cfg.ipv6.addrv insert 0 \
- [getIfcIPv6addr $target $ifc]
- $wi.if$ifc.cfg.ipv6.addrv configure \
- -vcmd {checkIPv6Net %P}
- pack $wi.if$ifc.cfg.ipv6.addrl \
- $wi.if$ifc.cfg.ipv6.addrv -side left
- pack $wi.if$ifc.cfg.ipv6 -side top -anchor w
- }
- pack $wi.if$ifc.tab $wi.if$ifc.cfg -side left
- pack $wi.if$ifc -side top -anchor w -fill both
- }
- }
-
- if {[lsearch {router pc host} $type] >= 0} {
- #
- # Static routes
- #
- set routes [concat [getStatIPv4routes $target] \
- [getStatIPv6routes $target]]
- labelframe $wi.statrt -padx 4 -pady 4
- label $wi.statrt.label -text "Static routes:"
- pack $wi.statrt.label -side top -anchor w
- frame $wi.statrt.tab -width 10
- frame $wi.statrt.tab1 -width 10
- frame $wi.statrt.cfg
- set h [expr [llength $routes] + 1]
- if { $h < 2 } {
- set h 2
- }
- text $wi.statrt.cfg.text -font arial -bg white \
- -width 42 -height $h -takefocus 0
- foreach route $routes {
- $wi.statrt.cfg.text insert end "$route\r"
- }
- pack $wi.statrt.cfg.text -expand yes
- pack $wi.statrt.tab $wi.statrt.cfg $wi.statrt.tab1 -side left
- pack $wi.statrt -side top -anchor w -fill both
- }
-
- if {[lsearch {router pc host} $type] >= 0} {
- #
- # Custom startup config
- #
- global customEnabled
- labelframe $wi.custom -padx 4 -pady 4
- frame $wi.custom.label
- label $wi.custom.label.txt -text "Custom startup config:"
- pack $wi.custom.label.txt -side left -anchor w
- set customEnabled [getCustomEnabled $target]
- radiobutton $wi.custom.label.enabled -text "enabled" \
- -variable customEnabled -value true
- radiobutton $wi.custom.label.disabled -text "disabled" \
- -variable customEnabled -value false
- pack $wi.custom.label.enabled $wi.custom.label.disabled \
- -side left -anchor w
- pack $wi.custom.label -side top -anchor w
- frame $wi.custom.cfg
- button $wi.custom.cfg.generate -text "Generate" \
- -command "cfgGenerate $target"
- button $wi.custom.cfg.edit -text "Edit" \
- -command "editStartupCfg $target"
- button $wi.custom.cfg.clear -text "Clear" \
- -command "setCustomConfig $target {}"
- pack $wi.custom.cfg.generate $wi.custom.cfg.edit \
- $wi.custom.cfg.clear -side left
-
- pack $wi.custom.label -side top -anchor w
- pack $wi.custom.cfg -side top
- pack $wi.custom -side top -anchor w -fill both
-
- #
- # CPU scheduling parameters
- #
- labelframe $wi.cpu -padx 4 -pady 4
- label $wi.cpu.minl -text "CPU min%" -anchor w
- spinbox $wi.cpu.mine -bg white -width 3 \
- -validate focus -invcmd "focusAndFlash %W"
- $wi.cpu.mine insert 0 [lindex \
- [lsearch -inline [getNodeCPUConf $target] {min *}] 1]
- $wi.cpu.mine configure \
- -vcmd {checkIntRange %P 1 90} \
- -from 0 -to 90 -increment 1
- label $wi.cpu.maxl -text " max%" -anchor w
- spinbox $wi.cpu.maxe -bg white -width 3 \
- -validate focus -invcmd "focusAndFlash %W"
- set cpumax [lindex \
- [lsearch -inline [getNodeCPUConf $target] {max *}] 1]
- if { $cpumax == "" } {
- set cpumax 100
- }
- $wi.cpu.maxe insert 0 $cpumax
- $wi.cpu.maxe configure \
- -vcmd {checkIntRange %P 1 100} \
- -from 1 -to 100 -increment 1
- label $wi.cpu.weightl -text " weight" -anchor w
- spinbox $wi.cpu.weighte -bg white -width 2 \
- -validate focus -invcmd "focusAndFlash %W"
- $wi.cpu.weighte insert 0 [lindex \
- [lsearch -inline [getNodeCPUConf $target] {weight *}] 1]
- $wi.cpu.weighte configure \
- -vcmd {checkIntRange %P 1 10} \
- -from 1 -to 10 -increment 1
- pack $wi.cpu.minl $wi.cpu.mine \
- $wi.cpu.maxl $wi.cpu.maxe \
- $wi.cpu.weightl $wi.cpu.weighte -side left
- pack $wi.cpu -side top -anchor w -fill both
- }
- }
- link {
- wm title $wi "link configuration"
- frame $wi.ftop -borderwidth 6
- set nam0 [getNodeName $n0]
- set nam1 [getNodeName $n1]
- label $wi.ftop.name_label -justify left -text \
- "Link from $nam0 to $nam1"
- pack $wi.ftop.name_label -side right
- pack $wi.ftop -side top
-
- frame $wi.bandwidth -borderwidth 4
- label $wi.bandwidth.label -anchor e \
- -text "Bandwidth (bps):"
- spinbox $wi.bandwidth.value -bg white -justify right -width 10 \
- -validate focus -invcmd "focusAndFlash %W"
- $wi.bandwidth.value insert 0 [getLinkBandwidth $target]
- $wi.bandwidth.value configure \
- -vcmd {checkIntRange %P 0 1000000000} \
- -from 0 -to 1000000000 -increment 1000
- pack $wi.bandwidth.value $wi.bandwidth.label \
- -side right
- pack $wi.bandwidth -side top -anchor e
-
- frame $wi.delay -borderwidth 4
- label $wi.delay.label -anchor e -text "Delay (us):"
- spinbox $wi.delay.value -bg white -justify right -width 10 \
- -validate focus -invcmd "focusAndFlash %W"
- $wi.delay.value insert 0 [getLinkDelay $target]
- $wi.delay.value configure \
- -vcmd {checkIntRange %P 0 10000000} \
- -from 0 -to 10000000 -increment 5
- pack $wi.delay.value $wi.delay.label -side right
- pack $wi.delay -side top -anchor e
-
- frame $wi.ber -borderwidth 4
- label $wi.ber.label -anchor e -text "BER (1/N):"
- spinbox $wi.ber.value -bg white -justify right -width 10 \
- -validate focus -invcmd "focusAndFlash %W"
- $wi.ber.value insert 0 [getLinkBER $target]
- $wi.ber.value configure \
- -vcmd {checkIntRange %P 0 10000000000000} \
- -from 0 -to 10000000000000 -increment 1000
- pack $wi.ber.value $wi.ber.label -side right
- pack $wi.ber -side top -anchor e
-
- frame $wi.dup -borderwidth 4
- label $wi.dup.label -anchor e -text "Duplicate (%):"
- spinbox $wi.dup.value -bg white -justify right -width 10 \
- -validate focus -invcmd "focusAndFlash %W"
- $wi.dup.value insert 0 [getLinkDup $target]
- $wi.dup.value configure \
- -vcmd {checkIntRange %P 0 50} \
- -from 0 -to 50 -increment 1
- pack $wi.dup.value $wi.dup.label -side right
- pack $wi.dup -side top -anchor e
- }
+ node {
+ set type [nodeType $target]
+ if { $type == "pseudo" } {
+ #
+ # Hyperlink to another canvas
+ #
+ destroy $wi
+ set curcanvas [getNodeCanvas [getNodeMirror $target]]
+ switchCanvas none
+ return
+ }
+ set model [getNodeModel $target]
+ set router_model $model
+ wm title $wi "$type configuration"
+ frame $wi.ftop -borderwidth 4
+ if { $type == "rj45" } {
+ label $wi.ftop.name_label -text "Physical interface:"
+ } else {
+ label $wi.ftop.name_label -text "Node name:"
+ }
+ entry $wi.ftop.name -bg white -width 16 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.ftop.name insert 0 [getNodeName $target]
+ pack $wi.ftop.name $wi.ftop.name_label -side right -padx 4 -pady 4
+ pack $wi.ftop -side top
+ if { $type == "router" } {
+ frame $wi.model -borderwidth 4
+ label $wi.model.label -text "Model:"
+ if { $oper_mode == "edit" } {
+ eval tk_optionMenu $wi.model.menu router_model \
+ $supp_router_models
+ } else {
+ tk_optionMenu $wi.model.menu router_model $model
+ }
+ pack $wi.model.menu $wi.model.label -side right -padx 0 -pady 0
+ pack $wi.model -side top
+ }
+
+ if { $type != "rj45" } {
+ foreach ifc [lsort -ascii [ifcList $target]] {
+ labelframe $wi.if$ifc -padx 4 -pady 4
+ frame $wi.if$ifc.label
+ label $wi.if$ifc.label.txt -text "Interface $ifc:"
+ pack $wi.if$ifc.label.txt -side left -anchor w
+ if {[[typemodel $target].layer] == "NETWORK"} {
+ global ifoper$ifc
+ set ifoper$ifc [getIfcOperState $target $ifc]
+ radiobutton $wi.if$ifc.label.up -text "up" \
+ -variable ifoper$ifc -value up
+ radiobutton $wi.if$ifc.label.down -text "down" \
+ -variable ifoper$ifc -value down
+ label $wi.if$ifc.label.mtul -text "MTU" \
+ -anchor e -width 5
+ spinbox $wi.if$ifc.label.mtuv -bg white -width 4 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.if$ifc.label.mtuv insert 0 \
+ [getIfcMTU $target $ifc]
+ if {![string first eth $ifc]} {
+ $wi.if$ifc.label.mtuv configure \
+ -from 256 -to 1500 -increment 2 \
+ -vcmd {checkIntRange %P 256 1500}
+ } else {
+ $wi.if$ifc.label.mtuv configure \
+ -from 256 -to 2044 -increment 2 \
+ -vcmd {checkIntRange %P 256 2044}
+ }
+ pack $wi.if$ifc.label.up $wi.if$ifc.label.down \
+ $wi.if$ifc.label.mtul $wi.if$ifc.label.mtuv \
+ -side left -anchor w
+ }
+ pack $wi.if$ifc.label -side top -anchor w
+ frame $wi.if$ifc.tab -width 10
+ frame $wi.if$ifc.cfg
+
+ #
+ # Queue config
+ #
+ global ifqdisc$ifc ifqdrop$ifc
+ set ifqdisc$ifc [getIfcQDisc $target $ifc]
+ set ifqdrop$ifc [getIfcQDrop $target $ifc]
+ frame $wi.if$ifc.cfg.q
+ label $wi.if$ifc.cfg.q.l1 -text "Queue" \
+ -anchor w
+ tk_optionMenu $wi.if$ifc.cfg.q.disc ifqdisc$ifc \
+ FIFO DRR WFQ
+ tk_optionMenu $wi.if$ifc.cfg.q.drop ifqdrop$ifc \
+ drop-tail drop-head
+ label $wi.if$ifc.cfg.q.l2 -text "len" \
+ -anchor e -width 3
+ spinbox $wi.if$ifc.cfg.q.len -bg white -width 4 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.if$ifc.cfg.q.len insert 0 [getIfcQLen $target $ifc]
+ $wi.if$ifc.cfg.q.len configure \
+ -from 5 -to 4096 -increment 1 \
+ -vcmd {checkIntRange %P 5 4096}
+ pack $wi.if$ifc.cfg.q.l1 $wi.if$ifc.cfg.q.disc \
+ $wi.if$ifc.cfg.q.drop -side left -anchor w
+ pack $wi.if$ifc.cfg.q.l2 $wi.if$ifc.cfg.q.len \
+ -side left -anchor e
+ pack $wi.if$ifc.cfg.q -side top -anchor w
+
+ if {[lsearch {router pc host} $type] >= 0} {
+ #
+ # IPv4 address
+ #
+ frame $wi.if$ifc.cfg.ipv4
+ label $wi.if$ifc.cfg.ipv4.addrl -text "IPv4 address" \
+ -anchor w
+ entry $wi.if$ifc.cfg.ipv4.addrv -bg white -width 30 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.if$ifc.cfg.ipv4.addrv insert 0 \
+ [getIfcIPv4addr $target $ifc]
+ $wi.if$ifc.cfg.ipv4.addrv configure \
+ -vcmd {checkIPv4Net %P}
+ pack $wi.if$ifc.cfg.ipv4.addrl \
+ $wi.if$ifc.cfg.ipv4.addrv -side left
+ pack $wi.if$ifc.cfg.ipv4 -side top -anchor w
+
+ #
+ # IPv6 address
+ #
+ frame $wi.if$ifc.cfg.ipv6
+ label $wi.if$ifc.cfg.ipv6.addrl -text "IPv6 address" \
+ -anchor w
+ entry $wi.if$ifc.cfg.ipv6.addrv -bg white -width 30 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.if$ifc.cfg.ipv6.addrv insert 0 \
+ [getIfcIPv6addr $target $ifc]
+ $wi.if$ifc.cfg.ipv6.addrv configure \
+ -vcmd {checkIPv6Net %P}
+ pack $wi.if$ifc.cfg.ipv6.addrl \
+ $wi.if$ifc.cfg.ipv6.addrv -side left
+ pack $wi.if$ifc.cfg.ipv6 -side top -anchor w
+ }
+ pack $wi.if$ifc.tab $wi.if$ifc.cfg -side left
+ pack $wi.if$ifc -side top -anchor w -fill both
+ }
+ }
+
+ if {[lsearch {router pc host} $type] >= 0} {
+ #
+ # Static routes
+ #
+ set routes [concat [getStatIPv4routes $target] \
+ [getStatIPv6routes $target]]
+ labelframe $wi.statrt -padx 4 -pady 4
+ label $wi.statrt.label -text "Static routes:"
+ pack $wi.statrt.label -side top -anchor w
+ frame $wi.statrt.tab -width 10
+ frame $wi.statrt.tab1 -width 10
+ frame $wi.statrt.cfg
+ set h [expr [llength $routes] + 1]
+ if { $h < 2 } {
+ set h 2
+ }
+ text $wi.statrt.cfg.text -font arial -bg white \
+ -width 42 -height $h -takefocus 0
+ foreach route $routes {
+ $wi.statrt.cfg.text insert end "$route\r"
+ }
+ pack $wi.statrt.cfg.text -expand yes
+ pack $wi.statrt.tab $wi.statrt.cfg $wi.statrt.tab1 -side left
+ pack $wi.statrt -side top -anchor w -fill both
+ }
+
+ if {[lsearch {router pc host} $type] >= 0} {
+ #
+ # Custom startup config
+ #
+ global customEnabled
+ labelframe $wi.custom -padx 4 -pady 4
+ frame $wi.custom.label
+ label $wi.custom.label.txt -text "Custom startup config:"
+ pack $wi.custom.label.txt -side left -anchor w
+ set customEnabled [getCustomEnabled $target]
+ radiobutton $wi.custom.label.enabled -text "enabled" \
+ -variable customEnabled -value true
+ radiobutton $wi.custom.label.disabled -text "disabled" \
+ -variable customEnabled -value false
+ pack $wi.custom.label.enabled $wi.custom.label.disabled \
+ -side left -anchor w
+ pack $wi.custom.label -side top -anchor w
+ frame $wi.custom.cfg
+ button $wi.custom.cfg.generate -text "Generate" \
+ -command "cfgGenerate $target"
+ button $wi.custom.cfg.edit -text "Edit" \
+ -command "editStartupCfg $target"
+ button $wi.custom.cfg.clear -text "Clear" \
+ -command "setCustomConfig $target {}"
+ pack $wi.custom.cfg.generate $wi.custom.cfg.edit \
+ $wi.custom.cfg.clear -side left
+
+ pack $wi.custom.label -side top -anchor w
+ pack $wi.custom.cfg -side top
+ pack $wi.custom -side top -anchor w -fill both
+
+ #
+ # IPsec configuration:
+ #
+ global ipsecEnabled
+ labelframe $wi.ipsec -padx 4 -pady 4
+ frame $wi.ipsec.label
+ label $wi.ipsec.label.txt -text "Manual IPsec configuration:"
+ pack $wi.ipsec.label.txt -side left -anchor w
+ set ipsecEnabled [getIpsecEnabled $target]
+ radiobutton $wi.ipsec.label.enabled -text "enabled" \
+ -variable ipsecEnabled -value true
+ radiobutton $wi.ipsec.label.disabled -text "disabled" \
+ -variable ipsecEnabled -value false
+ pack $wi.ipsec.label.enabled $wi.ipsec.label.disabled \
+ -side left -anchor w
+ pack $wi.ipsec.label -side top -anchor w
+ frame $wi.ipsec.cfg
+ set delete "0"
+ set view "0"
+ button $wi.ipsec.cfg.add -text "Add SA/SP" \
+ -command "viewIpsecCfg $target $delete $view"
+ set delete "0"
+ set view "1"
+ button $wi.ipsec.cfg.view -text "Edit SAs/SPs" \
+ -command "viewIpsecCfg $target $delete $view"
+ pack $wi.ipsec.cfg.add \
+ $wi.ipsec.cfg.view -side left
+ pack $wi.ipsec.label -side top -anchor w
+ pack $wi.ipsec.cfg -side top
+ pack $wi.ipsec -side top -anchor w -fill both
+
+ #
+ # CPU scheduling parameters
+ #
+ labelframe $wi.cpu -padx 4 -pady 4
+ label $wi.cpu.minl -text "CPU min%" -anchor w
+ spinbox $wi.cpu.mine -bg white -width 3 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.cpu.mine insert 0 [lindex \
+ [lsearch -inline [getNodeCPUConf $target] {min *}] 1]
+ $wi.cpu.mine configure \
+ -vcmd {checkIntRange %P 1 90} \
+ -from 0 -to 90 -increment 1
+ label $wi.cpu.maxl -text " max%" -anchor w
+ spinbox $wi.cpu.maxe -bg white -width 3 \
+ -validate focus -invcmd "focusAndFlash %W"
+ set cpumax [lindex \
+ [lsearch -inline [getNodeCPUConf $target] {max *}] 1]
+ if { $cpumax == "" } {
+ set cpumax 100
+ }
+ $wi.cpu.maxe insert 0 $cpumax
+ $wi.cpu.maxe configure \
+ -vcmd {checkIntRange %P 1 100} \
+ -from 1 -to 100 -increment 1
+ label $wi.cpu.weightl -text " weight" -anchor w
+ spinbox $wi.cpu.weighte -bg white -width 2 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.cpu.weighte insert 0 [lindex \
+ [lsearch -inline [getNodeCPUConf $target] {weight *}] 1]
+ $wi.cpu.weighte configure \
+ -vcmd {checkIntRange %P 1 10} \
+ -from 1 -to 10 -increment 1
+ pack $wi.cpu.minl $wi.cpu.mine \
+ $wi.cpu.maxl $wi.cpu.maxe \
+ $wi.cpu.weightl $wi.cpu.weighte -side left
+ pack $wi.cpu -side top -anchor w -fill both
+ }
+ }
+ link {
+ wm title $wi "link configuration"
+ frame $wi.ftop -borderwidth 6
+ set nam0 [getNodeName $n0]
+ set nam1 [getNodeName $n1]
+ label $wi.ftop.name_label -justify left -text \
+ "Link from $nam0 to $nam1"
+ pack $wi.ftop.name_label -side right
+ pack $wi.ftop -side top
+
+ frame $wi.bandwidth -borderwidth 4
+ label $wi.bandwidth.label -anchor e \
+ -text "Bandwidth (bps):"
+ spinbox $wi.bandwidth.value -bg white -justify right -width 10 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.bandwidth.value insert 0 [getLinkBandwidth $target]
+ $wi.bandwidth.value configure \
+ -vcmd {checkIntRange %P 0 1000000000} \
+ -from 0 -to 1000000000 -increment 1000
+ pack $wi.bandwidth.value $wi.bandwidth.label \
+ -side right
+ pack $wi.bandwidth -side top -anchor e
+
+ frame $wi.delay -borderwidth 4
+ label $wi.delay.label -anchor e -text "Delay (us):"
+ spinbox $wi.delay.value -bg white -justify right -width 10 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.delay.value insert 0 [getLinkDelay $target]
+ $wi.delay.value configure \
+ -vcmd {checkIntRange %P 0 10000000} \
+ -from 0 -to 10000000 -increment 5
+ pack $wi.delay.value $wi.delay.label -side right
+ pack $wi.delay -side top -anchor e
+
+ frame $wi.ber -borderwidth 4
+ label $wi.ber.label -anchor e -text "BER (1/N):"
+ spinbox $wi.ber.value -bg white -justify right -width 10 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.ber.value insert 0 [getLinkBER $target]
+ $wi.ber.value configure \
+ -vcmd {checkIntRange %P 0 10000000000000} \
+ -from 0 -to 10000000000000 -increment 1000
+ pack $wi.ber.value $wi.ber.label -side right
+ pack $wi.ber -side top -anchor e
+
+ frame $wi.dup -borderwidth 4
+ label $wi.dup.label -anchor e -text "Duplicate (%):"
+ spinbox $wi.dup.value -bg white -justify right -width 10 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.dup.value insert 0 [getLinkDup $target]
+ $wi.dup.value configure \
+ -vcmd {checkIntRange %P 0 50} \
+ -from 0 -to 50 -increment 1
+ pack $wi.dup.value $wi.dup.label -side right
+ pack $wi.dup -side top -anchor e
+ }
}
frame $wi.butt -borderwidth 6
button $wi.butt.apply -text "Apply" -command \
- "popupConfigApply $wi $object_type $target 0"
+ "popupConfigApply $wi $object_type $target 0"
focus $wi.butt.apply
button $wi.butt.cancel -text "Cancel" -command \
- "set badentry -1 ; destroy $wi"
+ "set badentry -1 ; destroy $wi"
pack $wi.butt.cancel $wi.butt.apply -side right
pack $wi.butt -side bottom
after 100 {
- grab .popup
+ grab .popup
}
return
}
pack $w.ftop -side top -anchor w
text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \
- -setgrid 1 -height 40 -undo 1 -autosep 1 -background white
+ -setgrid 1 -height 10 -undo 1 -autosep 1 -background white
focus $w.text
scrollbar $w.scroll -command "$w.text yview"
- frame $w.buttons
- pack $w.buttons -side bottom
- button $w.buttons.apply -text "Apply" \
- -command "customConfigApply $w $node"
- button $w.buttons.cancel -text Cancel -command "destroy $w"
- pack $w.buttons.apply $w.buttons.cancel -side left
-
pack $w.scroll -side right -fill y
pack $w.text -expand yes -fill both
+ # TODO: Ako je custom-config vec ucitan i ostavimo postavljen custom
+ # config enabled, onda se ono ucitano razlomi tak da da svako slovo
+ # dodje u novi red.
foreach line [getCustomConfig $node] {
- $w.text insert end "$line\r"
+ $w.text insert end "$line\r"
}
$w.text mark set insert 0.0
+
return
}
-
#****f* editor.tcl/customConfigApply
# NAME
# customConfigApply -- custom configuration apply
global changed
set newcmd [$w.ftop.cmd get]
- set newconf [split [$w.text get 0.0 end] {\r}]
+ set newconf [split [$w.text get 0.0 end] {^M}]
while { [lindex $newconf end] == {} && $newconf != {} } {
- set newconf [lreplace $newconf end end]
+ set newconf [lreplace $newconf end end]
}
if { [getCustomCmd $node] != $newcmd || \
- [getCustomConfig $node] != $newconf } {
- set changed 1
+ [getCustomConfig $node] != $newconf } {
+ set changed 1
}
setCustomCmd $node $newcmd
setCustomConfig $node $newconf
return
}
-
#****f* editor.tcl/popupConfigApply
# NAME
# popupConfigApply -- popup configuration apply
# set to 0.
#****
proc popupConfigApply { wi object_type target phase } {
- global changed oper_mode router_model badentry customEnabled
+ global changed oper_mode router_model badentry
+ global customEnabled ipsecEnabled
global eid
$wi config -cursor watch
update
if { $phase == 0 } {
- set badentry 0
- focus .
- after 100 "popupConfigApply $wi $object_type $target 1"
- return
+ set badentry 0
+ focus .
+ after 100 "popupConfigApply $wi $object_type $target 1"
+ return
} elseif { $badentry } {
- $wi config -cursor left_ptr
- return
+ $wi config -cursor left_ptr
+ return
}
switch -exact -- $object_type {
- #
- # Node
- #
- node {
- set type [nodeType $target]
- set model [getNodeModel $target]
- set name [string trim [$wi.ftop.name get]]
- if { $name != [getNodeName $target] } {
- setNodeName $target $name
- set changed 1
- }
- if { $oper_mode == "edit" && $type == "router" && \
- $router_model != $model } {
- setNodeModel $target $router_model
- set changed 1
- }
-
- #
- # Queue config
- #
- foreach ifc [ifcList $target] {
- if { [nodeType [peerByIfc $target $ifc]] != "rj45" && \
- [nodeType $target] != "rj45" } {
- global ifqdisc$ifc ifqdrop$ifc
- set qdisc [subst $[subst ifqdisc$ifc]]
- set oldqdisc [getIfcQDisc $target $ifc]
- if { $qdisc != $oldqdisc } {
- setIfcQDisc $target $ifc $qdisc
- set changed 1
- }
- set qdrop [subst $[subst ifqdrop$ifc]]
- set oldqdrop [getIfcQDrop $target $ifc]
- if { $qdrop != $oldqdrop } {
- setIfcQDrop $target $ifc $qdrop
- set changed 1
- }
- set len [$wi.if$ifc.cfg.q.len get]
- set oldlen [getIfcQLen $target $ifc]
- if { $len != $oldlen } {
- setIfcQLen $target $ifc $len
- set changed 1
- }
- }
- }
-
- if {[[typemodel $target].layer] == "NETWORK"} {
- foreach ifc [ifcList $target] {
- #
- # Operational state
- #
- global [subst ifoper$ifc]
- set ifoperstate [subst $[subst ifoper$ifc]]
- set oldifoperstate [getIfcOperState $target $ifc]
- if { $ifoperstate != $oldifoperstate } {
- setIfcOperState $target $ifc $ifoperstate
- set changed 1
- }
-
- #
- # IPv4 / IPv6 address & MTU
- #
- set ipaddr [$wi.if$ifc.cfg.ipv4.addrv get]
- set oldipaddr [getIfcIPv4addr $target $ifc]
- if { $ipaddr != $oldipaddr } {
- setIfcIPv4addr $target $ifc $ipaddr
- set changed 1
- }
- set ipaddr [$wi.if$ifc.cfg.ipv6.addrv get]
- set oldipaddr [getIfcIPv6addr $target $ifc]
- if { $ipaddr != $oldipaddr } {
- setIfcIPv6addr $target $ifc $ipaddr
- set changed 1
- }
-
- set mtu [$wi.if$ifc.label.mtuv get]
- set oldmtu [getIfcMTU $target $ifc]
- if { $mtu != $oldmtu } {
- setIfcMTU $target $ifc $mtu
- set changed 1
- }
-
- }
-
- set oldIPv4statrtes [lsort [getStatIPv4routes $target]]
- set oldIPv6statrtes [lsort [getStatIPv6routes $target]]
- set newIPv4statrtes {}
- set newIPv6statrtes {}
- set i 1
- while { 1 } {
- set text [$wi.statrt.cfg.text get $i.0 $i.end]
- set rtentry [lrange [split [string trim $text]] 0 2]
- if { $rtentry == "" } {
- break
- }
- set dst [lindex $rtentry 0]
- set gw [lindex $rtentry 1]
- set metric [lindex $rtentry 2]
- if { [string is integer $metric] != 1 || \
- $metric > 65535 } {
- break
- }
- if { [checkIPv4Net $dst] == 1 } {
- if { [checkIPv4Addr $gw] == 1 } {
- lappend newIPv4statrtes \
- [string trim "$dst $gw $metric"]
- } else {
- break
- }
- } elseif { [checkIPv6Net $dst] == 1 } {
- if { [checkIPv6Addr $gw] == 1 } {
- lappend newIPv6statrtes \
- [string trim "$dst $gw $metric"]
- } else {
- break
- }
- } else {
- break
- }
- incr i
- }
- set newIPv4statrtes [lsort $newIPv4statrtes]
- if { $oldIPv4statrtes != $newIPv4statrtes } {
- setStatIPv4routes $target $newIPv4statrtes
- set changed 1
- }
- set newIPv6statrtes [lsort $newIPv6statrtes]
- if { $oldIPv6statrtes != $newIPv6statrtes } {
- setStatIPv6routes $target $newIPv6statrtes
- set changed 1
- }
-
- set oldcustomenabled [getCustomEnabled $target]
- if {$oldcustomenabled != $customEnabled} {
- setCustomEnabled $target $customEnabled
- set changed 1
- }
-
- set oldcpuconf [getNodeCPUConf $target]
- set newcpuconf {}
- set cpumin [$wi.cpu.mine get]
- set cpumax [$wi.cpu.maxe get]
- set cpuweight [$wi.cpu.weighte get]
- if { $cpumin != "" } {
- lappend newcpuconf "min $cpumin"
- }
- if { $cpumax != "" } {
- lappend newcpuconf "max $cpumax"
- }
- if { $cpuweight != "" } {
- lappend newcpuconf "weight $cpuweight"
- }
- if { $oldcpuconf != $newcpuconf } {
- setNodeCPUConf $target [list $newcpuconf]
- set changed 1
- }
- }
- }
-
- #
- # Link
- #
- link {
- set mirror [getLinkMirror $target]
- set bw [$wi.bandwidth.value get]
- if { $bw != [getLinkBandwidth $target] } {
- setLinkBandwidth $target [$wi.bandwidth.value get]
- if { $mirror != "" } {
- setLinkBandwidth $mirror [$wi.bandwidth.value get]
- }
- set changed 1
- }
- set dly [$wi.delay.value get]
- if { $dly != [getLinkDelay $target] } {
- setLinkDelay $target [$wi.delay.value get]
- if { $mirror != "" } {
- setLinkDelay $mirror [$wi.delay.value get]
- }
- set changed 1
- }
- set ber [$wi.ber.value get]
- if { $ber != [getLinkBER $target] } {
- setLinkBER $target [$wi.ber.value get]
- if { $mirror != "" } {
- setLinkBER $mirror [$wi.ber.value get]
- }
- set changed 1
- }
- set dup [$wi.dup.value get]
- if { $dup != [getLinkDup $target] } {
- setLinkDup $target [$wi.dup.value get]
- if { $mirror != "" } {
- setLinkDup $mirror [$wi.dup.value get]
- }
- set changed 1
- }
+ #
+ # Node
+ #
+ node {
+ set type [nodeType $target]
+ set model [getNodeModel $target]
+ set name [string trim [$wi.ftop.name get]]
+ if { $name != [getNodeName $target] } {
+ setNodeName $target $name
+ set changed 1
+ }
+ if { $oper_mode == "edit" && $type == "router" && \
+ $router_model != $model } {
+ setNodeModel $target $router_model
+ set changed 1
+ }
+
+ #
+ # Queue config
+ #
+ foreach ifc [ifcList $target] {
+ if { [nodeType [peerByIfc $target $ifc]] != "rj45" && \
+ [nodeType $target] != "rj45" } {
+ global ifqdisc$ifc ifqdrop$ifc
+ set qdisc [subst $[subst ifqdisc$ifc]]
+ set oldqdisc [getIfcQDisc $target $ifc]
+ if { $qdisc != $oldqdisc } {
+ setIfcQDisc $target $ifc $qdisc
+ set changed 1
+ }
+ set qdrop [subst $[subst ifqdrop$ifc]]
+ set oldqdrop [getIfcQDrop $target $ifc]
+ if { $qdrop != $oldqdrop } {
+ setIfcQDrop $target $ifc $qdrop
+ set changed 1
+ }
+ set len [$wi.if$ifc.cfg.q.len get]
+ set oldlen [getIfcQLen $target $ifc]
+ if { $len != $oldlen } {
+ setIfcQLen $target $ifc $len
+ set changed 1
+ }
+ }
+ }
+
+ if {[[typemodel $target].layer] == "NETWORK"} {
+ foreach ifc [ifcList $target] {
+ #
+ # Operational state
+ #
+ global [subst ifoper$ifc]
+ set ifoperstate [subst $[subst ifoper$ifc]]
+ set oldifoperstate [getIfcOperState $target $ifc]
+ if { $ifoperstate != $oldifoperstate } {
+ setIfcOperState $target $ifc $ifoperstate
+ set changed 1
+ }
+
+ #
+ # IPv4 / IPv6 address & MTU
+ #
+ set ipaddr [$wi.if$ifc.cfg.ipv4.addrv get]
+ set oldipaddr [getIfcIPv4addr $target $ifc]
+ if { $ipaddr != $oldipaddr } {
+ setIfcIPv4addr $target $ifc $ipaddr
+ set changed 1
+ }
+ set ipaddr [$wi.if$ifc.cfg.ipv6.addrv get]
+ set oldipaddr [getIfcIPv6addr $target $ifc]
+ if { $ipaddr != $oldipaddr } {
+ setIfcIPv6addr $target $ifc $ipaddr
+ set changed 1
+ }
+
+ set mtu [$wi.if$ifc.label.mtuv get]
+ set oldmtu [getIfcMTU $target $ifc]
+ if { $mtu != $oldmtu } {
+ setIfcMTU $target $ifc $mtu
+ set changed 1
+ }
+
+ }
+
+ set oldIPv4statrtes [lsort [getStatIPv4routes $target]]
+ set oldIPv6statrtes [lsort [getStatIPv6routes $target]]
+ set newIPv4statrtes {}
+ set newIPv6statrtes {}
+ set i 1
+ while { 1 } {
+ set text [$wi.statrt.cfg.text get $i.0 $i.end]
+ set rtentry [lrange [split [string trim $text]] 0 2]
+ if { $rtentry == "" } {
+ break
+ }
+ set dst [lindex $rtentry 0]
+ set gw [lindex $rtentry 1]
+ set metric [lindex $rtentry 2]
+ if { [string is integer $metric] != 1 || \
+ $metric > 65535 } {
+ break
+ }
+ if { [checkIPv4Net $dst] == 1 } {
+ if { [checkIPv4Addr $gw] == 1 } {
+ lappend newIPv4statrtes \
+ [string trim "$dst $gw $metric"]
+ } else {
+ break
+ }
+ } elseif { [checkIPv6Net $dst] == 1 } {
+ if { [checkIPv6Addr $gw] == 1 } {
+ lappend newIPv6statrtes \
+ [string trim "$dst $gw $metric"]
+ } else {
+ break
+ }
+ } else {
+ break
+ }
+ incr i
+ }
+ set newIPv4statrtes [lsort $newIPv4statrtes]
+ if { $oldIPv4statrtes != $newIPv4statrtes } {
+ setStatIPv4routes $target $newIPv4statrtes
+ set changed 1
+ }
+ set newIPv6statrtes [lsort $newIPv6statrtes]
+ if { $oldIPv6statrtes != $newIPv6statrtes } {
+ setStatIPv6routes $target $newIPv6statrtes
+ set changed 1
+ }
+
+ set oldcustomenabled [getCustomEnabled $target]
+ if {$oldcustomenabled != $customEnabled} {
+ setCustomEnabled $target $customEnabled
+ set changed 1
+ }
+
+ set oldipsecenabled [getIpsecEnabled $target]
+ if {$oldipsecenabled != $ipsecEnabled} {
+ setIpsecEnabled $target $ipsecEnabled
+ set changed 1
+ }
+
+ set oldcpuconf [getNodeCPUConf $target]
+ set newcpuconf {}
+ set cpumin [$wi.cpu.mine get]
+ set cpumax [$wi.cpu.maxe get]
+ set cpuweight [$wi.cpu.weighte get]
+ if { $cpumin != "" } {
+ lappend newcpuconf "min $cpumin"
+ }
+ if { $cpumax != "" } {
+ lappend newcpuconf "max $cpumax"
+ }
+ if { $cpuweight != "" } {
+ lappend newcpuconf "weight $cpuweight"
+ }
+ if { $oldcpuconf != $newcpuconf } {
+ setNodeCPUConf $target [list $newcpuconf]
+ set changed 1
+ }
+ }
+ }
+
+ #
+ # Link
+ #
+ link {
+ set mirror [getLinkMirror $target]
+ set bw [$wi.bandwidth.value get]
+ if { $bw != [getLinkBandwidth $target] } {
+ setLinkBandwidth $target [$wi.bandwidth.value get]
+ if { $mirror != "" } {
+ setLinkBandwidth $mirror [$wi.bandwidth.value get]
+ }
+ set changed 1
+ }
+ set dly [$wi.delay.value get]
+ if { $dly != [getLinkDelay $target] } {
+ setLinkDelay $target [$wi.delay.value get]
+ if { $mirror != "" } {
+ setLinkDelay $mirror [$wi.delay.value get]
+ }
+ set changed 1
+ }
+ set ber [$wi.ber.value get]
+ if { $ber != [getLinkBER $target] } {
+ setLinkBER $target [$wi.ber.value get]
+ if { $mirror != "" } {
+ setLinkBER $mirror [$wi.ber.value get]
+ }
+ set changed 1
+ }
+ set dup [$wi.dup.value get]
+ if { $dup != [getLinkDup $target] } {
+ setLinkDup $target [$wi.dup.value get]
+ if { $mirror != "" } {
+ setLinkDup $mirror [$wi.dup.value get]
+ }
+ set changed 1
+ }
if { $changed == 1 && $oper_mode == "exec" } {
execSetLinkParams $eid $target
}
- }
+ }
}
if { $changed == 1 } {
- redrawAll
+ redrawAll
updateUndoLog
}
destroy $wi
proc deleteSelection { } {
global changed
global background
-
+ global viewid
+ catch {unset viewid}
+
foreach obj [.c find withtag "node && selected"] {
- set lnode [lindex [.c gettags $obj] 1]
- if { $lnode != "" } {
+ set lnode [lindex [.c gettags $obj] 1]
+ if { $lnode != "" } {
removeGUINode $lnode
- }
+ }
set changed 1
}
.c raise link background
.menubar.tools entryconfigure "Rearrange selected" -state disabled
.bottom.mbuf config -text "autorearrange"
if { $mode == "selected" } {
- set tagmatch "node && selected"
+ set tagmatch "node && selected"
} else {
- set tagmatch "node"
+ set tagmatch "node"
}
set otime [clock clicks -milliseconds]
while { $autorearrange_enabled } {
- set ntime [clock clicks -milliseconds]
- if { $otime == $ntime } {
- set dt 0.001
- } else {
- set dt [expr ($ntime - $otime) * 0.001]
- if { $dt > 0.2 } {
- set dt 0.2
- }
- set otime $ntime
- }
-
- set objects [.c find withtag $tagmatch]
- set peer_objects [.c find withtag node]
- foreach obj $peer_objects {
+ set ntime [clock clicks -milliseconds]
+ if { $otime == $ntime } {
+ set dt 0.001
+ } else {
+ set dt [expr ($ntime - $otime) * 0.001]
+ if { $dt > 0.2 } {
+ set dt 0.2
+ }
+ set otime $ntime
+ }
+
+ set objects [.c find withtag $tagmatch]
+ set peer_objects [.c find withtag node]
+ foreach obj $peer_objects {
set node [lindex [.c gettags $obj] 1]
- set coords [.c coords $obj]
- set x [lindex $coords 0]
- set y [lindex $coords 1]
- set x_t($node) $x
- set y_t($node) $y
-
- if { $x > 0 } {
- set fx [expr 1000 / ($x * $x + 100)]
- } else {
- set fx 10
- }
- set dx [expr $sizex - $x]
- if { $dx > 0 } {
- set fx [expr $fx - 1000 / ($dx * $dx + 100)]
- } else {
- set fx [expr $fx - 10]
- }
-
- if { $y > 0 } {
- set fy [expr 1000 / ($y * $y + 100)]
- } else {
- set fy 10
- }
- set dy [expr $sizey - $y]
- if { $dy > 0 } {
- set fy [expr $fy - 1000 / ($dy * $dy + 100)]
- } else {
- set fy [expr $fy - 10]
- }
- set fx_t($node) $fx
- set fy_t($node) $fy
- }
-
- foreach obj $objects {
+ set coords [.c coords $obj]
+ set x [lindex $coords 0]
+ set y [lindex $coords 1]
+ set x_t($node) $x
+ set y_t($node) $y
+
+ if { $x > 0 } {
+ set fx [expr 1000 / ($x * $x + 100)]
+ } else {
+ set fx 10
+ }
+ set dx [expr $sizex - $x]
+ if { $dx > 0 } {
+ set fx [expr $fx - 1000 / ($dx * $dx + 100)]
+ } else {
+ set fx [expr $fx - 10]
+ }
+
+ if { $y > 0 } {
+ set fy [expr 1000 / ($y * $y + 100)]
+ } else {
+ set fy 10
+ }
+ set dy [expr $sizey - $y]
+ if { $dy > 0 } {
+ set fy [expr $fy - 1000 / ($dy * $dy + 100)]
+ } else {
+ set fy [expr $fy - 10]
+ }
+ set fx_t($node) $fx
+ set fy_t($node) $fy
+ }
+
+ foreach obj $objects {
set node [lindex [.c gettags $obj] 1]
- set i [lsearch -exact $peer_objects $obj]
- set peer_objects [lreplace $peer_objects $i $i]
- set x $x_t($node)
- set y $y_t($node)
- foreach other_obj $peer_objects {
- set other [lindex [.c gettags $other_obj] 1]
- set o_x $x_t($other)
- set o_y $y_t($other)
- set dx [expr $x - $o_x]
- set dy [expr $y - $o_y]
- set d [expr hypot($dx, $dy)]
- set d2 [expr $d * $d]
- set p_fx [expr 1000.0 * $dx / ($d2 * $d + 100)]
- set p_fy [expr 1000.0 * $dy / ($d2 * $d + 100)]
- if {[linkByPeers $node $other] != ""} {
- set p_fx [expr $p_fx - $dx * $d2 * .0000000005]
- set p_fy [expr $p_fy - $dy * $d2 * .0000000005]
- }
- set fx_t($node) [expr $fx_t($node) + $p_fx]
- set fy_t($node) [expr $fy_t($node) + $p_fy]
- set fx_t($other) [expr $fx_t($other) - $p_fx]
- set fy_t($other) [expr $fy_t($other) - $p_fy]
- }
-
- foreach link $link_list {
- set nodes [linkPeers $link]
- if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas ||
- [getNodeCanvas [lindex $nodes 1]] != $curcanvas ||
- [getLinkMirror $link] != "" } {
- continue
- }
- set peers [linkPeers $link]
- set coords0 [getNodeCoords [lindex $peers 0]]
- set coords1 [getNodeCoords [lindex $peers 1]]
- set o_x [expr ([lindex $coords0 0] + [lindex $coords1 0]) * .5]
- set o_y [expr ([lindex $coords0 1] + [lindex $coords1 1]) * .5]
- set dx [expr $x - $o_x]
- set dy [expr $y - $o_y]
- set d [expr hypot($dx, $dy)]
- set d2 [expr $d * $d]
- set fx_t($node) \
- [expr $fx_t($node) + 500.0 * $dx / ($d2 * $d + 100)]
- set fy_t($node) \
- [expr $fy_t($node) + 500.0 * $dy / ($d2 * $d + 100)]
- }
- }
-
- foreach obj $objects {
+ set i [lsearch -exact $peer_objects $obj]
+ set peer_objects [lreplace $peer_objects $i $i]
+ set x $x_t($node)
+ set y $y_t($node)
+ foreach other_obj $peer_objects {
+ set other [lindex [.c gettags $other_obj] 1]
+ set o_x $x_t($other)
+ set o_y $y_t($other)
+ set dx [expr $x - $o_x]
+ set dy [expr $y - $o_y]
+ set d [expr hypot($dx, $dy)]
+ set d2 [expr $d * $d]
+ set p_fx [expr 1000.0 * $dx / ($d2 * $d + 100)]
+ set p_fy [expr 1000.0 * $dy / ($d2 * $d + 100)]
+ if {[linkByPeers $node $other] != ""} {
+ set p_fx [expr $p_fx - $dx * $d2 * .0000000005]
+ set p_fy [expr $p_fy - $dy * $d2 * .0000000005]
+ }
+ set fx_t($node) [expr $fx_t($node) + $p_fx]
+ set fy_t($node) [expr $fy_t($node) + $p_fy]
+ set fx_t($other) [expr $fx_t($other) - $p_fx]
+ set fy_t($other) [expr $fy_t($other) - $p_fy]
+ }
+
+ foreach link $link_list {
+ set nodes [linkPeers $link]
+ if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas ||
+ [getNodeCanvas [lindex $nodes 1]] != $curcanvas ||
+ [getLinkMirror $link] != "" } {
+ continue
+ }
+ set peers [linkPeers $link]
+ set coords0 [getNodeCoords [lindex $peers 0]]
+ set coords1 [getNodeCoords [lindex $peers 1]]
+ set o_x [expr ([lindex $coords0 0] + [lindex $coords1 0]) * .5]
+ set o_y [expr ([lindex $coords0 1] + [lindex $coords1 1]) * .5]
+ set dx [expr $x - $o_x]
+ set dy [expr $y - $o_y]
+ set d [expr hypot($dx, $dy)]
+ set d2 [expr $d * $d]
+ set fx_t($node) \
+ [expr $fx_t($node) + 500.0 * $dx / ($d2 * $d + 100)]
+ set fy_t($node) \
+ [expr $fy_t($node) + 500.0 * $dy / ($d2 * $d + 100)]
+ }
+ }
+
+ foreach obj $objects {
set node [lindex [.c gettags $obj] 1]
- if { [catch "set v_t($node)" v] } {
- set vx 0.0
- set vy 0.0
- } else {
- set vx [lindex $v_t($node) 0]
- set vy [lindex $v_t($node) 1]
- }
- set vx [expr $vx + 1000.0 * $fx_t($node) * $dt]
- set vy [expr $vy + 1000.0 * $fy_t($node) * $dt]
- set dampk [expr 0.5 + ($vx * $vx + $vy * $vy) * 0.00001]
- set vx [expr $vx * exp( - $dampk * $dt)]
- set vy [expr $vy * exp( - $dampk * $dt)]
- set dx [expr $vx * $dt]
- set dy [expr $vy * $dt]
- set x [expr $x_t($node) + $dx]
- set y [expr $y_t($node) + $dy]
- set v_t($node) "$vx $vy"
-
- setNodeCoords $node "$x $y"
- .c move $obj $dx $dy
- set img [.c find withtag "selectmark && $node"]
- .c move $img $dx $dy
- set img [.c find withtag "nodelabel && $node"]
- .c move $img $dx $dy
- setNodeLabelCoords $node [.c coords $img]
- .c addtag need_redraw withtag "link && $node"
- }
- foreach link [.c find withtag "link && need_redraw"] {
- redrawLink [lindex [.c gettags $link] 1]
- }
- .c dtag link need_redraw
- update
+ if { [catch "set v_t($node)" v] } {
+ set vx 0.0
+ set vy 0.0
+ } else {
+ set vx [lindex $v_t($node) 0]
+ set vy [lindex $v_t($node) 1]
+ }
+ set vx [expr $vx + 1000.0 * $fx_t($node) * $dt]
+ set vy [expr $vy + 1000.0 * $fy_t($node) * $dt]
+ set dampk [expr 0.5 + ($vx * $vx + $vy * $vy) * 0.00001]
+ set vx [expr $vx * exp( - $dampk * $dt)]
+ set vy [expr $vy * exp( - $dampk * $dt)]
+ set dx [expr $vx * $dt]
+ set dy [expr $vy * $dt]
+ set x [expr $x_t($node) + $dx]
+ set y [expr $y_t($node) + $dy]
+ set v_t($node) "$vx $vy"
+
+ setNodeCoords $node "$x $y"
+ .c move $obj $dx $dy
+ set img [.c find withtag "selectmark && $node"]
+ .c move $img $dx $dy
+ set img [.c find withtag "nodelabel && $node"]
+ .c move $img $dx $dy
+ setNodeLabelCoords $node [.c coords $img]
+ .c addtag need_redraw withtag "link && $node"
+ }
+ foreach link [.c find withtag "link && need_redraw"] {
+ redrawLink [lindex [.c gettags $link] 1]
+ }
+ .c dtag link need_redraw
+ update
}
.menubar.tools entryconfigure "Rearrange all" -state normal
.menubar.tools entryconfigure "Rearrange selected" -state normal
set i [lsearch $canvas_list $curcanvas]
switch -exact -- $direction {
- prev {
- incr i -1
- if { $i < 0 } {
- set curcanvas [lindex $canvas_list end]
- } else {
- set curcanvas [lindex $canvas_list $i]
- }
- }
- next {
- incr i
- if { $i >= [llength $canvas_list] } {
- set curcanvas [lindex $canvas_list 0]
- } else {
- set curcanvas [lindex $canvas_list $i]
- }
- }
- first {
- set curcanvas [lindex $canvas_list 0]
- }
- last {
- set curcanvas [lindex $canvas_list end]
- }
+ prev {
+ incr i -1
+ if { $i < 0 } {
+ set curcanvas [lindex $canvas_list end]
+ } else {
+ set curcanvas [lindex $canvas_list $i]
+ }
+ }
+ next {
+ incr i
+ if { $i >= [llength $canvas_list] } {
+ set curcanvas [lindex $canvas_list 0]
+ } else {
+ set curcanvas [lindex $canvas_list $i]
+ }
+ }
+ first {
+ set curcanvas [lindex $canvas_list 0]
+ }
+ last {
+ set curcanvas [lindex $canvas_list end]
+ }
}
.hframe.t delete all
set x 0
foreach canvas $canvas_list {
- set text [.hframe.t create text 0 0 \
- -text "[getCanvasName $canvas]" -tags "text $canvas"]
- set ox [lindex [.hframe.t bbox $text] 2]
- set oy [lindex [.hframe.t bbox $text] 3]
- set tab [.hframe.t create polygon $x 0 [expr $x + 7] 18 \
- [expr $x + 2 * $ox + 17] 18 [expr $x + 2 * $ox + 24] 0 $x 0 \
- -fill gray -tags "tab $canvas"]
- set line [.hframe.t create line 0 0 $x 0 [expr $x + 7] 18 \
- [expr $x + 2 * $ox + 17] 18 [expr $x + 2 * $ox + 24] 0 999 0 \
- -fill #808080 -width 2 -tags "line $canvas"]
- .hframe.t coords $text [expr $x + $ox + 12] [expr $oy + 2]
- .hframe.t raise $text
- incr x [expr 2 * $ox + 17]
+ set text [.hframe.t create text 0 0 \
+ -text "[getCanvasName $canvas]" -tags "text $canvas"]
+ set ox [lindex [.hframe.t bbox $text] 2]
+ set oy [lindex [.hframe.t bbox $text] 3]
+ set tab [.hframe.t create polygon $x 0 [expr $x + 7] 18 \
+ [expr $x + 2 * $ox + 17] 18 [expr $x + 2 * $ox + 24] 0 $x 0 \
+ -fill gray -tags "tab $canvas"]
+ set line [.hframe.t create line 0 0 $x 0 [expr $x + 7] 18 \
+ [expr $x + 2 * $ox + 17] 18 [expr $x + 2 * $ox + 24] 0 999 0 \
+ -fill #808080 -width 2 -tags "line $canvas"]
+ .hframe.t coords $text [expr $x + $ox + 12] [expr $oy + 2]
+ .hframe.t raise $text
+ incr x [expr 2 * $ox + 17]
}
incr x 7
.hframe.t raise "$curcanvas"
set lmargin [expr [lindex [.hframe.t xview] 0] * $x - 1]
set rmargin [expr [lindex [.hframe.t xview] 1] * $x + 1]
if { $lborder < $lmargin } {
- .hframe.t xview moveto [expr 1.0 * ($lborder - 10) / $x]
+ .hframe.t xview moveto [expr 1.0 * ($lborder - 10) / $x]
}
if { $rborder > $rmargin } {
- .hframe.t xview moveto [expr 1.0 * ($rborder - $width + 10) / $x]
+ .hframe.t xview moveto [expr 1.0 * ($rborder - $width + 10) / $x]
}
redrawAll
set newname [$w.e1 get]
destroy $w
if { $newname != [getCanvasName $curcanvas] } {
- set changed 1
+ set changed 1
}
setCanvasName $curcanvas $newname
switchCanvas none
.c itemconfigure "selectmark || selectbox" -dashoffset $animatephase
incr animatephase 2
if { $animatephase == 100 } {
- set animatephase 0
+ set animatephase 0
}
if { $oper_mode == "edit" } {
- after 250 animate
+ after 250 animate
} else {
- after 1500 animate
+ after 1500 animate
}
return
}
eval label $wi.hosts.labels.v$i -text "$i. " -anchor e
eval entry $wi.hosts.address.v$i -bg white -width 15 \
- -validate focus -invcmd "focusAndFlash"
+ -validate focus -invcmd "focusAndFlash"
$wi.hosts.address.v$i insert 0 [lindex $host_elem 0]
eval entry $wi.hosts.ports.v$i -bg white -width 5 \
$wi.hosts.ports.v$i insert 0 [lindex $host_elem 1]
eval entry $wi.hosts.monitors.v$i -bg white -width 5 \
- -validate focus -invcmd "focusAndFlash"
+ -validate focus -invcmd "focusAndFlash"
$wi.hosts.monitors.v$i insert 0 [lindex $host_elem 2]
eval checkbutton $wi.hosts.active.v$i \
-variable active_host($i) -onvalue true -offvalue false
-# eval entry $wi.hosts.weight.v$i -bg white -width 5 \
-# -validate focus -invcmd "focusAndFlash"
-# $wi.hosts.weight.v$i insert 0 [lindex $host_elem 4]
+# eval entry $wi.hosts.weight.v$i -bg white -width 5 \
+# -validate focus -invcmd "focusAndFlash"
+# $wi.hosts.weight.v$i insert 0 [lindex $host_elem 4]
- eval checkbutton $wi.hosts.ssh.v$i \
- -variable active_ssh($i) -onvalue true -offvalue false
- # -command {
- # if { active_ssh(0) } {
- # eval $wi.hosts.userName.v$i -configure state normal
- # } else {
- # eval $wi.hosts.userName.v$i -configure state disabled
- # }
- # }
-
- eval entry $wi.hosts.userName.v$i -bg white -width 5 \
- -validate focus -invcmd "focusAndFlash"
- $wi.hosts.userName.v$i insert 0 [lindex $host_elem 5]
+ eval checkbutton $wi.hosts.ssh.v$i \
+ -variable active_ssh($i) -onvalue true -offvalue false
+ # -command {
+ # if { active_ssh(0) } {
+ # eval $wi.hosts.userName.v$i -configure state normal
+ # } else {
+ # eval $wi.hosts.userName.v$i -configure state disabled
+ # }
+ # }
+
+ eval entry $wi.hosts.userName.v$i -bg white -width 5 \
+ -validate focus -invcmd "focusAndFlash"
+ $wi.hosts.userName.v$i insert 0 [lindex $host_elem 5]
incr i
}
}
pack $wi.hosts.labels $wi.hosts.address $wi.hosts.ports \
$wi.hosts.monitors $wi.hosts.active \
- $wi.hosts.ssh $wi.hosts.userName -side left -fill x
+ $wi.hosts.ssh $wi.hosts.userName -side left -fill x
pack $wi.select $wi.hosts -side top -fill x -padx 4
frame $wi.butt -borderwidth 4
"configRemoteHostsApply $wi; destroy $wi"
focus $wi.butt.apply
button $wi.butt.cancel -text "Cancel" -command \
- "set remote_exec $old_remote_exec; destroy $wi"
+ "set remote_exec $old_remote_exec; destroy $wi"
pack $wi.butt.cancel $wi.butt.apply -side right
pack $wi.butt -side bottom
enable_disable $wi
after 100 {
- grab .popup
+ grab .popup
}
;# Apply and Cancel explicitly destroy $wi
vwait forever
[$wi.hosts.ports.v$i get] \
[$wi.hosts.monitors.v$i get]\
$active_host($i) \
- $active_ssh($i)\
- [$wi.hosts.userName.v$i get]]
+ $active_ssh($i)\
+ [$wi.hosts.userName.v$i get]]
lappend exec_hosts $ent
if { $active_host($i) } { set at_least_one_up true }
}
if { $remote_exec && ! $at_least_one_up } {
set editor_only true
- .menubar.experiment entryconfigure "Execute" -state disabled
+ .menubar.experiment entryconfigure "Execute" -state disabled
}
# catch { unset exec_sock monitor_sock } message
# set exec_sockets_opened false
}
if { $editor_only } {
- .menubar.experiment entryconfigure "Execute" -state disabled
+ .menubar.experiment entryconfigure "Execute" -state disabled
} else {
.menubar.experiment entryconfigure "Execute" -state normal
}
eval $wi.hosts.ports.v$i configure -state $state
eval $wi.hosts.monitors.v$i configure -state $state
#eval $wi.hosts.weight.v$i configure -state $state
- eval $wi.hosts.ssh.v$i configure -state $state
- eval $wi.hosts.userName.v$i configure -state $state
- incr i
+ eval $wi.hosts.ssh.v$i configure -state $state
+ eval $wi.hosts.userName.v$i configure -state $state
+ incr i
}
}
projects / imunes.git / commitdiff