#!/bin/sh
exec wish "$0" ${1+"$@"}
package require Tkspline
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} {
unset id
} {
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}
foreach itm [split $items .] {
$c dchars $itm $idx
$c insert $itm $idx [list $x $y]
}
$c move $id [expr $x - $oldx] [expr $y - $oldy]
}
set oldx $x
set oldy $y
}
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
}
}
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"]} {
if {[catch {package require Printer}]
&& [catch {package require printer}]} {
puts stderr "No \"Printer\" package found"
} {
set hdc [ printer dialog select ]
printer send -hdc $hdc -postscript \
-data [.c postscript]
}
} {
set chan [open "| lpr" w]
.c postscript -channel $chan
close $chan
}
}
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
}
bind .c <1> "nextpoint .c %x %y"
bind .c <Motion> "motion .c %x %y"
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}