From bf7668f61f8a131e221b1d5d270ecaeab48c0d86 Mon Sep 17 00:00:00 2001
From: marko <marko>
Date: Sat, 22 Oct 2005 14:45:27 +0000
Subject: [PATCH] Implement initial GUI support for operating on multiple
 canvases.

TODO: implement links that can bind nodes in different canvases.

Bug found by:
Submitted by:
Requested by:
Reviewed by:
Approved by:
Obtained from:
---
 canvas.tcl   | 21 ++++++++++------
 cfgparse.tcl | 27 ++++++++++----------
 editor.tcl   | 70 ++++++++++++++++++++++++++++++++++++++++------------
 exec.tcl     | 18 +++++++-------
 imunes.tcl   | 44 +++------------------------------
 initgui.tcl  | 62 ++++++++++++++++++++++++++++++++++++++++------
 ipv4.tcl     |  4 +--
 ipv6.tcl     |  4 +--
 linkcfg.tcl  | 10 ++++----
 nodecfg.tcl  |  6 ++---
 10 files changed, 161 insertions(+), 105 deletions(-)

diff --git a/canvas.tcl b/canvas.tcl
index 802e592..cbbb07f 100755
--- a/canvas.tcl
+++ b/canvas.tcl
@@ -32,21 +32,28 @@
 
 
 proc removeCanvas { canvas } {
-    global canvass $canvas
+    global canvas_list $canvas
 
-    set i [lsearch $canvass $canvas]
-    set canvass [lreplace $canvass $i $i]
+    set i [lsearch $canvas_list $canvas]
+    set canvas_list [lreplace $canvas_list $i $i]
     set $canvas {}
     return
 }
 
 
 proc newCanvas { name } {
-    global canvass
+    global canvas_list
 
-    set canvas c0
+    set canvas [newObjectId canvas]
     global $canvas
-    lappend canvass $canvas
-    set $canvas {name default}
+    lappend canvas_list $canvas
+    set $canvas [list "name $name"]
     return
 }
