#!../tkdot -f

# disp - display a dot file - John.Ellson@att.com 
#
# Usage: disp <file.dot>
#
# disp displays the graph in a canvas widget.  Clicking on a node, edge,
#   or the background will list the attributes of that object to stdout.

# scrollEnter - as the mouse moves over an object change its shading
proc scrollEnter {c} {
    upvar #0 tk_library tk_library saveFill saveFill
    set item [string range [lindex [$c gettags current] 0] 1 end]
    set saveFill [lindex [$c itemconfigure 1$item -fill] 4]
    $c itemconfigure 1$item -fill black \
	-stipple @$tk_library/demos/images/grey.25
}

# scrollLeave - as the mouse moves out of an object restore its shading
proc scrollLeave {c} {
    upvar #0 saveFill  saveFill
    set item [string range [lindex [$c gettags current] 0] 1 end]
    $c itemconfigure 1$item -fill $saveFill -stipple {}
}

# select - if the mouse is currently over an object and button 1
#  is pressed then print out its attributes to stdout
proc select {c} {
    upvar #0 g g
    set item [string range [lindex [$c gettags current] 0] 1 end]
    if {$item == ""} {set item $g}
    puts [set name [$item showname]]
    foreach attr [$item listattr] {
        set val [lindex [$item queryattr $attr] 0]
        # support dot's "\N" = name substitution in labels and URLS
        if {"$attr" == "label" || "$attr" == "URL"} {
	    regsub -all {\\N} $val $name val
        }
        puts "    $attr = $val"
    }
}

# load a dot file and render the graph to a canvas widget
proc load {c} {
    upvar #0 g g argv argv saveFill saveFill

    set saveFill ""
    catch {$g delete}
    $c delete all

    if {[llength $argv] == 0} {
	puts "No dot file specified. Assuming demo."
	set argv "data/poly.dot"
    }
    if {[llength $argv] > 1} {puts "Too many args."; exit}
    if {[catch {open $argv r} f]} {puts "unable to open dot file"; exit}
    set g [dotread $f]
    close $f
    
    $g layout
    
    eval [$g render]
    
    # size the window to match the bounding box of the graph layout
    scan [$g queryattr bb] "{%dp %dp %dp %dp}" ulx uly lrx lry
    $c configure -height [set lry]p -width [set lrx]p
    
    wm minsize . 100 100
}

# set up widgets and bindings and load initial file
set c [canvas .c]
set tb [frame .tb]
pack append . $c {expand fill} $tb {expand fillx}

set b1 [button $tb.b1 -command "load $c" -text reload]
set b2 [button $tb.b2 -command exit -text quit]
pack append $tb $b1 {left} $b2 {right}

$c bind all <Any-Enter> "scrollEnter $c"
$c bind all <Any-Leave> "scrollLeave $c"

bind $c <1> "select $c"

load $c
