doted

Graphviz - Graph Drawing Programs from AT&T Research and Lucent Bell Labs See doc/build.html for

	bind $w.e$a.v <Return> [list setoneattribute $w $d $a $s]
	pack $w.e$a -side top 
	focus $w.e$a.a
}

proc deleteobj {c o} {
	if {[string first "node" $o] == 0} {
		foreach e [$o listedges] {
			$c delete 1$e
			$c delete 0$e
			$e delete
		}
	}
	$c delete 1$o
	$c delete 0$o
	$o delete
}

# open a requestor for object $o,
#	deletable if $d is not null, 
#	command to list attribute in $l
#	command to query attributes in $q
#	command to set attributes in $s
proc setAttributesWidget {c o d l q s} {
	set w .attributes
	catch {destroy $w}
	toplevel $w
#	positionWindow $w
	wm title $w "[$o showname] Attributes"
	wm iconname $w "Attributes"
	foreach a [eval $l] {
		if {[catch {eval $q $a} v]} {set v {}}
		addEntryPair $w $d $a $v $s
	}
	addEntryPair $w d {} {} $s
	frame $w.spacer -height 3m -width 20
	frame $w.buttons
	if {$d == "d"} {
		 button $w.buttons.delete -text Delete -command "deleteobj $c $o; destroy $w"
		 pack $w.buttons.delete -side left -expand 1
	}
	button $w.buttons.dismiss -text OK -command "destroy $w"
	pack $w.buttons.dismiss -side left -expand 1
	pack $w.buttons -side bottom -expand y -fill x -pady 2m
}

# open a requestor according to the type of graph object $obj, to allow the user to read and set attributions
proc setAttributes {c obj} {
	global g
	if {$obj == {}} {
		set obj [string range [lindex [$c gettags current] 0] 1 end]
	}
	set type [string range $obj 0 3]
	if {$type == "node" || $type == "edge"} {
		if {[string length $obj] > 4} {
			setAttributesWidget $c $obj d \
				"$obj listattributes" \
				"$obj queryattributes" \
				"$obj setattributes"
		} {
			setAttributesWidget $c $obj {} \
				"$g list[set type]attributes" \
				"$g query[set type]attributes" \
				"$g set[set type]attributes"
		}
	} {
		setAttributesWidget $c $g {} \
			"$g listattributes" \
			"$g queryattributes" \
			"$g setattributes"
	}
}

# unconditionally remove any old graph and canvas contents, the create a new graph of $type
proc newGraphDontAsk {c type} {
	global modified g graphtype
	set graphtype $type
	$c delete all
	set modified 0
	if {[info exists g]} {$g delete}
	set g [dotnew $type]
}

# upon confirmation, remove any old graph and canvas contents, the create a new graph of $type
proc newGraph {c type} {
	global modified
	if {$modified} {
		confirm "Current graph has been modified.  Shall I continue?" \
			"newGraphDontAsk $c $type"
	} {
		newGraphDontAsk $c $type
	}
}

# generate a new graph layout and update rendering on the canvas
#  this proc is attached to the green button to the lower right of the window
proc layout {c} {
	global g
	$c delete all
	$g layout
	eval [$g render]
	$c configure -scrollregion [$c bbox all]
}

# generate a help window with $msg as the contents
proc help {msg} {
	set w .help
	catch {destroy $w}
	toplevel $w
#	positionWindow $w
	wm title $w "DotEd Help"
	wm iconname $w "DotEd"
	frame $w.menu -relief raised -bd 2
	pack $w.menu -side top -fill x
	label $w.msg \
		-font -Adobe-helvetica-medium-r-normal--*-140-*-*-*-*-*-* \
		-wraplength 4i -justify left -text $msg
	pack $w.msg -side top
	frame $w.buttons
	pack  $w.buttons -side bottom -expand y -fill x -pady 2m
	button $w.buttons.dismiss -text Dismiss -command "destroy $w"
	pack $w.buttons.dismiss -side left -expand 1
}

