spline   [plain text]

#!/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}