-# $Id: editor.tcl,v 1.62.2.1 2007/05/07 08:20:09 ana Exp $
+# $Id: editor.tcl,v 1.62.2.2 2007/07/11 12:11:12 miljenko Exp $
#
# Copyright 2004, 2005 University of Zagreb, Croatia. All rights reserved.
#
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
}
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
}
}
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
}
}
global changed undolog undolevel redolevel
if { $changed } {
- global t_undolog undolog
- set t_undolog ""
- dumpCfg string t_undolog
- incr undolevel
- if { $undolevel == 1 } {
- .menubar.edit entryconfigure "Undo" -state normal
- }
- set undolog($undolevel) $t_undolog
- set redolevel $undolevel
- set changed 0
+ global t_undolog undolog
+ set t_undolog ""
+ dumpCfg string t_undolog
+ incr undolevel
+ if { $undolevel == 1 } {
+ .menubar.edit entryconfigure "Undo" -state normal
+ }
+ set undolog($undolevel) $t_undolog
+ set redolevel $undolevel
+ set changed 0
}
}
global undolevel undolog oper_mode
if {$oper_mode == "edit" && $undolevel > 0} {
- .menubar.edit entryconfigure "Redo" -state normal
- incr undolevel -1
- if { $undolevel == 0 } {
- .menubar.edit entryconfigure "Undo" -state disabled
- }
- .c config -cursor watch
- loadCfg $undolog($undolevel)
- switchCanvas none
+ .menubar.edit entryconfigure "Redo" -state normal
+ incr undolevel -1
+ if { $undolevel == 0 } {
+ .menubar.edit entryconfigure "Undo" -state disabled
+ }
+ .c config -cursor watch
+ loadCfg $undolog($undolevel)
+ switchCanvas none
}
}
global undolevel redolevel undolog oper_mode
if {$oper_mode == "edit" && $redolevel > $undolevel} {
- incr undolevel
- if { $undolevel == 1 } {
- .menubar.edit entryconfigure "Undo" -state normal
- }
- if {$redolevel <= $undolevel} {
- .menubar.edit entryconfigure "Redo" -state disabled
- }
- .c config -cursor watch
- loadCfg $undolog($undolevel)
- switchCanvas none
+ incr undolevel
+ if { $undolevel == 1 } {
+ .menubar.edit entryconfigure "Undo" -state normal
+ }
+ if {$redolevel <= $undolevel} {
+ .menubar.edit entryconfigure "Redo" -state disabled
+ }
+ .c config -cursor watch
+ loadCfg $undolog($undolevel)
+ switchCanvas none
}
}
proc redrawAll {} {
global node_list link_list background sizex sizey grid
global curcanvas zoom
-
+ global showBkgImage showAnnotations showGrid bkgImage
+ global oval_list label_list rectangle_list text_list
.bottom.zoom config -text "zoom [expr {int($zoom * 100)}]%"
set e_sizex [expr {int($sizex * $zoom)}]
set e_sizey [expr {int($sizey * $zoom)}]
set border 28
.c configure -scrollregion \
- "-$border -$border [expr {$e_sizex + $border}] \
- [expr {$e_sizey + $border}]"
+ "-$border -$border [expr {$e_sizex + $border}] \
+ [expr {$e_sizey + $border}]"
.c delete all
- set background [.c create rectangle 0 0 $e_sizex $e_sizey \
- -fill white -tags "background"]
+
+ set canvasBkgImage [getCanvasBkg $curcanvas]
+ if { $showBkgImage == 1 && "$canvasBkgImage" != ""} {
+ set ret [backgroundImage .c $canvasBkgImage]
+ if { "$ret" == 2 } {
+ set background [.c create rectangle 0 0 $e_sizex $e_sizey \
+ -fill white -tags "background"]
+ } else {
+ set background [.c create rectangle 0 0 $e_sizex $e_sizey \
+ -tags "background"]
+ }
+ } else {
+ set background [.c create rectangle 0 0 $e_sizex $e_sizey \
+ -fill white -tags "background"]
+ }
+
+ if { $showAnnotations == 1 } {
+ foreach rect $rectangle_list {
+ if { [getNodeCanvas $rect] == $curcanvas } {
+ drawRect $rect
+ }
+ }
+ foreach oval $oval_list {
+ if { [getNodeCanvas $oval] == $curcanvas } {
+ drawOval $oval
+ }
+ }
+ foreach text $text_list {
+ if { [getNodeCanvas $text] == $curcanvas } {
+ drawText $text
+ }
+ }
+ }
# Grid
set e_grid [expr {int($grid * $zoom)}]
set e_grid2 [expr {$e_grid * 2}]
- if { 1 } {
- for { set x $e_grid } { $x < $e_sizex } { incr x $e_grid } {
- if { [expr {$x % $e_grid2}] != 0 } {
- if { $zoom > 0.5 } {
- .c create line $x 1 $x $e_sizey \
- -fill gray -dash {1 7} -tags "background"
- }
- } else {
- .c create line $x 1 $x $e_sizey -fill gray -dash {1 3} \
- -tags "background"
- }
- }
- for { set y $e_grid } { $y < $e_sizey } { incr y $e_grid } {
- if { [expr {$y % $e_grid2}] != 0 } {
- if { $zoom > 0.5 } {
- .c create line 1 $y $e_sizex $y \
- -fill gray -dash {1 7} -tags "background"
- }
- } else {
- .c create line 1 $y $e_sizex $y -fill gray -dash {1 3} \
- -tags "background"
- }
- }
+ if { $showGrid } {
+ for { set x $e_grid } { $x < $e_sizex } { incr x $e_grid } {
+ if { [expr {$x % $e_grid2}] != 0 } {
+ if { $zoom > 0.5 } {
+ .c create line $x 1 $x $e_sizey \
+ -fill gray -dash {1 7} -tags "grid"
+ }
+ } else {
+ .c create line $x 1 $x $e_sizey -fill gray -dash {1 3} \
+ -tags "grid"
+ }
+ }
+ for { set y $e_grid } { $y < $e_sizey } { incr y $e_grid } {
+ if { [expr {$y % $e_grid2}] != 0 } {
+ if { $zoom > 0.5 } {
+ .c create line 1 $y $e_sizex $y \
+ -fill gray -dash {1 7} -tags "grid"
+ }
+ } else {
+ .c create line 1 $y $e_sizex $y -fill gray -dash {1 3} \
+ -tags "grid"
+ }
+ }
}
.c lower -withtags 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
}
.c config -cursor left_ptr
+ raiseAll .c
}
#****f* editor.tcl/drawNode
set x [expr {[lindex $coords 0] * $zoom}]
set y [expr {[lindex $coords 1] * $zoom}]
if { [nodeType $node] != "pseudo" } {
- set label [.c create text $x $y -fill blue \
+ 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 label [.c create text $x $y -fill blue \
- -text "[getNodeName $pnode]:$ifc" \
- -tags "nodelabel $node" -justify center]
- }
+ 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
+@[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]
+ }
}
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
}
}
set lnode2 [lindex $nodes 1]
set lwidth [getLinkWidth $link]
if { [getLinkMirror $link] != "" } {
- set newlink [.c create line 0 0 0 0 \
- -fill [getLinkColor $link] -width $lwidth \
- -tags "link $link $lnode1 $lnode2" -arrow both]
+ set newlink [.c create line 0 0 0 0 \
+ -fill [getLinkColor $link] -width $lwidth \
+ -tags "link $link $lnode1 $lnode2" -arrow both]
} else {
- set newlink [.c create line 0 0 0 0 \
- -fill [getLinkColor $link] -width $lwidth \
- -tags "link $link $lnode1 $lnode2"]
+ set newlink [.c create line 0 0 0 0 \
+ -fill [getLinkColor $link] -width $lwidth \
+ -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 \
global $lnode1 $lnode2
switch -exact -- [nodeType $lnode1] {
- pc {
- return eth
- }
- host {
- return eth
- }
- hub {
- return e
- }
- lanswitch {
- return e
- }
- frswitch {
- return f
- }
- router {
- return eth
- }
- rj45 {
- return
- }
+ pc {
+ return eth
+ }
+ host {
+ return eth
+ }
+ hub {
+ return e
+ }
+ lanswitch {
+ return e
+ }
+ frswitch {
+ return f
+ }
+ router {
+ 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
if { $zoom > 1.0 } {
- set x 1
- set y 1
- return
+ set x 1
+ set y 1
+ return
}
switch -exact -- [nodeType $lnode] {
- frswitch {
- set x [expr {1.8 / $zoom}]
- set y [expr {1.8 / $zoom}]
- }
- hub {
- set x [expr {1.5 / $zoom}]
- set y [expr {2.6 / $zoom}]
- }
- lanswitch {
- set x [expr {1.5 / $zoom}]
- set y [expr {2.6 / $zoom}]
- }
- router {
- set x [expr {1 / $zoom}]
- set y [expr {2 / $zoom}]
- }
- pc {
- if { $showIfIPaddrs || $showIfIPv6addrs } {
- set x [expr {1.1 / $zoom}]
- } else {
- set x [expr {1.4 / $zoom}]
- }
- set y [expr {1.5 / $zoom}]
- }
- host {
- if { $showIfIPaddrs || $showIfIPv6addrs } {
- set x [expr {1 / $zoom}]
- } else {
- set x [expr {1.5 / $zoom}]
- }
- set y [expr {1.5 / $zoom}]
- }
- rj45 {
- set x [expr {1 / $zoom}]
- set y [expr {1 / $zoom}]
- }
+ frswitch {
+ set x [expr {1.8 / $zoom}]
+ set y [expr {1.8 / $zoom}]
+ }
+ hub {
+ set x [expr {1.5 / $zoom}]
+ set y [expr {2.6 / $zoom}]
+ }
+ lanswitch {
+ set x [expr {1.5 / $zoom}]
+ set y [expr {2.6 / $zoom}]
+ }
+ router {
+ set x [expr {1 / $zoom}]
+ set y [expr {2 / $zoom}]
+ }
+ pc {
+ if { $showIfIPaddrs || $showIfIPv6addrs } {
+ set x [expr {1.1 / $zoom}]
+ } else {
+ set x [expr {1.4 / $zoom}]
+ }
+ set y [expr {1.5 / $zoom}]
+ }
+ host {
+ if { $showIfIPaddrs || $showIfIPv6addrs } {
+ set x [expr {1 / $zoom}]
+ } else {
+ set x [expr {1.5 / $zoom}]
+ }
+ set y [expr {1.5 / $zoom}]
+ }
+ rj45 {
+ set x [expr {1 / $zoom}]
+ set y [expr {1 / $zoom}]
+ }
}
}
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
+"
}
if { $showIfIPaddrs && $ifipv4addr != "" } {
- set labelstr "$labelstr$ifipv4addr\r"
+ set labelstr "$labelstr$ifipv4addr
+"
}
if { $showIfIPv6addrs && $ifipv6addr != "" } {
- set labelstr "$labelstr$ifipv6addr\r"
+ set labelstr "$labelstr$ifipv6addr
+"
}
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"
}
set delstr [getLinkDelayString $link]
set ber [getLinkBER $link]
set dup [getLinkDup $link]
- set labelstr "$labelstr[getLinkBandwidthString $link]\r"
+ set labelstr "$labelstr[getLinkBandwidthString $link]
+"
if { "$delstr" != "" } {
- set labelstr "$labelstr$delstr\r"
+ set labelstr "$labelstr$delstr
+"
}
if { "$ber" != "" } {
- set berstr "ber=$ber"
- set labelstr "$labelstr$berstr\r"
+ set berstr "ber=$ber"
+ set labelstr "$labelstr$berstr
+"
}
if { "$dup" != "" } {
- set dupstr "dup=$dup%"
- set labelstr "$labelstr$dupstr\r"
+ set dupstr "dup=$dup%"
+ set labelstr "$labelstr$dupstr
+"
}
set labelstr \
- [string range $labelstr 0 [expr {[string length $labelstr] - 2}]]
+ [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
}
}
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
}
}
.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
+ set n 1
}
calcDxDy $lnode1
set y2 [lindex [getNodeCoords $orig_node2] 1]
setNodeCoords $new_node1 \
- "[expr {($x1 + 0.4 * ($x2 - $x1)) / $zoom}] \
- [expr {($y1 + 0.4 * ($y2 - $y1)) / $zoom}]"
+ "[expr {($x1 + 0.4 * ($x2 - $x1)) / $zoom}] \
+ [expr {($y1 + 0.4 * ($y2 - $y1)) / $zoom}]"
setNodeCoords $new_node2 \
- "[expr {($x1 + 0.6 * ($x2 - $x1)) / $zoom}] \
- [expr {($y1 + 0.6 * ($y2 - $y1)) / $zoom}]"
+ "[expr {($x1 + 0.6 * ($x2 - $x1)) / $zoom}] \
+ [expr {($y1 + 0.6 * ($y2 - $y1)) / $zoom}]"
setNodeLabelCoords $new_node1 [getNodeCoords $new_node1]
setNodeLabelCoords $new_node2 [getNodeCoords $new_node2]
#****
proc selectNode { c obj } {
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"]
+ } elseif { [nodeType $node] == "rectangle" } {
+ $c addtag selected withtag "rectangle && $node"
+ set bbox [$c bbox "rectangle && $node"]
+ } elseif { [nodeType $node] == "text" } {
+ $c addtag selected withtag "text && $node"
+ set bbox [$c bbox "text && $node"]
+ } elseif { [nodeType $node] == "oval" } {
+ $c addtag selected withtag "oval && $node"
+ set bbox [$c bbox "oval && $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"
}
proc selectNodes { nodelist } {
foreach node $nodelist {
- selectNode .c [.c find withtag "node && $node"]
+ selectNode .c [.c find withtag "node && $node"]
}
}
proc selectedNodes {} {
set selected {}
foreach obj [.c find withtag "node && selected"] {
- lappend selected [lindex [.c gettags $obj] 1]
+ lappend selected [lindex [.c gettags $obj] 1]
+ }
+ foreach obj [.c find withtag "oval && selected"] {
+ lappend selected [lindex [.c gettags $obj] 1]
+ }
+ foreach obj [.c find withtag "rectangle && selected"] {
+ lappend selected [lindex [.c gettags $obj] 1]
+ }
+ foreach obj [.c find withtag "text && selected"] {
+ lappend selected [lindex [.c gettags $obj] 1]
}
return $selected
}
proc selectedRealNodes {} {
set selected {}
foreach obj [.c find withtag "node && selected"] {
- set node [lindex [.c gettags $obj] 1]
- if { [getNodeMirror $node] != "" ||
- [nodeType $node] == "rj45" } {
- continue
- }
- lappend selected $node
+ set node [lindex [.c gettags $obj] 1]
+ if { [getNodeMirror $node] != "" ||
+ [nodeType $node] == "rj45" } {
+ continue
+ }
+ lappend selected $node
}
return $selected
}
set selected [selectedNodes]
set adjacent {}
foreach node $selected {
- foreach ifc [ifcList $node] {
- set peer [peerByIfc $node $ifc]
- if { [getNodeMirror $peer] != "" } {
- return
- }
- if { [lsearch $adjacent $peer] < 0 } {
- lappend adjacent $peer
- }
- }
+ foreach ifc [ifcList $node] {
+ set peer [peerByIfc $node $ifc]
+ if { [getNodeMirror $peer] != "" } {
+ return
+ }
+ if { [lsearch $adjacent $peer] < 0 } {
+ lappend adjacent $peer
+ }
+ }
}
selectNodes $adjacent
}
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 [selectedNodes]
foreach node $selected_nodes {
- setNodeCanvas $node $canvas
- set changed 1
+ 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
# Select adjacent
#
if { [nodeType $node] != "pseudo" } {
- .button3menu add command -label "Select adjacent" \
- -command "selectAdjacent"
+ .button3menu add command -label "Select adjacent" \
+ -command "selectAdjacent"
} else {
- .button3menu add command -label "Select adjacent" \
- -command "selectAdjacent" -state disabled
+ .button3menu add command -label "Select adjacent" \
+ -command "selectAdjacent" -state disabled
}
#
# 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
}
destroy .button3menu.connect.selected
menu .button3menu.connect.selected -tearoff 0
.button3menu.connect add cascade -label "Selected" \
- -menu .button3menu.connect.selected
+ -menu .button3menu.connect.selected
.button3menu.connect.selected add command \
- -label "Chain" -command "P \[selectedRealNodes\]"
+ -label "Chain" -command "P \[selectedRealNodes\]"
.button3menu.connect.selected add command \
- -label "Star" \
- -command "Kb \[lindex \[selectedRealNodes\] 0\] \
- \[lrange \[selectedNodes\] 1 end\]"
+ -label "Star" \
+ -command "Kb \[lindex \[selectedRealNodes\] 0\] \
+ \[lrange \[selectedNodes\] 1 end\]"
.button3menu.connect.selected add command \
- -label "Cycle" -command "C \[selectedRealNodes\]"
+ -label "Cycle" -command "C \[selectedRealNodes\]"
.button3menu.connect.selected add command \
- -label "Clique" -command "K \[selectedRealNodes\]"
+ -label "Clique" -command "K \[selectedRealNodes\]"
.button3menu.connect add separator
foreach canvas $canvas_list {
- destroy .button3menu.connect.$canvas
- menu .button3menu.connect.$canvas -tearoff 0
- .button3menu.connect add cascade -label [getCanvasName $canvas] \
- -menu .button3menu.connect.$canvas
+ destroy .button3menu.connect.$canvas
+ menu .button3menu.connect.$canvas -tearoff 0
+ .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 &
+ exec cmd /c nc $exec_host 1234 &
}
} else {
- nexec xterm -sb -rightbar \
- -T "IMUNES: [getNodeName $node] (console)" \
- -e "vimage $node_id $cmd" &
+ nexec xterm -sb -rightbar \
+ -T "IMUNES: [getNodeName $node] (console)" \
+ -e "vimage $node_id $cmd" &
}
}
global node_list curcanvas zoom
global activetool newlink curobj changed def_router_model
global router pc host lanswitch frswitch rj45 hub
+ global oval rectangle text
global lastX lastY
global background selectbox
global defLinkColor defLinkWidth
+ global resizemode resizeobj
set x [$c canvasx $x]
set y [$c canvasy $y]
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
- }
+ if { $curtype == "node" ||
+ $curtype == "oval" || $curtype == "rectangle" || $curtype == "text"
+ || ( $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
+ }
+ } elseif { $curtype == "selectmark" } {
+
+ set t1 [$c gettags current]
+ set o1 [lindex $t1 1]
+ set type1 [nodeType $o1]
+
+ if {$type1== "oval" || $type1== "rectangle"} {
+ set resizeobj $o1
+ set bbox1 [$c bbox $o1]
+ set x1 [lindex $bbox1 0]
+ set y1 [lindex $bbox1 1]
+ set x2 [lindex $bbox1 2]
+ set y2 [lindex $bbox1 3]
+ set l 0 ;# left
+ set r 0 ;# right
+ set u 0 ;# up
+ set d 0 ;# down
+
+ if { $x < [expr $x1+($x2-$x1)/8.0]} { set l 1 }
+ if { $x > [expr $x2-($x2-$x1)/8.0]} { set r 1 }
+ if { $y < [expr $y1+($y2-$y1)/8.0]} { set u 1 }
+ if { $y > [expr $y2-($y2-$y1)/8.0]} { set d 1 }
+
+ if {$l==1} {
+ if {$u==1} {
+ set resizemode lu
+ } elseif {$d==1} {
+ set resizemode ld
+ } else {
+ set resizemode l
+ }
+ } elseif {$r==1} {
+ if {$u==1} {
+ set resizemode ru
+ } elseif {$d==1} {
+ set resizemode rd
+ } else {
+ set resizemode r
+ }
+ } elseif {$u==1} {
+ set resizemode u
+ } elseif {$d==1} {
+ set resizemode d
+ } else {
+ set resizemode false
+ }
+ }
+
} elseif { $button != "ctrl" || $activetool != "select" } {
- $c dtag node selected
- $c delete -withtags selectmark
- }
- if { [lsearch [.c gettags $curobj] background] != -1 } {
- if { [lsearch {select link} $activetool] < 0 } {
- set node [newNode $activetool]
- setNodeCanvas $node $curcanvas
- setNodeCoords $node "[expr {$x / $zoom}] [expr {$y / $zoom}]"
- set dy 32
- if { [lsearch {router hub lanswitch rj45} $activetool] >= 0 } {
- set dy 24
- }
- setNodeLabelCoords $node "[expr {$x / $zoom}] \
- [expr {$y / $zoom + $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 ""
- }
- }
+ $c dtag node selected
+ $c delete -withtags selectmark
+ }
+ if { [lsearch [.c gettags $curobj] background] != -1 ||
+ [lsearch [.c gettags $curobj] grid] != -1 } {
+ if { [lsearch {select link oval rectangle text} $activetool] < 0 } {
+ set node [newNode $activetool]
+ setNodeCanvas $node $curcanvas
+ setNodeCoords $node "[expr {$x / $zoom}] [expr {$y / $zoom}]"
+ set dy 32
+ if { [lsearch {router hub lanswitch rj45} $activetool] >= 0 } {
+ set dy 24
+ }
+ setNodeLabelCoords $node "[expr {$x / $zoom}] \
+ [expr {$y / $zoom + $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 ""
+ }
+ } elseif { $activetool == "oval" || $activetool == "rectangle" } {
+ $c config -cursor cross
+ set lastX $x
+ set lastY $y
+ } elseif { $activetool == "text" } {
+ $c config -cursor xterm
+ set lastX $x
+ set lastY $y
+ }
} 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"]
- }
- }
- $c raise link background
- $c raise linklabel "link || background"
- $c raise interface "linklabel || link || background"
- $c raise node "interface || linklabel || link || background"
- $c raise nodelabel "node || interface || linklabel || link || background"
+ 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"]
+ }
+ }
+
+ raiseAll $c
}
proc button1-motion { c x y } {
global activetool newlink changed
global lastX lastY sizex sizey selectbox background
-
+ global oper_mode newoval newrect resizemode
set x [$c canvasx $x]
set y [$c canvasy $y]
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 || $curtype == "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
- }
+ ( $curobj == $selectbox || $curtype == "background" || $curtype == "grid")} {
+ 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 == "text" } {
+ $c move $curobj [expr {$x - $lastX}] [expr {$y - $lastY}]
+ set changed 1
+ set lastX $x
+ set lastY $y
+ $c delete [$c find withtag "selectmark"]
} elseif { $activetool == "select" && $curtype == "nodelabel" \
- && [nodeType [lindex [$c gettags $curobj] 1]] != "pseudo" } {
+ && [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
+ # actually we should check if curobj==bkgImage
+ } elseif { $activetool == "oval" && \
+ ( $curobj == $newoval || $curobj == $background || $curtype == "background" || $curtype == "grid")} {
+ # Draw a new oval
+ if {$newoval == ""} {
+ set newoval [$c create oval $lastX $lastY $x $y \
+ -dash {10 4} -width 1 -tags "newoval"]
+ $c raise $newoval "background || link || linklabel || interface"
+ } else {
+ $c coords $newoval \
+ $lastX $lastY $x $y
+ }
+ # actually we should check if curobj==bkgImage
+ } elseif { $activetool == "rectangle" && \
+ ( $curobj == $newrect || $curobj == $background || $curtype == "background") || $curtype == "grid"} {
+ # Draw a new rectangle
+ if {$newrect == ""} {
+ set newrect [$c create rectangle $lastX $lastY $x $y \
+ -outline blue \
+ -dash {10 4} -width 1 -tags "newrect"]
+ $c raise $newrect "oval || background || link || linklabel || interface"
+ } else {
+ $c coords $newrect $lastX $lastY $x $y
+ }
+ } elseif { $curtype == "selectmark" } {
+ foreach o [$c find withtag "selected"] {
+ set node [lindex [$c gettags $o] 1]
+ set tagovi [$c gettags $o]
+ set koord [getNodeCoords $node]
+
+ set oldX1 [lindex $koord 0]
+ set oldY1 [lindex $koord 1]
+ set oldX2 [lindex $koord 2]
+ set oldY2 [lindex $koord 3]
+ switch -exact -- $resizemode {
+ lu {
+ set oldX1 $x
+ set oldY1 $y
+ }
+ ld {
+ set oldX1 $x
+ set oldY2 $y
+ }
+ l {
+ set oldX1 $x
+ }
+ ru {
+ set oldX2 $x
+ set oldY1 $y
+ }
+ rd {
+ set oldX2 $x
+ set oldY2 $y
+ }
+ r {
+ set oldX2 $x
+ }
+ u {
+ set oldY1 $y
+ }
+ d {
+ set oldY2 $y
+ }
+ }
+ if {$selectbox == ""} {
+ set selectbox [$c create line \
+ $oldX1 $oldY1 $oldX2 $oldY1 $oldX2 $oldY2 $oldX1 $oldY2 $oldX1 $oldY1 \
+ -dash {10 4} -fill black -width 1 -tags "selectbox"]
+ $c raise $selectbox "background || link || linklabel || interface"
+ } else {
+ $c coords $selectbox \
+ $oldX1 $oldY1 $oldX2 $oldY1 $oldX2 $oldY2 $oldX1 $oldY2 $oldX1 $oldY1
+ }
+ }
} else {
- 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}]
- 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
+ foreach img [$c find withtag "selected"] {
+ set node [lindex [$c gettags $img] 1]
+ set img [$c find withtag "selectmark && $node"]
+ if {$curtype == "oval" || $curtype == "rectangle"} {
+ $c move $img [expr {($x - $lastX) / 2}] [expr {($y - $lastY) / 2}]
+ } else {
+ $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
}
}
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
global changed undolog undolevel redolevel selectbox
global lastX lastY sizex sizey zoom
global autorearrange_enabled
+ global resizemode resizeobj
+ set redrawNeeded 0
set x [$c canvasx $x]
set y [$c canvasy $y]
$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
+ }
+ }
+ }
+ } elseif {$activetool == "rectangle" } {
+ popupRectDialog $c 0 "false" "" "" ""
+ } elseif {$activetool == "oval" } {
+ popupOvalDialog $c 0 "false" "" "" ""
+ } elseif {$activetool == "text" } {
+ textEnter $c $x $y
}
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 [expr {[lindex $coords 0] / $zoom}]
- set y [expr {[lindex $coords 1] / $zoom}]
- if { $autorearrange_enabled == 0} {
- set dx [expr {(int($x / $grid + 0.5) * $grid - $x) * $zoom}]
- set dy [expr {(int($y / $grid + 0.5) * $grid - $y) * $zoom}]
- $c move $img $dx $dy
- set coords [$c coords $img]
- set x [expr {[lindex $coords 0] / $zoom}]
- set y [expr {[lindex $coords 1] / $zoom}]
- } else {
- set dx 0
- set dy 0
- }
- 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 [expr {[lindex $coords 0] / $zoom}]
- set y [expr {[lindex $coords 1] / $zoom}]
- 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 {
- .c config -cursor watch
- loadCfg $undolog($undolevel)
- redrawAll
- if {$activetool == "select" } {
- selectNodes $selected
- }
- 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
- }
- }
- $c raise link background
- $c raise linklabel "link || background"
- $c raise interface "linklabel || link || background"
- $c raise node "interface || linklabel || link || background"
- $c raise nodelabel "node || interface || linklabel || link || background"
+ 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 [expr {[lindex $coords 0] / $zoom}]
+ set y [expr {[lindex $coords 1] / $zoom}]
+ if { $autorearrange_enabled == 0} {
+ set dx [expr {(int($x / $grid + 0.5) * $grid - $x) * $zoom}]
+ set dy [expr {(int($y / $grid + 0.5) * $grid - $y) * $zoom}]
+ $c move $img $dx $dy
+ set coords [$c coords $img]
+ set x [expr {[lindex $coords 0] / $zoom}]
+ set y [expr {[lindex $coords 1] / $zoom}]
+ } else {
+ set dx 0
+ set dy 0
+ }
+ setNodeCoords $node "$x $y"
+ if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} {
+ set regular false
+ }
+ if { [lindex [$c gettags $node] 0] == "oval" ||
+ [lindex [$c gettags $node] 0] == "rectangle" } {
+ set bbox [$c bbox "selectmark && $node"]
+ setNodeCoords $node "$bbox"
+ set redrawNeeded 1
+ }
+ if {[$c find withtag "nodelabel && $node"] != "" } {
+ $c move "nodelabel && $node" $dx $dy
+ set coords [$c coords "nodelabel && $node"]
+ set x [expr {[lindex $coords 0] / $zoom}]
+ set y [expr {[lindex $coords 1] / $zoom}]
+ 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"
+ set changed 1
+ } ;# end of: foreach img selected
+ if {$regular == "true"} {
+ foreach link [$c find withtag "link && need_redraw"] {
+ redrawLink [lindex [$c gettags $link] 1]
+ }
+ } else {
+ .c config -cursor watch
+ loadCfg $undolog($undolevel)
+ redrawAll
+ if {$activetool == "select" } {
+ selectNodes $selected
+ }
+ set changed 0
+ }
+ $c dtag link need_redraw
+
+ # $changed!=1
+ } 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 ""
+ }
+
+ if { $resizemode == "false" } {
+ 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
+ }
+ if {[lindex $tags 0] == "oval" && [lsearch $tags selected] == -1} {
+ lappend enclosed $obj
+ }
+ if {[lindex $tags 0] == "rectangle" && [lsearch $tags selected] == -1} {
+ lappend enclosed $obj
+ }
+ if {[lindex $tags 0] == "text" && [lsearch $tags selected] == -1} {
+ lappend enclosed $obj
+ }
+ }
+ foreach obj $enclosed {
+ selectNode $c $obj
+ }
+ } else {
+ setNodeCoords $resizeobj "$x $y $x1 $y1"
+ set redrawNeeded 1
+ set resizemode false
+ }
+ }
+
+ if { $redrawNeeded } {
+ set redrawNeeded 0
+ redrawAll
+ } else {
+ raiseAll $c
+ }
update
updateUndoLog
}
+proc raiseAll { c } {
+ $c raise rectangle background
+ $c raise oval "rectangle || background"
+ $c raise grid "oval || rectangle || background"
+ $c raise link "grid || oval || rectangle || background"
+ $c raise linklabel "link || grid || oval || rectangle || background"
+ $c raise interface "linklabel || link || grid || oval || rectangle || background"
+ $c raise node "interface || linklabel || link || grid || oval || rectangle || background"
+ $c raise nodelabel "node || interface || linklabel || link || grid || oval || rectangle || background"
+ $c raise menuBubble "nodelabel || node || interface || linklabel || link || grid || oval || rectangle || background"
+ $c raise text "menuBubble || nodelabel || node || interface || linklabel || link || grid || oval || rectangle || background"
+}
#****f* editor.tcl/nodeEnter
# NAME
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"
}
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}]]
}
}
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 { [lsearch {oval} $tk_type] > -1 } {
+ set object_type oval
+ }
+ if { [lsearch {rectangle} $tk_type] > -1 } {
+ set object_type rectangle
+ }
+ if { [lsearch {text} $tk_type] > -1 } {
+ set object_type text
}
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
node {
set type [nodeType $target]
if { $type == "pseudo" } {
- #
- # Hyperlink to another canvas
- #
- destroy $wi
- set curcanvas [getNodeCanvas [getNodeMirror $target]]
- switchCanvas none
- return
+ #
+ # 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:"
+ label $wi.ftop.name_label -text "Physical interface:"
} else {
- label $wi.ftop.name_label -text "Node name:"
+ label $wi.ftop.name_label -text "Node name:"
}
entry $wi.ftop.name -bg white -width 16 \
- -validate focus -invcmd "focusAndFlash %W"
+ -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
+ 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
- }
+ 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
+ #
+ # 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
+"
+ }
+ 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 0"
- button $wi.custom.cfg.clear -text "Clear" \
- -command "setCustomConfig $target {} {} {} 0"
- 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
- global showIPsecConfig
- if { $showIPsecConfig == 1 } {
- 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
+ #
+ # 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 0"
+ button $wi.custom.cfg.clear -text "Clear" \
+ -command "setCustomConfig $target {} {} {} 0"
+ 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
+ global showIPsecConfig
+ if { $showIPsecConfig == 1 } {
+ 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
}
}
+ oval {
+ destroy $wi
+ annotationConfig $c $target
+ return
+ }
+ rectangle {
+ destroy $wi
+ annotationConfig $c $target
+ return
+ }
+ text {
+ destroy $wi
+ textConfig $c $target
+ return
+ }
link {
wm title $wi "link configuration"
frame $wi.ftop -borderwidth 6
frame $wi.color -borderwidth 4
label $wi.color.label -anchor e -text "Color:"
set link_color [getLinkColor $target]
- tk_optionMenu $wi.color.value link_color \
- Red Green Blue Yellow Magenta Cyan Black
+ tk_optionMenu $wi.color.value link_color \
+ Red Green Blue Yellow Magenta Cyan Black
pack $wi.color.value $wi.color.label -side right
pack $wi.color -side top -anchor e
"set badentry -1 ; destroy $wi"
pack $wi.butt.cancel $wi.butt.apply -side right
pack $wi.butt -side bottom
+ bind $wi <Key-Escape> "set badentry -1; destroy $wi"
+ bind $wi <Key-Return> "popupConfigApply $wi $object_type $target 0"
after 100 {
- grab .popup
+ grab .popup
}
}
# * node_id -- node id
#****
proc cfgGenerate { node } {
- set id "generic"
+ set id "generic"
set cmd [[typemodel $node].bootcmd $node]
set cfg [[typemodel $node].cfggen $node]
setCustomConfig $node $id $cmd $cfg 0
# INPUTS
# * node_id -- node id
# * deleted -- if deleted is set to 1, editStartupCfg
-# has been invoked after deleting custom-config
-# with specified custom-config-id.
+# has been invoked after deleting custom-config
+# with specified custom-config-id.
#****
proc editStartupCfg { node deleted } {
global viewcustomid
set customCfgList [getCustomConfig $node]
set customidlist {}
foreach customCfg $customCfgList {
- set customid [lindex [lsearch -inline $customCfg \
- "custom-config-id *"] 1]
- lappend customidlist $customid
+ set customid [lindex [lsearch -inline $customCfg \
+ "custom-config-id *"] 1]
+ lappend customidlist $customid
}
set edit 1
}
if { $customidlist == "" } {
- set warning "Custom config list is empty."
- tk_messageBox -message $warning -type ok -icon warning \
- -title "Custom configuration warning"
+ set warning "Custom config list is empty."
+ tk_messageBox -message $warning -type ok -icon warning \
+ -title "Custom configuration warning"
} else {
- set w .cfgeditor
- catch {destroy $w}
- toplevel $w -takefocus 1
- grab $w
- wm title $w "Custom config $node"
- wm iconname $w "$node"
- labelframe $w.custom -padx 4 -pady 4
- if { $edit == "1" } {
- frame $w.custom.viewid -borderwidth 4
- label $w.custom.viewid.label -text "View custom-config:"
- pack $w.custom.viewid.label -side left -anchor w
- eval {tk_optionMenu $w.custom.viewid.optmenu viewcustomid} \
- $customidlist
- pack $w.custom.viewid.label $w.custom.viewid.optmenu \
- -side left -anchor w
- pack $w.custom.viewid -side top -anchor w
- button $w.custom.viewid.button -text View \
- -command "editStartupCfg $node 0"
- pack $w.custom.viewid.button -side right
-
- foreach element $customCfgList {
- set cid \
- [lindex [lsearch -inline $element "custom-config-id *"] 1]
- if { $viewcustomid == $cid } {
- set customCfg $element
- }
- }
- }
-
- frame $w.custom.id -borderwidth 4
- label $w.custom.id.label -text "Custom config id:"
- entry $w.custom.id.text -bg white -width 30
- if { $customCfg != {} } {
- set ccfg [getConfig $customCfg "custom-config-id"]
- } else {
- set ccfg ""
- }
- $w.custom.id.text insert 0 $ccfg
- pack $w.custom.id.text $w.custom.id.label -side right -padx 4 -pady 4
- pack $w.custom.id -side top -anchor w
- pack $w.custom -side top -anchor w -fill both
-
- frame $w.ftop -borderwidth 4
- label $w.ftop.label -text "Startup command:"
- entry $w.ftop.cmd -bg white -width 64
- if { $customCfg != {} } {
- set ccmd [getConfig $customCfg "custom-command"]
- } else {
- set ccmd ""
- }
- $w.ftop.cmd insert 0 $ccmd
- pack $w.ftop.cmd $w.ftop.label -side right -padx 4 -pady 4
- pack $w.ftop -side top -anchor w
-
- text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \
- -setgrid 1 -height 20 -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.close -text Close -command "destroy $w"
- button $w.buttons.delete -text Delete -command \
- "deleteCustomConfig $w $node $viewcustomid {} {} 1"
- pack $w.buttons.apply $w.buttons.close $w.buttons.delete -side left
-
- pack $w.scroll -side right -fill y
- pack $w.text -expand yes -fill both
-
- if { $customCfg != {} } {
- set ccfg [getConfig $customCfg "config"]
- } else {
- set ccfg ""
- }
-
- foreach line $ccfg {
- $w.text insert end "$line\n"
- }
- $w.text mark set insert 0.0
+ set w .cfgeditor
+ catch {destroy $w}
+ toplevel $w -takefocus 1
+ grab $w
+ wm title $w "Custom config $node"
+ wm iconname $w "$node"
+ labelframe $w.custom -padx 4 -pady 4
+ if { $edit == "1" } {
+ frame $w.custom.viewid -borderwidth 4
+ label $w.custom.viewid.label -text "View custom-config:"
+ pack $w.custom.viewid.label -side left -anchor w
+ eval {tk_optionMenu $w.custom.viewid.optmenu viewcustomid} \
+ $customidlist
+ pack $w.custom.viewid.label $w.custom.viewid.optmenu \
+ -side left -anchor w
+ pack $w.custom.viewid -side top -anchor w
+ button $w.custom.viewid.button -text View \
+ -command "editStartupCfg $node 0"
+ pack $w.custom.viewid.button -side right
+
+ foreach element $customCfgList {
+ set cid \
+ [lindex [lsearch -inline $element "custom-config-id *"] 1]
+ if { $viewcustomid == $cid } {
+ set customCfg $element
+ }
+ }
+ }
+
+ frame $w.custom.id -borderwidth 4
+ label $w.custom.id.label -text "Custom config id:"
+ entry $w.custom.id.text -bg white -width 30
+ if { $customCfg != {} } {
+ set ccfg [getConfig $customCfg "custom-config-id"]
+ } else {
+ set ccfg ""
+ }
+ $w.custom.id.text insert 0 $ccfg
+ pack $w.custom.id.text $w.custom.id.label -side right -padx 4 -pady 4
+ pack $w.custom.id -side top -anchor w
+ pack $w.custom -side top -anchor w -fill both
+
+ frame $w.ftop -borderwidth 4
+ label $w.ftop.label -text "Startup command:"
+ entry $w.ftop.cmd -bg white -width 64
+ if { $customCfg != {} } {
+ set ccmd [getConfig $customCfg "custom-command"]
+ } else {
+ set ccmd ""
+ }
+ $w.ftop.cmd insert 0 $ccmd
+ pack $w.ftop.cmd $w.ftop.label -side right -padx 4 -pady 4
+ pack $w.ftop -side top -anchor w
+
+ text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \
+ -setgrid 1 -height 20 -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.close -text Close -command "destroy $w"
+ button $w.buttons.delete -text Delete -command \
+ "deleteCustomConfig $w $node $viewcustomid {} {} 1"
+ pack $w.buttons.apply $w.buttons.close $w.buttons.delete -side left
+
+ pack $w.scroll -side right -fill y
+ pack $w.text -expand yes -fill both
+
+ if { $customCfg != {} } {
+ set ccfg [getConfig $customCfg "config"]
+ } else {
+ set ccfg ""
+ }
+
+ foreach line $ccfg {
+ $w.text insert end "$line\n"
+ }
+ $w.text mark set insert 0.0
}
}
set newid [$w.custom.id.text get]
set newconf [split [$w.text get 0.0 end] "\n"]
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
}
setCustomConfig $node $newid $newcmd $newconf 0
destroy $w
global customEnabled ipsecEnabled
global eid
global showIPsecConfig
-
+
$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 {
#
set model [getNodeModel $target]
set name [string trim [$wi.ftop.name get]]
if { $name != [getNodeName $target] } {
- setNodeName $target $name
- set changed 1
+ setNodeName $target $name
+ set changed 1
}
if { $oper_mode == "edit" && $type == "router" && \
- $router_model != $model } {
- setNodeModel $target $router_model
- set changed 1
+ $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 { [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] {
+ foreach ifc [ifcList $target] {
#
# Operational state
#
set changed 1
}
- if { $showIPsecConfig == 0 } {
- set ipsecEnabled 0
- }
+ if { $showIPsecConfig == 0 } {
+ set ipsecEnabled 0
+ }
set oldipsecenabled [getIpsecEnabled $target]
if {$oldipsecenabled != $ipsecEnabled} {
setIpsecEnabled $target $ipsecEnabled
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
+ 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
+ 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
+ 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
+ setLinkDup $target [$wi.dup.value get]
+ if { $mirror != "" } {
+ setLinkDup $mirror [$wi.dup.value get]
+ }
+ set changed 1
}
if { $link_color != [getLinkColor $target] } {
- setLinkColor $target $link_color
- if { $mirror != "" } {
- setLinkColor $mirror $link_color
- }
- set changed 1
+ setLinkColor $target $link_color
+ if { $mirror != "" } {
+ setLinkColor $mirror $link_color
+ }
+ set changed 1
}
set width [$wi.width.value get]
if { $width != [getLinkWidth $target] } {
- setLinkWidth $target [$wi.width.value get]
- if { $mirror != "" } {
- setLinkWidth $mirror [$wi.width.value get]
- }
- set changed 1
+ setLinkWidth $target [$wi.width.value get]
+ if { $mirror != "" } {
+ setLinkWidth $mirror [$wi.width.value get]
+ }
+ set changed 1
+ }
+ if { $changed == 1 && $oper_mode == "exec" } {
+ execSetLinkParams $eid $target
}
- if { $changed == 1 && $oper_mode == "exec" } {
- execSetLinkParams $eid $target
- }
}
}
if { $changed == 1 } {
- redrawAll
+ redrawAll
updateUndoLog
}
destroy $wi
.c config -cursor watch; update
foreach lnode [selectedNodes] {
- if { $lnode != "" } {
- removeGUINode $lnode
- }
- set changed 1
+ if { $lnode != "" } {
+ removeGUINode $lnode
+ }
+ set changed 1
}
- .c raise link background
- .c raise linklabel "link || background"
- .c raise interface "linklabel || link || background"
- .c raise node "interface || linklabel || link || background"
- .c raise nodelabel "node || interface || linklabel || link || background"
+ raiseAll .c
updateUndoLog
.c config -cursor left_ptr
.bottom.textbox config -text ""
set node_objects [.c find withtag node]
if { [llength $node_objects] == 0 } {
- return
+ return
}
set step [expr {$grid * 4}]
for { set x $step } { $x <= [expr {$sizex - $step}] } { incr x $step } {
- for { set y $step } { $y <= [expr {$sizey - $step}] } { incr y $step } {
- if { [llength $node_objects] == 0 } {
- set changed 1
- updateUndoLog
- redrawAll
- return
- }
- set node [lindex [.c gettags [lindex $node_objects 0]] 1]
- set node_objects [lreplace $node_objects 0 0]
- setNodeCoords $node "$x $y"
- set dy 32
- if { [lsearch {router hub lanswitch rj45} \
- [nodeType $node]] >= 0 } {
- set dy 24
- }
- setNodeLabelCoords $node "$x [expr {$y + $dy}]"
- }
+ for { set y $step } { $y <= [expr {$sizey - $step}] } { incr y $step } {
+ if { [llength $node_objects] == 0 } {
+ set changed 1
+ updateUndoLog
+ redrawAll
+ return
+ }
+ set node [lindex [.c gettags [lindex $node_objects 0]] 1]
+ set node_objects [lreplace $node_objects 0 0]
+ setNodeCoords $node "$x $y"
+ set dy 32
+ if { [lsearch {router hub lanswitch rj45} \
+ [nodeType $node]] >= 0 } {
+ set dy 24
+ }
+ setNodeLabelCoords $node "$x [expr {$y + $dy}]"
+ }
}
}
.menubar.tools entryconfigure "Auto 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 node [lindex [.c gettags $obj] 1]
- set coords [.c coords $obj]
- set x [expr {[lindex $coords 0] / $zoom}]
- set y [expr {[lindex $coords 1] / $zoom}]
- 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 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"
- set e_dx [expr {$dx * $zoom}]
- set e_dy [expr {$dy * $zoom}]
- .c move $obj $e_dx $e_dy
- set img [.c find withtag "selectmark && $node"]
- .c move $img $e_dx $e_dy
- set img [.c find withtag "nodelabel && $node"]
- .c move $img $e_dx $e_dy
- set x [expr {[lindex [.c coords $img] 0] / $zoom}]
- set y [expr {[lindex [.c coords $img] 1] / $zoom}]
- setNodeLabelCoords $node "$x $y"
- .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
+ 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 [expr {[lindex $coords 0] / $zoom}]
+ set y [expr {[lindex $coords 1] / $zoom}]
+ 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 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"
+ set e_dx [expr {$dx * $zoom}]
+ set e_dy [expr {$dy * $zoom}]
+ .c move $obj $e_dx $e_dy
+ set img [.c find withtag "selectmark && $node"]
+ .c move $img $e_dx $e_dy
+ set img [.c find withtag "nodelabel && $node"]
+ .c move $img $e_dx $e_dy
+ set x [expr {[lindex [.c coords $img] 0] / $zoom}]
+ set y [expr {[lindex [.c coords $img] 1] / $zoom}]
+ setNodeLabelCoords $node "$x $y"
+ .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 "Auto rearrange all" -state normal
.menubar.tools entryconfigure "Auto rearrange selected" -state normal
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}]
}
set sizex [lindex [getCanvasSize $curcanvas] 0]
set w .entry1
catch {destroy $w}
toplevel $w -takefocus 1
- update
- grab $w
+
+ if { $x == 0 && $y == 0 } {
+ set screen [wm maxsize .]
+ set x [expr {[lindex $screen 0] / 2}]
+ set y [expr {[lindex $screen 1] / 2}]
+ } else {
+ set x [expr {$x + 10}]
+ set y [expr {$y - 90}]
+ }
+ wm geometry $w +$x+$y
wm title $w "Canvas rename"
wm iconname $w "Canvas rename"
+ update
+ grab $w
label $w.msg -wraplength 5i -justify left -text "Canvas name:"
pack $w.msg -side top
button $w.buttons.cancel -text "Cancel" -command "destroy $w"
pack $w.buttons.print $w.buttons.cancel -side left -expand 1
+ bind $w <Key-Escape> "destroy $w"
+ bind $w <Key-Return> "renameCanvasApply $w"
+
entry $w.e1 -bg white
$w.e1 insert 0 [getCanvasName $curcanvas]
pack $w.e1 -side top -pady 5 -padx 10 -fill x
button $w.buttons.print -text "Apply" -command "resizeCanvasApply $w"
button $w.buttons.cancel -text "Cancel" -command "destroy $w"
pack $w.buttons.print $w.buttons.cancel -side left -expand 1
+ bind $w <Key-Escape> "destroy $w"
+ bind $w <Key-Return> "resizeCanvasApply $w"
frame $w.size
pack $w.size -side top -fill x -pady 2m
spinbox $w.size.x -bg white -width 4 \
- -validate focus -invcmd "focusAndFlash %W"
+ -validate focus -invcmd "focusAndFlash %W"
$w.size.x insert 0 [lindex [getCanvasSize $curcanvas] 0]
$w.size.x configure -from 800 -to 4096 -increment 2 \
- -vcmd {checkIntRange %P 800 4096}
+ -vcmd {checkIntRange %P 800 4096}
label $w.size.label -text "*"
spinbox $w.size.y -bg white -width 4 \
- -validate focus -invcmd "focusAndFlash %W"
+ -validate focus -invcmd "focusAndFlash %W"
$w.size.y insert 0 [lindex [getCanvasSize $curcanvas] 1]
$w.size.y configure -from 600 -to 4096 -increment 2 \
- -vcmd {checkIntRange %P 600 4096}
+ -vcmd {checkIntRange %P 600 4096}
pack $w.size.x $w.size.label $w.size.y -side left -pady 5 -padx 2 -fill x
}
set newname [$w.e1 get]
destroy $w
if { $newname != [getCanvasName $curcanvas] } {
- set changed 1
+ set changed 1
}
setCanvasName $curcanvas $newname
switchCanvas none
set y [$w.size.y get]
destroy $w
if { "$x $y" != [getCanvasSize $curcanvas] } {
- set changed 1
+ set changed 1
}
setCanvasSize $curcanvas $x $y
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
}
}
enable_disable $wi
after 100 {
- grab .popup
+ grab .popup
}
;# Apply and Cancel explicitly destroy $wi
vwait forever
global zoom
set stops ".25 .5 .75 1.0 1.5 2.0 4.0"
- set i [lsearch $stops $zoom]
+ # set i [lsearch $stops $zoom]
+ set minzoom [lindex $stops 0]
+ set maxzoom [lindex $stops [expr [llength $stops] - 1]]
switch -exact -- $dir {
- "down" {
- if { $i >0 } {
- set zoom [lindex $stops [expr $i - 1]]
- redrawAll
- }
- }
- "up" {
- if { $i < [expr [llength $stops] - 1] } {
- set zoom [lindex $stops [expr $i + 1]]
- redrawAll
- }
- }
+ "down" {
+ if {$zoom > $maxzoom} {
+ set zoom $maxzoom
+ } elseif {$zoom < $minzoom} {
+ ; # leave it unchanged
+ } else {
+ set newzoom $minzoom
+ foreach z $stops {
+ if {$zoom <= $z} {
+ break
+ } else {
+ set newzoom $z
+ }
+ }
+ set zoom $newzoom
+ }
+ redrawAll
+ }
+ "up" {
+ if {$zoom < $minzoom} {
+ set zoom $minzoom
+ } elseif {$zoom > $maxzoom} {
+ ; # leave it unchanged
+ } else {
+ foreach z [lrange $stops 1 end] {
+ set newzoom $z
+ if {$zoom < $z} {
+ break
+ }
+ }
+ set zoom $newzoom
+ }
+ redrawAll
+ }
+ default {
+ if { $i < [expr [llength $stops] - 1] } {
+ set zoom [lindex $stops [expr $i + 1]]
+ redrawAll
+ }
+ }
}
}
+
+
+#****h* editor.tcl/double1onGrid
+# NAME
+# double1onGrid.tcl -- called on Double-1 click on grid (bind command)
+# SYNOPSIS
+# double1onGrid $c %x %y
+# FUNCTION
+# As grid is layered above annotations this procedure is used to find
+# annotation object closest to cursor
+#****
+
+proc double1onGrid { c x y } {
+ set obj [$c find closest $x $y]
+ set tags [$c gettags $obj]
+ set node [lindex $tags 1]
+ if {[lsearch $tags grid] != -1 || [lsearch $tags background] != -1} {
+ return
+ }
+ # Is this really necessary?
+ set coords [getNodeCoords $node]
+ set x1 [lindex $coords 0]
+ set y1 [lindex $coords 1]
+ set x2 [lindex $coords 2]
+ set y2 [lindex $coords 3]
+ if {$x < $x1 || $x > $x2 || $y < $y1 || $y > $y2} {
+ # cursor is not ON the closest object
+ return
+ } else {
+ annotationConfig $c $node
+ }
+}
+
+proc setZoom { x y } {
+ global curcanvas
+ global zoom
+
+ set w .entry1
+ catch {destroy $w}
+ toplevel $w -takefocus 1
+
+ if { $x == 0 && $y == 0 } {
+ set screen [wm maxsize .]
+ set x [expr {[lindex $screen 0] / 2}]
+ set y [expr {[lindex $screen 1] / 2}]
+ } else {
+ set x [expr {$x + 10}]
+ set y [expr {$y - 90}]
+ }
+ wm geometry $w +$x+$y
+ wm title $w "Set zoom %"
+ wm iconname $w "Set zoom %"
+
+ update
+ grab $w
+ label $w.msg -wraplength 5i -justify left -text "Zoom percentage:"
+ pack $w.msg -side top
+
+ frame $w.buttons
+ pack $w.buttons -side bottom -fill x -pady 2m
+ button $w.buttons.print -text "Apply" -command "setZoomApply $w"
+ button $w.buttons.cancel -text "Cancel" -command "destroy $w"
+ pack $w.buttons.print $w.buttons.cancel -side left -expand 1
+
+ bind $w <Key-Escape> "destroy $w"
+ bind $w <Key-Return> "setZoomApply $w"
+
+ entry $w.e1 -bg white
+ $w.e1 insert 0 [expr {int($zoom * 100)}]
+ pack $w.e1 -side top -pady 5 -padx 10 -fill x
+}
+
+proc setZoomApply { w } {
+ global zoom changed
+
+ set newzoom [expr [$w.e1 get] / 100.0]
+ if { $newzoom != $zoom } {
+ set zoom $newzoom
+ redrawAll
+ }
+ destroy $w
+}
+
+proc selectZoom { x y } {
+ global curcanvas
+ global zoom
+
+ set stops ".25 .5 .75 1.0 1.5 2.0 4.0"
+
+ set w .entry1
+ catch {destroy $w}
+ toplevel $w -takefocus 1
+
+ if { $x == 0 && $y == 0 } {
+ set screen [wm maxsize .]
+ set x [expr {[lindex $screen 0] / 2}]
+ set y [expr {[lindex $screen 1] / 2}]
+ } else {
+ set x [expr {$x + 10}]
+ set y [expr {$y - 90}]
+ }
+ wm geometry $w +$x+$y
+ wm title $w "Select zoom %"
+ wm iconname $w "Select zoom %"
+
+ update
+ grab $w
+
+ frame $w.buttons
+ pack $w.buttons -side bottom -fill x -pady 2m
+ button $w.buttons.print -text "Apply" -command "setZoomApply $w"
+ button $w.buttons.cancel -text "Cancel" -command "destroy $w"
+ pack $w.buttons.print $w.buttons.cancel -side left -expand 1
+
+ bind $w <Key-Escape> "destroy $w"
+ bind $w <Key-Return> "setZoomApply $w"
+
+ entry $w.e1 -bg white
+ $w.e1 insert 0 [expr {int($zoom * 100)}]
+ pack $w.e1 -side top -pady 5 -padx 10 -fill x
+}
+
projects / imunes.git / commitdiff