From: ellson <devnull@localhost>
Date: Sat, 12 Jan 2008 04:40:40 +0000 (+0000)
Subject: -renaming demo scripts so that they consistently use .<lang> for their extent
X-Git-Tag: LAST_LIBGRAPH~32^2~4864
X-Git-Url: https://granicus.if.org/sourcecode?a=commitdiff_plain;h=fc7b807a762d31b1a3b36d0785db41528358b8ef;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/tkspline/demo/Makefile.am b/tclpkg/tkspline/demo/Makefile.am
index a572c9dff..32931abdb 100644
--- a/tclpkg/tkspline/demo/Makefile.am
+++ b/tclpkg/tkspline/demo/Makefile.am
@@ -4,8 +4,8 @@
 demodir = $(pkgdatadir)/demo
 
 if WITH_TK
-demo_SCRIPTS = spline
-demo_DATA = spline.README
+demo_SCRIPTS = spline.tcl
+demo_DATA = spline.tcl.README
 endif
 
-EXTRA_DIST = spline spline.README
+EXTRA_DIST = spline.tcl spline.tcl.README
diff --git a/tclpkg/tkspline/demo/spline.tcl b/tclpkg/tkspline/demo/spline.tcl
new file mode 100755
index 000000000..0dae2daee
--- /dev/null
+++ b/tclpkg/tkspline/demo/spline.tcl
@@ -0,0 +1,151 @@
+#!/bin/sh
+# next line is a comment in tcl \
+exec wish "$0" ${1+"$@"}
+
+package require Tkspline
+
+########################################################################
+# splinetest.tcl - a test of spline rendering using the Tkspline extension
+#
+# John Ellson - ellson@graphviz.org 
+########################################################################
+
+# create canvas and frame for toolbar
+pack [canvas .c -bg white -height 350] \
+    -side top -fill both -expand true
+pack [frame .f] -side top -fill x
+
+proc nextpoint {c wx wy} {
+    global id oldx oldy
+
+    if {[info exists id]} {
+        unset id
+    } {
+        set id [$c find withtag current]
+        if {[string length $id] == 0} {
+            # not a Point
+            unset id
+        } {
+            # $id != {} so must be a Point because everything else is disabled
+            set oldx [$c canvasx $wx]
+            set oldy [$c canvasy $wy]
+        }
+    }
+}
+
+proc motion {c wx wy} {
+    global id oldx oldy
+    set x [$c canvasx $wx]
+    set y [$c canvasy $wy]
+    if [info exists id] {
+        foreach {items idx} [$c gettags $id] {break}
+        # update single coord in three variants of shape
+        foreach itm [split $items .] {
+               $c dchars $itm $idx
+               $c insert $itm $idx [list $x $y]
+        }
+        # move control point
+        $c move $id [expr $x - $oldx] [expr $y - $oldy]
+    }
+    set oldx $x
+    set oldy $y
+}
+
+# itemwithcontrolpoints - create a "line" or "polygon" with
+#    straight + spline + smooth  line variants and draggable 
+#    control points.
+#
+# c = canvas handle
+# item = "line" | "polygon"
+# coords = x y x y ... list of control point locations
+#
+proc itemwithcontrolpoints {c item coords} {
+    if {[string equal $item "line"]} {
+        set opts {}
+    } {
+        set opts {-fill {} -outline black}
+    }
+    set lid [eval $c create $item $coords $opts \
+        -state disabled -tag Line]
+    set slid [eval $c create $item $coords $opts \
+        -smooth true -state disabled -tag Smooth]
+    set bzlid [eval $c create $item $coords $opts \
+        -smooth spline -state disabled -tag Spline]
+    set idx 0
+    foreach {x y} $coords {
+        set id [$c create oval -2 -2 2 2 \
+            -fill yellow -outline black \
+            -tags [list $lid.$slid.$bzlid $idx Point]]
+        $c move $id $x $y 
+        incr idx 2
+    }
+}
+    
+# show objects by type (from toolbar buttons)
+proc show {typ show} {
+    if {$show} {
+        if {[string equal $typ "Point"]} {
+            .c itemconfigure $typ -state normal
+        } {
+            .c itemconfigure $typ -state disabled
+        }
+    } {
+        .c itemconfigure $typ -state hidden
+    }
+}
+
+proc print {} {
+    global tcl_platform
+    if {[string equal $tcl_platform(platform) "windows"]} {
+        # platform == "windows"
+        if {[catch {package require Printer}] 
+        && [catch {package require printer}]} {
+            # Can't do this--no printer package
+            puts stderr "No \"Printer\" package found"
+        } {
+            # Ask the user to select a printer
+            set hdc [ printer dialog select ]
+            # Now send raw postscript output to the device
+            printer send -hdc $hdc -postscript \
+                -data [.c postscript]
+        }
+    } {
+        # platform != "windows" ... then probably unix
+        set chan [open "| lpr" w]
+        .c postscript -channel $chan
+        close $chan
+    }
+}
+
+# populate toolbar
+foreach typ {Exit Print} {
+    set cmd [string tolower $typ]
+    pack [button .f.$cmd \
+        -text $typ -width 6 -command $cmd \
+        -padx 0 -pady 0 -width 6] \
+            -side right
+}
+
+foreach typ {Line Smooth Spline Point} {
+    pack [checkbutton .f.[string tolower $typ] \
+        -text $typ -variable var$typ -width 6 \
+        -selectcolor yellow -command "show $typ \$var$typ" \
+        -indicatoron false] \
+            -side left -fill both
+    set var$typ 1
+}
+
+# mouse bindings on canvas objects
+bind .c <1> "nextpoint .c %x %y"
+bind .c <Motion> "motion .c %x %y"
+
+# populate with demo objects
+itemwithcontrolpoints .c line \
+    {50 50 50 100 100 100 100 50 100 20 150 20 150 50}
+itemwithcontrolpoints .c polygon \
+    {50 200 100 150 150 200 150 250 100 300 50 250}
+
+set help [.c create text 10 125 \
+    -anchor w \
+    -text "You can drag the points\nwith mouse button 1"]
+after 5000 {.c delete $help}
diff --git a/tclpkg/tkspline/demo/spline.tcl.README b/tclpkg/tkspline/demo/spline.tcl.README
new file mode 100644
index 000000000..667e8cfbc
--- /dev/null
+++ b/tclpkg/tkspline/demo/spline.tcl.README
@@ -0,0 +1,8 @@
+spline.tcl - demo additional smoothing method of tkspline
+
+Author: John Ellson <ellson@graphviz.org>
+
+Package requires: wish, tkspline
+
+A demo of various line and polygon smoothing methods.
+This script is designed to exercise the spline smoothing package: tkspline