From: ellson <devnull@localhost>
Date: Sat, 12 Jan 2008 04:40:39 +0000 (+0000)
Subject: -renaming demo scripts so that they consistently use .<lang> for their extent
X-Git-Tag: LAST_LIBGRAPH~32^2~4866
X-Git-Url: https://granicus.if.org/sourcecode?a=commitdiff_plain;h=61feffe5c5fd834f7d05b2eed5cd8960879640f2;p=graphviz

-renaming demo scripts so that they consistently use .<lang> for their extent
-packaging demo scripts in the appropriate graphviz-<lang> rpm
-fix up php install directories
---

diff --git a/tclpkg/tclpathplan/demo/Makefile.am b/tclpkg/tclpathplan/demo/Makefile.am
index 4165f6cf1..c28c6ccd3 100644
--- a/tclpkg/tclpathplan/demo/Makefile.am
+++ b/tclpkg/tclpathplan/demo/Makefile.am
@@ -6,8 +6,8 @@ SUBDIRS = pathplan_data
 demodir = $(pkgdatadir)/demo
 
 if WITH_TCL
-demo_SCRIPTS = pathplan
-demo_DATA = pathplan.README
+demo_SCRIPTS = pathplan.tcl
+demo_DATA = pathplan.tcl.README
 endif
 
