From: ellson Date: Sat, 12 Jan 2008 04:40:39 +0000 (+0000) Subject: -renaming demo scripts so that they consistently use . for their extent X-Git-Tag: LAST_LIBGRAPH~32^2~4867 X-Git-Url: https://granicus.if.org/sourcecode?a=commitdiff_plain;h=1278530addaa4eccc0f4c2f4e76c368796c76e21;p=graphviz -renaming demo scripts so that they consistently use . for their extent -packaging demo scripts in the appropriate graphviz- rpm -fix up php install directories --- diff --git a/tclpkg/tclpathplan/demo/pathplan b/tclpkg/tclpathplan/demo/pathplan deleted file mode 100755 index 40bc0be96..000000000 --- a/tclpkg/tclpathplan/demo/pathplan +++ /dev/null @@ -1,608 +0,0 @@ -#!/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_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 $vc $c %x %y" - -trace variable mode w "lastpoint $vc $c" - -bind .fr.file.name { - .fr.loadsave.load flash - loadvconfig $vc $c $filename -} - -bind .fr.coordinates { - 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 "after 1000 \"balloon_help_aux %W [list $msg]\"" - bind $w "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.README b/tclpkg/tclpathplan/demo/pathplan.README deleted file mode 100644 index 9410936e9..000000000 --- a/tclpkg/tclpathplan/demo/pathplan.README +++ /dev/null @@ -1,11 +0,0 @@ -pathplan - Pathplan demo - -Author: John Ellson - -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.