From a22ee2c747d302d43805bf9814d24e599a6be4b5 Mon Sep 17 00:00:00 2001
From: marko <marko>
Date: Thu, 8 Sep 2005 13:02:44 +0000
Subject: [PATCH] Implement a simple genetic algorithm for automatic
 rearpositioining of nodes.  The new function is activated from the "tools"
 menu, and remains in effect until a cusor is clicked on blank space in the
 canvas, or "execute" mode is engaged.  It is possible to reposition either
 all nodes or only the currently selected ones.

Bug found by:
Submitted by:
Requested by:
Reviewed by:
Approved by:
Obtained from:
---
 editor.tcl  | 101 ++++++++++++++++++++++++++++++++++++++++++++++++++--
 exec.tcl    |   6 ++++
 initgui.tcl |  17 +++++----
 3 files changed, 116 insertions(+), 8 deletions(-)

diff --git a/editor.tcl b/editor.tcl
index 382e448..ed16999 100755
--- a/editor.tcl
+++ b/editor.tcl
@@ -606,11 +606,10 @@ proc button1-motion { c x y } {
 	    set lastY $y
     } else {
 	foreach img [$c find withtag "selectmark"] {
-	    $c move $img [expr $x-$lastX] [expr $y-$lastY]
 	    set node [lindex [$c gettags $img] 1]
+	    $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 node [lindex [$c gettags $img] 1]
 	    set img [$c find withtag "nodelabel && $node"]
 	    $c move $img [expr $x-$lastX] [expr $y-$lastY]
 	    $c addtag need_redraw withtag "link && $node"
@@ -634,6 +633,7 @@ proc button1-release { c x y } {
     global lastX lastY sizex sizey
     global defLinkColor defLinkWidth
     global defEthBandwidth defSerBandwidth defSerDelay
+    global autorearrange_enabled
 
     set x [$c canvasx $x]
     set y [$c canvasy $y]
@@ -806,6 +806,7 @@ proc button1-release { c x y } {
 	if {$selectbox == ""} {
 	    set x1 $x
 	    set y1 $y
+	    set autorearrange_enabled 0
 	} else {
 	    set coords [$c coords $selectbox]
 	    set x [lindex $coords 0]
@@ -1577,3 +1578,99 @@ proc delete_object { c x y } {
     updateUndoLog
 }
 
+
+proc rearrange { mode } {
+    global nodes autorearrange_enabled
+
+    set c .c
+    set autorearrange_enabled 1
+    .menubar.tools entryconfigure "Rearrange all" -state disabled
+    .menubar.tools entryconfigure "Rearrange selected" -state disabled
+    .bottom.mbuf config -text "autorearrange"
+    if { $mode == "selected" } {
+	set tagmatch "node && selected"
+    } else {
+	set tagmatch "node"
+    }
+    while { $autorearrange_enabled } {
+	foreach obj [$c find withtag $tagmatch] {
+            set node [lindex [$c gettags $obj] 1]
+	    set coords [getNodeCoords $node]
+	    set x [lindex $coords 0]
+	    set y [lindex $coords 1]
+	    if { [catch "set cachectable($node)" cached] } {
+		set weight0 [calcDistWeight $node $x $y]
+	    } elseif { [lindex $cached 0] == $x && [lindex $cached 1] == $y } {
+		set weight0 [lindex $cached 2]
+	    } else {
+		set weight0 [calcDistWeight $node $x $y]
+	    }
+	    set dx [expr (rand() - 0.5) * 16]
+	    set dy [expr (rand() - 0.5) * 16]
+	    set x [expr $x + $dx]
+	    set y [expr $y + $dy]
+	    set weight1 [calcDistWeight $node $x $y]
+	    set cachectable($node) "$x $y $weight1"
+	    if { $weight0 > $weight1 } {
+		setNodeCoords $node "$x $y"
+		set img [$c find withtag "selectmark && $node"]
+		$c move $img $dx $dy
+		set img [$c find withtag "node && $node"]
+		$c move $img $dx $dy
+		set img [$c find withtag "nodelabel && $node"]
+		$c move $img $dx $dy
+		setNodeLabelCoords $node [$c coords $img]
+		$c addtag need_redraw withtag "link && $node"
+	    }
+	}
+	foreach link [$c find withtag "link && need_redraw"] {
+	    redrawLink [lindex [$c gettags $link] 1]
+	}
+	$c dtag link need_redraw
+	update
+    }
+    .menubar.tools entryconfigure "Rearrange all" -state normal
+    .menubar.tools entryconfigure "Rearrange selected" -state normal
+    .bottom.mbuf config -text ""
+}
+
+
+proc calcDistWeight { node x y } {
+    global nodes links sizex sizey
+
+    set weight [expr .1 / ($x * $x) + .1 / ($y * $y)]
+    set weight [expr $weight + .1 / (($sizex - $x) * ($sizex - $x))]
+    set weight [expr $weight + .1 / (($sizey - $y) * ($sizey - $y))]
+    foreach other $nodes {
+	if { $other == $node } {
+	    continue
+	}
+	set coords [getNodeCoords $other]
+	set o_x [lindex $coords 0]
+	set o_y [lindex $coords 1]
+	set dx [expr ($x - $o_x)]
+	set dy [expr ($y - $o_y)]
+	set d2 [expr $dx * $dx + $dy * $dy]
+	if { $d2 != 0 } {
+	    set weight [expr $weight + 1 / $d2]
+	}
+	if {[linkByPeers $node $other] != ""} {
+	    set d2 [expr $dx * $dx + $dy * $dy]
+	    set weight [expr $weight + $d2 * $d2 / 1000000000000000]
+	}
+    }
+    foreach link $links {
+	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]]
+	set o_y [expr [lindex $coords0 1] + [lindex $coords1 1]]
+	set dx [expr (2 * $x - $o_x)]
+	set dy [expr (2 * $y - $o_y)]
+	set d2 [expr $dx * $dx + $dy * $dy]
+	if { $d2 != 0 } {
+	    set weight [expr $weight + .1 / $d2]
+	}
+    }
+    return $weight
+}
diff --git a/exec.tcl b/exec.tcl
index 0a47116..4d2c0fb 100755
--- a/exec.tcl
+++ b/exec.tcl
@@ -73,6 +73,10 @@ proc setOperMode { mode } {
     set activetool select
     .left.select configure -state active
     if { "$mode" == "exec" && [nexec id -u] == 0} {
+	global autorearrange_enabled
+	set autorearrange_enabled 0
+	.menubar.tools entryconfigure "Rearrange all" -state disabled
+	.menubar.tools entryconfigure "Rearrange selected" -state disabled
 	.menubar.experiment entryconfigure "Execute" -state disabled
 	.menubar.experiment entryconfigure "Terminate" -state normal
 	.menubar.edit entryconfigure "Undo" -state disabled
@@ -85,6 +89,8 @@ proc setOperMode { mode } {
     } else {
 	if {$oper_mode != "edit"} {
 	    vimageCleanup
+	    .menubar.tools entryconfigure "Rearrange all" -state normal
+	    .menubar.tools entryconfigure "Rearrange selected" -state normal
 	}
 	if {[nexec id -u] == 0} {
 	    .menubar.experiment entryconfigure "Execute" -state normal
diff --git a/initgui.tcl b/initgui.tcl
index e93eb36..637bde3 100755
--- a/initgui.tcl
+++ b/initgui.tcl
@@ -48,6 +48,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 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
 .menubar add cascade -label Help -underline 0 -menu .menubar.help
@@ -117,6 +118,16 @@ bind . <Control-y> redo
 menu .menubar.canvas -tearoff 0
 
 
+#
+# Tools
+#
+menu .menubar.tools -tearoff 0
+.menubar.tools add command -label "Rearrange all" -underline 0 \
+    -command { rearrange all }
+.menubar.tools add command -label "Rearrange selected" -underline 0 \
+    -command { rearrange selected }
+
+
 #
 # View
 #
@@ -174,12 +185,6 @@ menu .menubar.experiment -tearoff 0
 	-command "setOperMode edit" -state disabled
 
 
-#
-# Tools
-#
-menu .menubar.tools -tearoff 0
-
-
 #
 # Help
 #
-- 
2.39.5