+
+
+proc getCanvasName { canvas } {
+    global $canvas
+
+    return [lrange [lsearch -inline [set $canvas] "name *"] 1 end]
+}
diff --git a/cfgparse.tcl b/cfgparse.tcl
index 61133a1..3eda1bd 100755
--- a/cfgparse.tcl
+++ b/cfgparse.tcl
@@ -49,11 +49,11 @@ proc dumpputs {method dest string} {
 
 
 proc dumpCfg {method dest} {
-    global nodes links canvass
+    global node_list link_list canvas_list
     global showIfNames showNodeLabels showLinkLabels
     global showIfIPaddrs showIfIPv6addrs
 
-    foreach node $nodes {
+    foreach node $node_list {
 	global $node
 	upvar 0 $node lnode
 	dumpputs $method $dest "node $node \{"
@@ -78,7 +78,7 @@ proc dumpCfg {method dest} {
 	dumpputs $method $dest ""
     }
 
-    foreach link $links {
+    foreach link $link_list {
 	global $link
 	upvar 0 $link llink
 	dumpputs $method $dest "link $link \{"
@@ -89,7 +89,7 @@ proc dumpCfg {method dest} {
 	dumpputs $method $dest ""
     }
 
-    foreach canvas $canvass {
+    foreach canvas $canvas_list {
 	global $canvas
 	upvar 0 $canvas lcanvas
 	dumpputs $method $dest "canvas $canvas \{"
@@ -129,16 +129,15 @@ proc dumpCfg {method dest} {
 
 
 proc loadCfg { cfg } {
-    global nodes links canvass
+    global node_list link_list canvas_list
     global showIfNames showNodeLabels showLinkLabels
     global showIfIPaddrs showIfIPv6addrs
 
     # Cleanup first - this also automatically deletes all associated links
-    # XXX remove this - Tk polution!
-    foreach node $nodes {
-	removeGUINode $node
+    foreach node $node_list {
+	removeNode $node
     }
-    foreach canvas $canvass {
+    foreach canvas $canvas_list {
 	removeCanvas $canvas
     }
 
@@ -152,13 +151,13 @@ proc loadCfg { cfg } {
 	    set object $entry
 	    global $object
 	    if {"$class" == "node"} {
-		lappend nodes $object
+		lappend node_list $object
 	    }
 	    if {"$class" == "link"} {
-		lappend links $object
+		lappend link_list $object
 	    }
 	    if {"$class" == "canvas"} {
-		lappend canvass $object
+		lappend canvas_list $object
 	    }
 	    if {"$class" == "option"} {
                 # for future use
@@ -300,11 +299,11 @@ proc loadCfg { cfg } {
 
 
 proc newObjectId { type } {
-    global nodes links canvass
+    global node_list link_list canvas_list
 
     set mark [string range [set type] 0 0]
     set id 0
-    while {[lsearch [set [set type]s] "$mark$id"]  != -1} {
+    while {[lsearch [set [set type]_list] "$mark$id"]  != -1} {
         incr id
     }
     return $mark$id
diff --git a/editor.tcl b/editor.tcl
index 072e596..ccadcbd 100755
--- a/editor.tcl
+++ b/editor.tcl
@@ -120,16 +120,33 @@ proc redo {} {
 
 
 proc redrawAll {} {
-    global nodes links
+    global node_list link_list background sizex sizey
+    global curcanvas
 
-    foreach node $nodes {
-	drawNode $node
+    .c delete all
+    set background [.c create rectangle 0 0 $sizex $sizey \
+	-fill white -tags "background"]
+    .c lower $background
+
+    foreach node $node_list {
+	if { [getNodeCanvas $node] == $curcanvas } {
+	    drawNode $node
+	}
     }
-    foreach link $links {
+
+    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
     }
+
+    refreshCanvasMenu
+
     return
 }
 
@@ -337,9 +354,14 @@ proc updateLinkLabel { link } {
 
 
 proc redrawAllLinks {} {
-    global links
+    global link_list curcanvas
 
-    foreach link $links {
+    foreach link $link_list {
+	set nodes [linkPeers $link]
+	if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas ||
+	     [getNodeCanvas [lindex $nodes 1]] != $curcanvas } {
+	    continue
+	}
 	redrawLink $link
     }
     return
@@ -411,8 +433,8 @@ proc button3 { c x y } {
     global oper_mode env eid
 
     set node [lindex [$c gettags {node && current}] 1]
-    set node_id $eid\_$node
     if { $node != "" && $oper_mode == "exec" } {
+	set node_id $eid\_$node
 	set cmd [[typemodel $node].shellcmd $node]
 	if { $cmd != "" } {
 	    nexec xterm -sb -rightbar \
@@ -448,7 +470,7 @@ proc startethereal { c } {
 
 
 proc button1 { c x y button} {
-    global nodes curcanvas
+    global node_list curcanvas
     global activetool newlink curobj changed def_router_model
     global router pc host lanswitch frswitch rj45 hub
     global lastX lastY
@@ -517,7 +539,7 @@ proc button1 { c x y button} {
 			! ]
 	    }
 	    lappend $node "network-config [list $nconfig]"
-	    lappend nodes $node
+	    lappend node_list $node
 	    setNodeCanvas $node $curcanvas
 	    setNodeCoords $node "$x $y"
 	    set dy 32
@@ -627,7 +649,7 @@ proc button1-motion { c x y } {
 
 
 proc button1-release { c x y } {
-    global links nodes
+    global link_list node_list
     global activetool newlink curobj grid
     global changed undolog undolevel redolevel selectbox selected
     global lastX lastY sizex sizey
@@ -680,7 +702,7 @@ proc button1-release { c x y } {
 		
 	    }
 
-	    foreach link $links {
+	    foreach link $link_list {
 		global $link
 		if { [$c find withtag "link && $lnode1 && $lnode2"] != "" } {
 		    set regular no
@@ -740,7 +762,7 @@ proc button1-release { c x y } {
 		    lappend $link "bandwidth $defSerBandwidth"
 		    lappend $link "delay $defSerDelay"
 		}
-		lappend links $link
+		lappend link_list $link
 		drawLink $link
 		updateLinkLabel $link
 		if { $lannode != "" } {
@@ -869,10 +891,10 @@ proc nodeEnter { c } {
 
 
 proc linkEnter {c} {
-    global activetool links
+    global activetool link_list
 
     set link [lindex [$c gettags current] 1]
-    if { [lsearch $links $link] == -1 } {
+    if { [lsearch $link_list $link] == -1 } {
 	return
     }
     set line "$link: [getLinkBandwidthString $link] [getLinkDelayString $link]"
@@ -1586,7 +1608,7 @@ proc delete_object { c x y } {
 
 
 proc rearrange { mode } {
-    global nodes links autorearrange_enabled sizex sizey
+    global link_list autorearrange_enabled sizex sizey curcanvas
 
     set c .c
     set autorearrange_enabled 1
@@ -1674,7 +1696,12 @@ proc rearrange { mode } {
 		set fy_t($other) [expr $fy_t($other) - $p_fy]
 	    }
 
-	    foreach link $links {
+	    foreach link $link_list {
+		set nodes [linkPeers $link]
+		if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas ||
+		    [getNodeCanvas [lindex $nodes 1]] != $curcanvas } {
+			continue
+		}
 		set peers [linkPeers $link]
 		set coords0 [getNodeCoords [lindex $peers 0]]
 		set coords1 [getNodeCoords [lindex $peers 1]]
@@ -1731,3 +1758,14 @@ proc rearrange { mode } {
     .bottom.mbuf config -text ""
 }
 
+
+proc refreshCanvasMenu {} {
+    global canvas_list curcanvas
+
+    .menubar.canvas delete 0 end
+    foreach canvas $canvas_list {
+	.menubar.canvas add radiobutton -label [getCanvasName $canvas] \
+		-command redrawAll -indicatoron true \
+		-value $canvas -variable curcanvas
+    }
+}
diff --git a/exec.tcl b/exec.tcl
index 4d2c0fb..45f3af5 100755
--- a/exec.tcl
+++ b/exec.tcl
@@ -40,7 +40,7 @@ proc nexec { args } {
 
 
 proc setOperMode { mode } {
-    global oper_mode activetool nodes
+    global oper_mode activetool node_list
     global nmbufs nmbclusters
 
     # Verify that links to external interfaces are properly configured
@@ -48,7 +48,7 @@ proc setOperMode { mode } {
 	set extifcs [nexec ifconfig -l]
 	set extifcs \
 	    [lreplace $extifcs [lsearch $extifcs lo0] [lsearch $extifcs lo0]]
-	foreach node $nodes {
+	foreach node $node_list {
 	    if { [nodeType $node] == "rj45" } {
 		set i [lsearch $extifcs [getNodeName $node]]
 		if { $i < 0 } {
@@ -198,7 +198,7 @@ proc l3node.nghook { eid node ifc } {
 
 proc deployCfg {} {
     global eid
-    global nodes links supp_router_models
+    global node_list link_list supp_router_models
     global mac_byte4 mac_byte5
 
     set mac_byte4 0
@@ -213,7 +213,7 @@ proc deployCfg {} {
     catch { nexec kldload ng_iface }
     catch { nexec kldload ng_eiface }
 
-    foreach node $nodes {
+    foreach node $node_list {
 	set node_id "$eid\_$node"
 	set type [nodeType $node]
 	set name [getNodeName $node]
@@ -221,7 +221,7 @@ proc deployCfg {} {
 	[typemodel $node].instantiate $eid $node
     }
 
-    foreach link $links {
+    foreach link $link_list {
 	statline "Creating link $link"
 	set lnode1 [lindex [linkPeers $link] 0]
 	set lnode2 [lindex [linkPeers $link] 1]
@@ -278,7 +278,7 @@ proc deployCfg {} {
 	catch { nexec cp /dev/null /usr/local/etc/quagga/$file }
     }
 
-    foreach node $nodes {
+    foreach node $node_list {
 	global $node
 	statline "Configuring node [getNodeName $node]"
 	set node_id "$eid\_$node"
@@ -313,7 +313,7 @@ proc deployCfg {} {
 	}
     }
 
-    statline "Network topology instantiated in [expr [clock seconds] - $t_start] seconds ([llength $nodes] nodes and [llength $links] links)."
+    statline "Network topology instantiated in [expr [clock seconds] - $t_start] seconds ([llength $node_list] nodes and [llength $link_list] links)."
 }
 
 
@@ -377,10 +377,10 @@ proc monitor_loop {} {
 
 
 proc linkByIfc { node ifc } {
-    global links
+    global link_list
 
     set peer [peerByIfc $node $ifc]
-    foreach link $links {
+    foreach link $link_list {
 	set endpoints [linkPeers $link]
 	if { $endpoints == "$node $peer" } {
 	    set dir downstream
diff --git a/imunes.tcl b/imunes.tcl
index 4408aae..7aac88d 100755
--- a/imunes.tcl
+++ b/imunes.tcl
@@ -77,47 +77,11 @@ source "$ROOTDIR/$LIBDIR/filemgmt.tcl"
 #
 # Global variables are initialized here
 #
-
-set eid e0
-
-set nodes {}
-set links {}
+set node_list {}
+set link_list {}
+set canvas_list {}
 set prefs {}
-set canvass {}
-newCanvas default
-
-set newlink ""
-set selectbox ""
-set selected ""
-
-set undolevel 0
-set redolevel 0
-set undolog(0) ""
-set changed 0
-set badentry 0
-set cursorState 0
-set clock_seconds 0
-set oper_mode edit
-set grid 24
-set sizex 1024
-set sizey 768
-set curcanvas [lindex $canvass 0]
-set autorearrange_enabled 0
-
-# Some default values
-set defLinkColor red
-set defLinkWidth 2
-set defEthBandwidth 100000000
-set defSerBandwidth 2048000
-set defSerDelay 2500
-set showIfNames 1
-set showIfIPaddrs 1
-set showIfIPv6addrs 1
-set showNodeLabels 1
-set showLinkLabels 1
-
-set supp_router_models "xorp quagga static"
-set def_router_model quagga
+set eid e0
 
 
 #
diff --git a/initgui.tcl b/initgui.tcl
index bfba130..75f14e4 100755
--- a/initgui.tcl
+++ b/initgui.tcl
@@ -34,11 +34,52 @@
 #
 
 
+#
+# GUI-related global variables
+#
+
+set newlink ""
+set selectbox ""
+set selected ""
+newCanvas default
+
+set undolevel 0
+set redolevel 0
+set undolog(0) ""
+set changed 0
+set badentry 0
+set cursorState 0
+set clock_seconds 0
+set oper_mode edit
+set grid 24
+set sizex 1024
+set sizey 768
+set curcanvas [lindex $canvas_list 0]
+set autorearrange_enabled 0
+
+#
+# Initialize a few variables to default values
+#
+set defLinkColor red
+set defLinkWidth 2
+set defEthBandwidth 100000000
+set defSerBandwidth 2048000
+set defSerDelay 2500
+set showIfNames 1
+set showIfIPaddrs 1
+set showIfIPv6addrs 1
+set showNodeLabels 1
+set showLinkLabels 1
+
+set supp_router_models "xorp quagga static"
+set def_router_model quagga
+
+
 #
 # Window / canvas setup section
 #
 
-wm minsize . 640 480
+wm minsize . 640 400
 wm geometry . 800x600
 wm title . IMUNES
 
@@ -47,7 +88,7 @@ menu .menubar
 
 .menubar add cascade -label File -underline 0 -menu .menubar.file
 .menubar add cascade -label Edit -underline 0 -menu .menubar.edit
-#.menubar add cascade -label Canvas -underline 0 -menu .menubar.canvas
+.menubar add cascade -label Canvas -underline 0 -menu .menubar.canvas
 .menubar add cascade -label Tools -underline 0 -menu .menubar.tools
 .menubar add cascade -label View -underline 0 -menu .menubar.view
 .menubar add cascade -label Experiment -underline 1 -menu .menubar.experiment
@@ -110,6 +151,12 @@ bind . <Control-z> undo
 .menubar.edit add command -label "Redo" -underline 0 \
     -accelerator "Ctrl+Y" -command redo
 bind . <Control-y> redo
+.menubar.edit add separator
+.menubar.edit add command -label "New canvas" -underline 0 \
+    -command {
+	newCanvas unnamed
+	refreshCanvasMenu
+    }
 
 
 #
@@ -223,9 +270,6 @@ frame .grid
 set c [canvas .c -relief sunken -bd 1 \
 	-scrollregion "-32 -32 [expr $sizex + 32] [expr $sizey + 32]" \
 	-xscrollcommand ".hscroll set" -yscrollcommand ".vscroll set"]
-set background [.c create rectangle 0 0 $sizex $sizey \
-	-fill white -tags "background"]
-.c lower $background
 scrollbar .hscroll -orient horiz -command "$c xview"
 scrollbar .vscroll -command "$c yview"
 pack .grid -expand yes -fill both -padx 0 -pady 0
@@ -261,9 +305,7 @@ $c bind linklabel <Any-Leave> "anyLeave $c"
 $c bind node <Double-1> "popupConfigDialog $c"
 $c bind nodelabel <Double-1> "popupConfigDialog $c"
 $c bind link <Double-1> "popupConfigDialog $c"
-#$c bind link <Double-3> "startethereal $c"
 $c bind link <B3-ButtonRelease> "startethereal $c"
-#$c bind linklabel <Double-3> "startethereal $c"
 $c bind linklabel <B3-ButtonRelease> "startethereal $c"
 $c bind linklabel <Double-1> "popupConfigDialog $c"
 bind $c <1> "button1 $c %x %y none"
@@ -280,3 +322,9 @@ bind $c <B2-Motion> "$c scan dragto %x %y 1"
 bind $c <4> "$c yview scroll 1 units"
 bind $c <5> "$c yview scroll -1 units"
 
+
+#
+# Done with initialization, draw an empty canvas
+#
+refreshCanvasMenu
+redrawAll
diff --git a/ipv4.tcl b/ipv4.tcl
index 8679a93..b4b63fd 100755
--- a/ipv4.tcl
+++ b/ipv4.tcl
@@ -35,10 +35,10 @@
 
 
 proc findFreeIPv4net { mask } {
-    global nodes
+    global node_list
 
     set ipnets {}
-    foreach node $nodes {
+    foreach node $node_list {
         foreach ifc [ifcList $node] {
             set ipnet [lrange [split [getIfcIPv4addr $node $ifc] .] 0 2]
             if {[lsearch $ipnets $ipnet] == -1} {
diff --git a/ipv6.tcl b/ipv6.tcl
index 909609a..cf102c3 100755
--- a/ipv6.tcl
+++ b/ipv6.tcl
@@ -35,10 +35,10 @@
 
 
 proc findFreeIPv6net { mask } {
-    global nodes
+    global node_list
 
     set ipnets {}
-    foreach node $nodes {
+    foreach node $node_list {
         foreach ifc [ifcList $node] {
             set ipnet [lrange [split [getIfcIPv6addr $node $ifc] :] 0 3]
             if {[lsearch $ipnets $ipnet] == -1} {
diff --git a/linkcfg.tcl b/linkcfg.tcl
index 24beed9..b694efb 100755
--- a/linkcfg.tcl
+++ b/linkcfg.tcl
@@ -78,9 +78,9 @@ proc linkPeers { link } {
 
 
 proc linkByPeers { node1 node2 } {
-    global links
+    global link_list
 
-    foreach link $links {
+    foreach link $link_list {
 	set peers [linkPeers $link]
 	if { $peers == "$node1 $node2" || $peers == "$node2 $node1" } {
 	    return $link
@@ -91,7 +91,7 @@ proc linkByPeers { node1 node2 } {
 
 
 proc removeLink { link } {
-    global links $link
+    global link_list $link
 
     set pnodes [linkPeers $link]
     foreach node $pnodes {
@@ -104,8 +104,8 @@ proc removeLink { link } {
         set $node [lreplace [set $node] $i $i]
     }
     unset $link
-    set i [lsearch -exact $links $link]
-    set links [lreplace $links $i $i]
+    set i [lsearch -exact $link_list $link]
+    set link_list [lreplace $link_list $i $i]
     return
 }
 
diff --git a/nodecfg.tcl b/nodecfg.tcl
index 0a15f30..696e6fd 100755
--- a/nodecfg.tcl
+++ b/nodecfg.tcl
@@ -760,7 +760,7 @@ proc hasIPv6Addr { node } {
 
 
 proc removeNode { node } {
-    global nodes $node
+    global node_list $node
 
     foreach ifc [ifcList $node] {
         set peer [peerByIfc $node $ifc]
@@ -768,8 +768,8 @@ proc removeNode { node } {
         removeLink $link
     }
     unset $node
-    set i [lsearch -exact $nodes $node]
-    set nodes [lreplace $nodes $i $i]
+    set i [lsearch -exact $node_list $node]
+    set node_list [lreplace $node_list $i $i]
     return
 }
 
-- 
2.39.5