pathplan

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

			}
			move - clone {
				if {$id == {}} {
					$c scan dragto $wx $wy 1
				} {
					set gx [expr $grid * int(($x / $grid) + 0.5)]
					set gy [expr $grid * int(($y / $grid) + 0.5)]
					$c move $id [expr $gx - $oldx] [expr $gy - $oldy]
					set oldx $gx
					set oldy $gy
				}
			}
			stretch {
				set gx [expr $grid * int(($x / $grid) + 0.5)]
				set gy [expr $grid * int(($y / $grid) + 0.5)]
				$c dchars $id $index
				$c insert $id $index [list $gx $gy]
			}
			scale {
				set t [lindex [$c gettags $id] 0]
				set dx [expr $x-$oldx]
				set dy [expr $y-$oldy]
				set gain [expr sqrt($dx*$dx+$dy*$dy)/20]
				$c coords $id [$vc scale $t $gain]
			}
			rotate {
				set t [lindex [$c gettags $id] 0]
				set alpha [expr atan2($x-$oldx,$oldy-$y) - $angle0]
				$c coords $id [$vc rotate $t $alpha]
			}
		}
	}
}

proc clearpaths {vc c} {
	catch { $c delete triangles }
	foreach i [$c find all] {
		set t [$c type $i]
		if {$t == "line"} {$c delete $i}
	}
}

proc clearall {vc c} {
	catch { $c delete triangles }
	foreach i [$c find all] {
		if {[$c type $i] == "polygon"} {$vc remove [lindex [$c gettags $i] 0]}
		$c delete $i
	}
}

proc loadpaths {vc c file} {
	if [catch {open $file r} f] {
		error "unable to open file for read: $file"
	}
	clearpaths $vc $c
	while {![eof $f]} {
		set path [gets $f]
		if {$path == {}} {continue}
		if [catch {$vc bpath $path} path] {
			puts $path
		} {
			$c create line $path \
				-smooth spline -fill #ff00c0 -state disabled
		}
	}
	close $f
	$c configure -scrollregion [$c bbox all]
}

proc loadvconfig {vc c file} {
	if [catch {open $file r} f] {
		error "unable to open file for read: $file"
	}
	clearall $vc $c
	while {![eof $f]} {
		set coords [string trim [gets $f]]
		if {$coords == {}} {continue}
		set tag [$vc insert $coords]
		$c create polygon $coords \
			-tag $tag \
			-fill darkgreen \
			-outline yellow \
			-activeoutline #ffc000
	}
	close $f
	$c configure -scrollregion [$c bbox all]
}

proc savepaths {vc c file} {
	if [catch {open $file w} f] {
		error "unable to open file for write: $file"
	}
	foreach i [$c find all] {
		set t [$c type $i]
		if {$t == "line"} {
			set path [$c coords $i]
			set l [llength $path]
			set x1 [lindex $path 0]
			set y1 [lindex $path 1]
			set x2 [lindex $path [incr l -2]]
			set y2 [lindex $path [incr l]]
			puts $f "$x1 $y1 $x2 $y2"
		}
	}
	close $f
}

proc savevconfig {vc c file} {
	if [catch {open $file w} f] {
		error "unable to open file for write: $file"
	}
	foreach id [$vc list] {
		puts $f [$vc coords $id]
	}
	close $f
}

proc nextfile {} {
	global filename
	set filename [file join [file dirname $filename] [file tail $filename]]
	set files [glob [file join [file dirname $filename] *[file extension $filename]]]
	set filename [lindex $files [expr ([lsearch $files $filename] + 1) % [llength $files]]]
}

set vc [vgpane]
set mode draw
set filename "pathplan_data/unknown.dat"
frame .fl
set a [frame .fl.a]
set b [frame .fl.b]
set c [canvas $a.c \
	-relief sunken \
	-borderwidth 2 \
	-bg lightblue \
	-xscrollcommand "$b.h set" \
	-yscrollcommand "$a.v set"]
scrollbar $b.h -command "$c xview" -orient horiz
scrollbar $a.v -command "$c yview"
frame $b.pad \
	-width [expr [$a.v cget -width] + \
		[$a.v cget -bd]*2 + [$a.v cget -highlightthickness]*2 ] \
	-height [expr [$b.h cget -width] + \
		[$b.h cget -bd]*2 + [.fl.b.h cget -highlightthickness]*2 ]
frame .fr
frame .fr.bpath
pack [radiobutton .fr.bpath.bpath -text "bezier path" -value bpath \
		-highlightthickness 0 -anchor w -variable mode] \
		-side left -anchor w -fill x
pack [scale .fr.grid -orient horizontal -label grid -variable grid \
		-highlightthickness 0 -from 1 -to 100] \
	[radiobutton .fr.draw -text draw -value draw \
		-highlightthickness 0 -anchor w -variable mode] \
	[radiobutton .fr.stretch -text stretch -value stretch \
		-highlightthickness 0 -anchor w -variable mode] \
	[radiobutton .fr.collapse -text collapse -value collapse \
		-highlightthickness 0 -anchor w -variable mode] \
	[radiobutton .fr.clone -text clone -value clone \
		-highlightthickness 0 -anchor w -variable mode] \
	[radiobutton .fr.move -text move -value move \
		-highlightthickness 0 -anchor w -variable mode] \
	[radiobutton .fr.rotate -text rotate -value rotate \
		-highlightthickness 0 -anchor w -variable mode] \
	[radiobutton .fr.scale -text scale -value scale \
		-highlightthickness 0 -anchor w -variable mode] \
	[radiobutton .fr.delete -text delete -value delete \
		-highlightthickness 0 -anchor w -variable mode] \
	[radiobutton .fr.path -text path -value path \
		-highlightthickness 0 -anchor w -variable mode] \
	.fr.bpath \
	[radiobutton .fr.id -text id -value id \
		-highlightthickness 0 -anchor w -variable mode] \
	[radiobutton .fr.triangulate -text triangulate -value triangulate \
		-highlightthickness 0 -anchor w -variable mode] \
		-anchor w -fill x