-EXTRA_DIST = pathplan pathplan.README
+EXTRA_DIST = pathplan.tcl pathplan.tcl.README
diff --git a/tclpkg/tclpathplan/demo/pathplan.tcl b/tclpkg/tclpathplan/demo/pathplan.tcl
new file mode 100755
index 000000000..d7b6ef288
--- /dev/null
+++ b/tclpkg/tclpathplan/demo/pathplan.tcl
@@ -0,0 +1,608 @@
+#!/bin/sh
+# next line is a comment in tcl \
+exec wish "$0" ${1+"$@"}
+
+package require Tkspline
+package require Tclpathplan
+
+########################################################################
+# shape - a shape drawing tool for testing the spring layout engine
+#
+# John Ellson - ellson@graphviz.org - September 12, 1996
+
+# requires dash patch
+
+# Radio buttons select the drawing mode.
+#	"draw"		- draw a closed and filled polygon
+#	"stretch"   - move a vertex of a polygon, also
+#				  insert additional vertices with subsequent button 1 clicks
+#	"collapse"  - delete a vertex of a polygon (except last 2)
+#	"move"		- move a complete polygon without altering 
+#				  its shape, or move the whole canvas.
+#	"rotate"	- rotate a polygon about its center
+#	"scale"		- scale a polygon
+#	"clone"		- copy an existing shape
+#	"delete"	- remove an entire polygon object
+#	"path"		- draw a line between two polygons and the 
+#				  system will respond with the shortest path
+#				  around all the other polygons.
+#	"bezier path" - draw a line between two polygons and the 
+#				  system will respond with the spline that follows
+#				  the shortest path around all the other polygons.
+#	"id"		- identify a polygon.  mostly for debugging.
+
+# "draw," "stretch," "move," "path", "bezier path",  and "clone" use 
+# button 1 for first though penultimate points, then button 2 to 
+# complete the operation.
+
+# "rotate" and "scale" use the button 1 to grab a polygon and
+# button 2 to complete the operation.
+
+# "collapse" and "delete" just use button 1 
+
+# "stretch, " "move, " "collapse," and "delete" operations all act on
+# a highlighted object
+
+# "grid" constrains the locations of input points to lie on a grid of
+# the specified spacing (in pixels).
+
+# Future...
+#
+# some other possible operations:
+#   regularize (arrange points on circle)
+#   transformations: skew, distort, scale
+#	   label text (inside or relative)
+#   fill & outline color
+#   fill & outline stipple
+#   fill tile image
+#   outline dash (mark, space offset)
+#   outline width
+#   number of peripheries
+#
+#   group/ungroup
+#
+#   raise/lower (not required if no overlap)
+#
+#   constraints:  no overlap
+#				 no twist
+#
+#   resources:	shape library
+#				 stipple patterns
+#				 tile images
+#
+########################################################################
+
+set splinecolor orange
+
+set showmouse off
+
+proc nextpoint {vc c wx wy} {
+	global id mode oldx oldy gain0 angle0 index grid
+
+	set x [$c canvasx $wx]
+	set y [$c canvasy $wy]
+	set gx [expr $grid * int(($x / $grid) + 0.5)]
+	set gy [expr $grid * int(($y / $grid) + 0.5)]
+	switch $mode {
+		draw {
+			if [info exists id] {
+				$c insert $id 0 [list $gx $gy]
+			} {
+				set id [$c create polygon $gx $gy $gx $gy \
+					-fill red -outline #ffc000]
+			}
+		}
+		stretch {
+			if [info exists id] {
+				$c insert $id $index [list $gx $gy]
+			} {
+				set id [$c find withtag current]
+				if {$id == {}} {
+					unset id
+				} {
+					set index [$c index $id @$x,$y]
+					$c dchars $id $index
+					$c insert $id $index [list $gx $gy]
+				}
+			}
+		}
+		collapse {
+			set id [$c find withtag current]
+			if {$id != {}} {
+				set index [$c index $id @$x,$y]
+				if {[llength [$c coords $id]] > 4} {$c dchars $id $index}
+				$vc coords [lindex [$c gettags $id] 0] [$c coords $id]
+			}
+			unset id
+		}
+		clone {
+			if [info exists id] {
+				set tag [$vc insert [$c coords $id]]
+				$c addtag $tag withtag $id
+			}
+			set t [$c find withtag current]
+			if {$t != {}} {
+				set id [$c create [$c type $t] [$c coords $t]]
+				foreach config [$c itemconfigure $t] {
+					foreach {config . . . val} $config {break}
+					if {$config != "-tags"} {
+						$c itemconfigure $id $config $val
+					}
+				}
+				set oldx $gx
+				set oldy $gy
+			}
+		}
+		move {
+			set id [$c find withtag current]
+			if {$id == {}} {
+				$c scan mark $wx $wy
+			} {
+				set oldx $gx
+				set oldy $gy
+			}
+		}
+		scale {
+			set id [$c find withtag current]
+			if {$id == {}} {
+				unset id
+			} {
+				foreach {oldx oldy} \
+					[$vc center [lindex [$c gettags $id] 0]] {break}
+				set dx [expr $oldx-$x]
+				set dy [expr $oldy-$y]
+				set gain0 [expr sqrt($dx*$dx+$dy*$dy)]
+			}
+		}
+		rotate {
+			set id [$c find withtag current]
+			if {$id == {}} {
+				unset id
+			} {
+				foreach {oldx oldy} [$vc center [lindex [$c gettags $id] 0]] {
+					break
+				}
+				set angle0 [expr atan2($x-$oldx, $oldy-$y)]
+			}
+		}
+		path {
+			if [info exists id] {
+				set path [$c coords $id]
+				if [catch {$vc path $path} path] {
+					puts $path
+				} {
+					$c coords $id $path
+					$c itemconfigure $id -fill red
+					set id [$c create line $x $y $x $y \
+						-fill red -state disabled]
+				}
+			} {
+				set id [$c create line $gx $gy $gx $gy \
+					-fill red -state disabled]
+			}
+		}
+		bpath {
+			if [info exists id] {
+				set path [$c coords $id]
+				if [catch {$vc bpath $path} path] {
+					puts $path
+				} {
+					$c coords $id $path
+					$c itemconfigure $id -fill orange
+					set id [$c create line $x $y $x $y \
+						-smooth spline -fill orange -state disabled]
+				}
+			} {
+				set id [$c create line $gx $gy $gx $gy \
+					-smooth spline -fill orange -state disabled]
+			}
+		}
+		delete {
+		   $vc remove [lindex [$c gettags current] 0]
+		   $c delete current
+		}
+		triangulate {
+			global mode
+			if {[$vc bind triangle] == {}} {
+				$vc bind triangle {
+					if {$mode == "triangulate"} {
+						$c create polygon %t -tag triangles \
+							-fill {} -outline white -width 2 
+					} {
+						$c create polygon %t -tag triangles \
+							-fill {} -outline white -width 2  -state hidden
+					}
+				}
+			}
+			if {$mode == "triangulate"} {
+				$c itemconfigure triangles -state normal
+			} {
+				$c itemconfigure triangles -state hidden
+			} 
+			set t [$vc find $x $y]
+			if {$t != {}} {
+				$vc triangulate $t
+			}
+		}
+		id {
+		   set t [$vc find $x $y]
+		   if {$t == {}} {
+			   puts "at: $x $y ....nothing"
+		   } {
+			   puts "at: $x $y\nid: $t\ncoords: [$vc coords $t]"
+		   }
+		}
+	}
+}
+
+proc lastpoint {vc c args} {
+	global id mode
+	if [info exists id] {
+		switch $mode {
+			draw {
+				$c itemconfigure $id -fill darkgreen \
+					-outline yellow -activeoutline #ffc000
+				set tag [$vc insert [$c coords $id]]
+				$c addtag $tag withtag $id
+			}
+			clone {
+				set tag [$vc insert [$c coords $id]]
+				$c addtag $tag withtag $id
+			}
+			move - stretch - rotate - scale {
+				set t [lindex [$c gettags $id] 0]
+				if {$t != {} && $t != "current"} {
+					$vc coords $t [$c coords $id]
+				}
+			}
+			path {
+				set path [$c coords $id]
+				if [catch {$vc path $path} path] {
+					puts $path
+					$c delete $id
+				} {
+					$c coords $id $path
+					$c itemconfigure $id -fill 
+				}
+			}
+			bpath {
+				set path [$c coords $id]
+				if [catch {$vc bpath $path} path] {
+					puts $path
+					$c delete $id
+				} {
+					$c coords $id $path
+					$c itemconfigure $id -fill red
+				}
+			}
+		}
+		$c configure -scrollregion [$c bbox all]
+		unset id
+	}
+}
+
+proc motion {vc c wx wy} {
+	global id mode oldx oldy gain0 angle0 index grid showmouse
+	set x [$c canvasx $wx]
+	set y [$c canvasy $wy]
+		if {$showmouse == "on"} {
+			puts -nonewline stderr "\r$x,$y [list [$vc find $x $y]]	 "
+		}
+	if [info exists id] {
+		switch $mode {
+			draw {
+				set gx [expr $grid * int(($x / $grid) + 0.5)]
+				set gy [expr $grid * int(($y / $grid) + 0.5)]
+				$c dchars $id 0
+				$c insert $id 0 [list $gx $gy]
+			}
+			path {
+				$c dchars $id 0
+				$c insert $id 0 [list $x $y]
+			}
+			bpath {
+				$c dchars $id 0
+				$c insert $id 0 [list $x $y]
+			}
+			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.tcl.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"
diff --git a/tclpkg/tclpathplan/demo/pathplan.tcl.README b/tclpkg/tclpathplan/demo/pathplan.tcl.README
new file mode 100644
index 000000000..12a38043f
--- /dev/null
+++ b/tclpkg/tclpathplan/demo/pathplan.tcl.README
@@ -0,0 +1,11 @@
+pathplan.tcl - Pathplan demo
+
+Author: John Ellson <ellson@graphviz.org>
+
+Package requires: wish, tclpathplan, tkspline
+
+Pathplan is a library for finding stright-line or bezier routes
+around abitrary polygon obstacles.  This script is a demo of
+the capabilities of the library.  It supports the creation of polygon
+obstacles and the specification of the endpoints of paths between
+which the shortest path is found.