+++ /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}