# proc that supports zoom in/out events
proc zoom {c fact} {
        upvar #0 $c data
        set x [$c canvasx [expr {[winfo pointerx $c] - [winfo rootx $c]}]]
        set y [$c canvasy [expr {[winfo pointery $c] - [winfo rooty $c]}]]
        $c scale all $x $y $fact $fact
        set data(zdepth) [expr {$data(zdepth) * $fact}]
        after cancel $data(idle)
        set data(idle) [after idle "zoomupdate $c"]
}

# update all text strings after zom operation is complete
proc zoomupdate {c} {
        upvar #0 $c data
        # adjust fonts
        foreach {i} [$c find all] {
                if { ! [string equal [$c type $i] text]} {continue}
                set fontsize 0
                # get original fontsize and text from tags
                #   if they were previously recorded
                foreach {tag} [$c gettags $i] {
                        scan $tag {_f%d} fontsize
                        scan $tag "_t%\[^\0\]" text
                }
                # if not, then record current fontsize and text
                #   and use them
                set font [$c itemcget $i -font]
                if {!$fontsize} {
                        set text [$c itemcget $i -text]
                        set fontsize [lindex $font 1]
                        $c addtag _f$fontsize withtag $i
                        $c addtag _t$text withtag $i
                }
                # scale font
                set newsize [expr {int($fontsize * $data(zdepth))}]
                if {abs($newsize) >= 4} {
                        $c itemconfigure $i \
                                -font [lreplace $font 1 1 $newsize] \
                                -text $text
                } {
                        # suppress text if too small
                        $c itemconfigure $i -text {}
                }
        }
        set bbox [$c bbox all]
        if {[llength $bbox]} {
                $c configure -scrollregion $bbox
        } {
                $c configure -scrollregion [list -4 -4 \
                        [expr {[winfo width $c]-4}] \
                        [expr {[winfo height $c]-4}]]
        }
}

#--------------------------------------------------------------------------
set help_about "DotEd - Dot Graph Editor
Copyright (C) 1995 AT&T Bell Labs
		  (C) 1996 Lucent Technologies

Written by: John Ellson ([e-mail])
	   and: Stephen North ([e-mail])

DotEd provides for the graphical editing of
directed graphs. Once a graph has been manually
entered then the dot layout algorithm can be applied 
by clicking on the button in the lower right corner
of the window."

set help_mouse "Button-1: When the cursor is over the
  background Button-1-Press will start a node, 
  Button-1-Motion (dragging the mouse with
  Button-1 still down) will move it and
  Button-1-Release will complete the node
  insertion into the graph.
 
  When the cursor is over an existing node
  then Button-1-Press will start an edge from
  that node.  Button-1-Motion will extend the
  edge and Button-1-Release over a different
  node will complete the edge.

Button-2: Button-2-Motion (click and drag) will
  reposition the canvas under the window.

Button-3: When Button-3 is clicked over a
  node or edge the attribute editor will
  be opened on that object.

Scrollwheel: Zooms canvas in/out.

Once a graph has been manually entered then
the dot layout algorithm can be applied by
clicking on the button in the lower right
corner of the window."

#--------------------------------------------------------------------------

#initialize some globals
set startObj {}
set saveFill {}
set modified 0
set fileName {no_name}
set printCommand {lpr}
set zfact 1.1

# create main window
wm title . "DotEd"
wm iconname . "DotEd"
wm minsize . 120 100
wm geometry . 400x300
frame .m -relief raised -borderwidth 1
frame .a
frame .b
set c [canvas .a.c \
	-cursor crosshair \
	-xscrollcommand ".b.h set" \
	-yscrollcommand ".a.v set" \
	-width 0 \
	-height 0 \
	-borderwidth 0]
scrollbar .b.h \
	-orient horiz \
	-relief sunken \
	-command "$c xview"
scrollbar .a.v \
	-relief sunken \
	-command "$c yview"
button .b.layout \
	-width [.a.v cget -width] \
	-height [.b.h cget -width] \
	-foreground green \
	-activeforeground green\
	-bitmap @$tk_library/demos/images/gray25.bmp \
	-command "layout $c"

