--- /dev/null
+#!/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}
projects / graphviz / commitdiff