frame .fr.load
pack [button .fr.load.load -text load \
		 -highlightthickness 0 -command "loadvconfig $vc $c \$filename"] \
	[button .fr.load.paths -text loadpaths \
		 -highlightthickness 0 -command "loadpaths $vc $c \$filename"] \
		 -side left -fill x -expand true
frame .fr.save
pack [button .fr.save.save -text save \
		 -highlightthickness 0 -command "savevconfig $vc $c \$filename"] \
	[button .fr.save.paths -text savepaths \
		 -highlightthickness 0 -command "savepaths $vc $c \$filename"] \
		 -side left -fill x -expand true
frame .fr.clear
pack [button .fr.clear.all -text clear -command "clearall $vc $c" \
		-highlightthickness 0] \
	[button .fr.clear.paths -text clearpaths -command "clearpaths $vc $c" \
		-highlightthickness 0] \
		 -side left -fill x -expand true
frame .fr.file
pack [entry .fr.file.name -textvar filename -highlightthickness 0] \
		 -side left -fill x -expand true
pack [button .fr.file.next -text next \
		 -highlightthickness 0 -command "nextfile"] \
		 -side left
frame .fr.quitdebug
pack [button .fr.quitdebug.debug -text debug \
		 -highlightthickness 0 -command "$vc debug"] \
	[button .fr.quitdebug.quit -text quit \
		 -highlightthickness 0 -command "exit"] \
	-side left -fill x -expand true
pack .fr.quitdebug .fr.clear .fr.save .fr.load .fr.file \
	[label .fr.flabel -anchor w -text "file"] \
	[entry .fr.coordinates -textvar coordinates -highlightthickness 0] \
	[label .fr.clabel -anchor w -text "coordinates"] \
		-side bottom -fill x -expand true
pack $a.v -side right -fill y
pack $c -side left -fill both -expand true
pack $b.h -side left -fill x -expand true
pack $b.pad -side right
pack $b -side bottom -fill x
pack $a -side top -fill both -expand true
pack .fl -side left -fill both -expand true
pack .fr -side left -fill y

bind $c <1> "nextpoint $vc $c %x %y"
bind $c <2> "lastpoint $vc $c"
bind $c <Motion> "motion $vc $c %x %y"

trace variable mode w "lastpoint $vc $c"

bind .fr.file.name <Return> {
	.fr.loadsave.load flash
	loadvconfig $vc $c $filename
}

bind .fr.coordinates <Return> {
	if {$coordinates == {}} {continue}
	set coords [split $coordinates]
	set coordinates {}
	switch $mode {
		draw {
			if [catch {$vc insert $coords} tag] {
				puts $tag
			} {
				$c create polygon $coords \
					-fill darkgreen \
					-outline yellow \
					-activeoutline #ffc000 \
					-tag $tag
			}
		}
		path {
			if [catch {$vc path $coords} coords] {
				puts $coords
			} {
				$c create line $coords -fill #ff00c0 -state disabled
			}
		}
		bpath {
			if [catch {$vc bpath $coords} coords] {
				puts $coords
			} {
				$c create line $coords \
					-smooth spline -fill orange -state disabled
			}
		}
	}
}

proc balloon_help {w msg} {
  bind $w <Enter> "after 1000   \"balloon_help_aux %W [list $msg]\""
  bind $w <Leave> "after cancel \"balloon_help_aux %W [list $msg]\"
	  catch {destroy %W.balloon_help}"
}
 
proc balloon_help_aux {w msg} {
  set t $w.balloon_help
  catch {destroy $t}
  toplevel $t
  wm overrideredirect $t 1
  pack [label $t.l -text $msg -relief groove -bd 1 -bg yellow] -fill both
  wm geometry $t +[expr [winfo rootx $w]+([winfo width $w]/2)]+[expr \
	  [winfo rooty $w]+([winfo height $w]/2)]
}

balloon_help .fr.grid "set grid size for draw operations"
balloon_help .fr.draw "draw a region. B1 foreach vertex except B2 for last"
balloon_help .fr.stretch "B1 to stretch a vertex, next B1 inserts new vertex. B2 to end"
balloon_help .fr.collapse "B1 collapses a vertex"
balloon_help .fr.clone "each B1 creates a new clone of a region, B2 to end"
balloon_help .fr.move "B1 to move, B2 to end"
balloon_help .fr.rotate "B1 to rotate, B2 to end"
balloon_help .fr.scale "B1 to scale, B2 to end"
balloon_help .fr.delete "B1 to delete a region"
balloon_help .fr.path "B1 starts a euclidean shortest path, B2 to end"
balloon_help .fr.bpath.bpath "B1 starts a bezier spline path, B2 to end"
balloon_help .fr.triangulate "B1 to display triangulation of a polygon"
balloon_help .fr.id "print the identifier of a region"
balloon_help .fr.coordinates "text entry of coordinates, alternative to button operations"
balloon_help .fr.file.name "current file name, or enter new name"
balloon_help .fr.file.next "next file with same directory and extension"
balloon_help .fr.save.paths "save paths to file"
balloon_help .fr.load.paths "load paths from file"
balloon_help .fr.save.save "save regions to file"
balloon_help .fr.load.load "load regions from file"
balloon_help .fr.clear.all "clear canvas of all regions and paths"
balloon_help .fr.clear.paths "clear canvas of all paths"
balloon_help .fr.quitdebug.quit "quit this application"
balloon_help .fr.quitdebug.debug "dump the vconfig"