# initialize zoom state
set [set c](zdepth) 1.0
set [set c](idle) {}

# create graph structure and set global "g"
newGraphDontAsk $c digraph

# canvas bindings
bind $c <Configure> "resize_canvas $c %w %h"
bind $c <ButtonPress-1> "mouse_b1_press $c %x %y"
bind $c <B1-Motion> "mouse_b1_motion $c %x %y"
bind $c <ButtonRelease-1> "mouse_b1_release $c %x %y"
bind $c <Button-2> "$c scan mark %x %y"
bind $c <B2-Motion> "$c scan dragto %x %y 1"
bind $c <Button-3> "setAttributes $c {}"
bind $c <Button-4> "zoom $c $zfact"
bind $c <Button-5> "zoom $c [expr {1.0/$zfact}]"

# canvas item bindings
$c bind all <Any-Enter> "mouse_anyenter $c"
$c bind all <Any-Leave> "mouse_anyleave $c"

menubutton .m.file -text "File" -underline 0 -menu .m.file.m
menu .m.file.m
.m.file.m add command -label "Load ..." -underline 0 \
	-command "loadFile $c"
.m.file.m add command -label "New - directed" -underline 0 \
	-command "newGraph $c digraph"
.m.file.m add command -label "New - undirected" -underline 6 \
	-command "newGraph $c graph"
.m.file.m add command -label "Save" -underline 0 \
	-command "saveFile dot"
.m.file.m add command -label "Save As ..." -underline 5 \
	-command "saveFileAs dot"
.m.file.m add separator
.m.file.m add cascade -label "Export" -underline 1 \
	-menu .m.file.m.export
menu .m.file.m.export
.m.file.m.export add command -label "CMAP ..." -underline 0 \
	-command "saveFileAs cmap"
.m.file.m.export add command -label "DIA ..." -underline 0 \
	-command "saveFileAs dia"
.m.file.m.export add command -label "FIG ..." -underline 0 \
	-command "saveFileAs fig"
.m.file.m.export add command -label "GIF ..." -underline 0 \
	-command "saveFileAs gif"
.m.file.m.export add command -label "HPGL ..." -underline 0 \
	-command "saveFileAs hpgl"
.m.file.m.export add command -label "MIF ..." -underline 0 \
	-command "saveFileAs mif"
.m.file.m.export add command -label "PNG ..." -underline 0 \
	-command "saveFileAs png"
.m.file.m.export add command -label "PS ..." -underline 0 \
	-command "saveFileAs ps"
.m.file.m.export add command -label "SVG ..." -underline 0 \
	-command "saveFileAs svg"
.m.file.m add separator
.m.file.m add command -label "Print Setup ..." -underline 0 \
	-command "printSetup"
.m.file.m add command -label "Print" -underline 0 \
	-command "print"
.m.file.m add separator
.m.file.m add command -label "Exit" -underline 0 -command "exit"
menubutton .m.graph -text "Graph" -underline 0 -menu .m.graph.m
menu .m.graph.m
.m.graph.m add command -label "Graph Attributes" -underline 0 \
	-command "setAttributes $c graph"
.m.graph.m add command -label "Node Attributes" -underline 0 \
	-command "setAttributes $c node"
.m.graph.m add command -label "Edge Attributes" -underline 0 \
	-command "setAttributes $c edge"
menubutton .m.help -text "Help" -underline 0 -menu .m.help.m
menu .m.help.m
.m.help.m add command -label "About DotEd" -underline 0 \
	-command {help $help_about}
.m.help.m add command -label "Mouse Operations" -underline 0 \
	-command {help $help_mouse}

pack append .m .m.file {left} .m.graph {left} .m.help {right}
pack append .a $c {left expand fill} .a.v {right filly}
pack append .b .b.h {left expand fillx} .b.layout {right}
pack append . .m {top fillx} .a {expand fill} .b {bottom fillx}
tk_menuBar .m.file .m.graph .m.help

if {$argc} {loadFileByNameDontAsk $c [lindex $argv 0]}