#!/usr/bin/env wish -f

# Mouse actions:
#  mouse-1 (left)     place node
#  mouse-2 (middle)   click on first node and draw "line" to second node
#  mouse-3 (right)    move node

# Keyboard actions:

#  m                  change background color to mauve and create circles
#  f                  change background color to pink and create squares
#  p                  print graph

#  S                  save to file
#  B                  ?
#  L                  load from file
#  s                  dump to stdout

#  r                  make node red
#  g                  make node green
#  b                  make node blue

#  q                  quit program


canvas .c -background gray70 -height 300 -width 300
set gender 0
pack .c
proc mkNode {x y} {
    global nodeX nodeY edgeFirst edgeSecond gender attrib
    if {$gender} {
	set new [.c create oval [expr $x-10] [expr $y-10] \
		[expr $x+10] [expr $y+10] -outline black \
		-fill white -tags node]
    }
    if {[expr !$gender]} {
	set new [.c create rectangle [expr $x-8] [expr $y-8] \
		[expr $x+8] [expr $y+8] -outline black \
		-fill white -tags node]
    }
    set attrib($new) $gender
    set nodeX($new) $x
    set nodeY($new) $y
    set edgeFirst($new) {}
    set edgeSecond($new) {}
    return $new
}

proc mkEdge {first second} {
    global nodeX nodeY edgeFirst edgeSecond edge edgeattrs
    set edge [.c create line $nodeX($first) $nodeY($first) \
	     $nodeX($second) $nodeY($second)]
    .c lower $edge
    lappend edgeFirst($first) $edge
    lappend edgeSecond($second) $edge
    set edgeattrs($edge) 0
    return $edge
}


proc moveNode {node xDist yDist} {
    global nodeX nodeY edgeFirst edgeSecond
    .c move $node $xDist $yDist
    incr nodeX($node) $xDist
    incr nodeY($node) $yDist
    foreach edge $edgeFirst($node) {
	.c coords $edge $nodeX($node) $nodeY($node) \
			[lindex [.c coords $edge] 2] \
			[lindex [.c coords $edge] 3]
    }
    foreach edge $edgeSecond($node) {
	.c coords $edge [lindex [.c coords $edge] 0] \
			[lindex [.c coords $edge] 1] \
			$nodeX($node) $nodeY($node)
    }
}

.c bind node <Button-3> {
    set curX %x
    set curY %y
}

.c bind node <B3-Motion> {
    moveNode [.c find withtag current] [expr %x-$curX] \
	     [expr %y-$curY]
    set curX %x
    set curY %y
}

bind .c m {set gender [expr 0];.c configure -background #aac}
bind .c f {set gender [expr 1];.c configure -background #caa}
bind .c p {.c postscript -file /tmp/graph.ps -pagewidth 8.5i
exec lpr /tmp/graph.ps
}

source mkdialog.tcl
set filename "/tmp/foo"
bind .c B {mkdialog "file test" .c filename}
bind .c S {callbackdialog "file save" .c dumptofile}
proc loadmap {fn} { global gender; source $fn }
bind .c L {callbackdialog "file load" .c loadmap}

bind .c r {.c itemconfigure current -fill red}
bind .c b {.c itemconfigure current -fill blue}
bind .c g {.c itemconfigure current -fill green}
bind .c w {.c itemconfigure current -fill white}
bind .c s {puts stdout $filename}

bind .c q {exit}
bind .c <Button-1> {mkNode %x %y}
#.c bind node <Any-Enter> {
#	.c itemconfigure current -fill black
#}
#.c bind node <Any-Leave> {
#	.c itemconfigure current -fill white
#}
bind .c <Button-2> {set firstNode [.c find withtag current]}

bind .c <ButtonRelease-2> {
    set curNode [.c find withtag current]
    if {($firstNode != "") && ($curNode != "")} {
	mkEdge $firstNode $curNode
    }
}

proc mkarrow {edge} {
    global edgeattrs
    .c itemconfigure $edge -arrow last
    .c itemconfigure $edge -arrowshape {15 25 15}
    set edgeattrs($edge) 1
}    

bind .c <Shift-Button-2> {set firstNode [.c find withtag current]}

bind .c <Shift-ButtonRelease-2> {
    set curNode [.c find withtag current]
    if {($firstNode != "") && ($curNode != "")} {
	mkEdge $firstNode $curNode
    }
    mkarrow $edge
}


bind .c <Delete> {
    set delme [.c find withtag current]
    unset nodeX($delme)
    unset nodeY($delme)
    .c delete $delme
    foreach myedge $edgeFirst($delme) {
	.c delete $myedge
    }
    unset edgeFirst($delme)
    foreach myedge $edgeSecond($delme) {
	.c delete $myedge
    }
    unset edgeSecond($delme)
}

focus .c

proc dumptofile { filename } {
    set file [open $filename w]
    global nodeX nodeY edgeFirst edgeSecond attrib edgeattrs
    puts $file "# grapheditor $filename"
    foreach node [array names nodeX] {
	puts $file "set gender $attrib($node)"
	puts $file "set graphedit($node) \[mkNode $nodeX($node) $nodeY($node)\]"
    }
    foreach node [array names nodeX] {
	foreach edge $edgeFirst($node) {
	    # edge is the one that starts at $node
	    # it ends at the node N for which $edge is in edgeSecond(N)
	    foreach N [array names nodeX] {
		set E [lsearch $edgeSecond($N) $edge]
		if {($E != -1)} {
		    puts $file "set tmpedge \[mkEdge \$graphedit($node) \$graphedit($N)\]"
		    if {($edgeattrs($edge))} {
			puts $file "mkarrow \$tmpedge"
		    }
		}
	    }
	}
    }
    puts $file "unset graphedit"
    puts $file "unset tmpedge"
    puts $file "# done."
}