← Back to branch summary

~ubuntu-branches/ubuntu/lucid/graphviz/lucid-updates

« back to all changes in this revision

Viewing changes to tclpkg/tkspline/demo/spline

  • Committer: Bazaar Package Importer
  • Author(s): Bryce Harrington
  • Date: 2008-06-19 20:23:23 UTC
  • mfrom: (1.2.5 upstream)
  • Revision ID: james.westby@ubuntu.com-20080619202323-ls23h96ntj9ny94m
Tags: 2.18-1ubuntu1
https://launchpad.net/bugs/174749
* Merge from debian unstable, remaining changes:
  - Build depend on liblualib50-dev instead of liblua5.1-0-dev.
  - Drop libttf-dev (libttf-dev is in universe) (LP: #174749).
  - Replace gs-common with ghostscript.
  - Build-depend on python-dev instead of python2.4-dev or python2.5-dev.
  - Mention the correct python version for the python bindings in the
    package description.

Show diffs side-by-side

added added

removed removed

Lines of Context:
tclpkg/tkspline/demo/spline
1
 
#!/bin/sh
2
 
# next line is a comment in tcl \
3
 
exec wish "$0" ${1+"$@"}
4
 
 
5
 
package require Tkspline
6
 
 
7
 
########################################################################
8
 
# splinetest.tcl - a test of spline rendering using the Tkspline extension
9
 
#
10
 
# John Ellson - ellson@graphviz.org 
11
 
########################################################################
12
 
 
13
 
# create canvas and frame for toolbar
14
 
pack [canvas .c -bg white -height 350] \
15
 
    -side top -fill both -expand true
16
 
pack [frame .f] -side top -fill x
17
 
 
18
 
proc nextpoint {c wx wy} {
19
 
    global id oldx oldy
20
 
 
21
 
    if {[info exists id]} {
22
 
        unset id
23
 
    } {
24
 
        set id [$c find withtag current]
25
 
        if {[string length $id] == 0} {
26
 
            # not a Point
27
 
            unset id
28
 
        } {
29
 
            # $id != {} so must be a Point because everything else is disabled
30
 
            set oldx [$c canvasx $wx]
31
 
            set oldy [$c canvasy $wy]
32
 
        }
33
 
    }
34
 
}
35
 
 
36
 
proc motion {c wx wy} {
37
 
    global id oldx oldy
38
 
    set x [$c canvasx $wx]
39
 
    set y [$c canvasy $wy]
40
 
    if [info exists id] {
41
 
        foreach {items idx} [$c gettags $id] {break}
42
 
        # update single coord in three variants of shape
43
 
        foreach itm [split $items .] {
44
 
               $c dchars $itm $idx
45
 
               $c insert $itm $idx [list $x $y]
46
 
        }
47
 
        # move control point
48
 
        $c move $id [expr $x - $oldx] [expr $y - $oldy]
49
 
    }
50
 
    set oldx $x
51
 
    set oldy $y
52
 
}
53
 
 
54
 
# itemwithcontrolpoints - create a "line" or "polygon" with
55
 
#    straight + spline + smooth  line variants and draggable 
56
 
#    control points.
57
 
#
58
 
# c = canvas handle
59
 
# item = "line" | "polygon"
60
 
# coords = x y x y ... list of control point locations
61
 
#
62
 
proc itemwithcontrolpoints {c item coords} {
63
 
    if {[string equal $item "line"]} {
64
 
        set opts {}
65
 
    } {
66
 
        set opts {-fill {} -outline black}
67
 
    }
68
 
    set lid [eval $c create $item $coords $opts \
69
 
        -state disabled -tag Line]
70
 
    set slid [eval $c create $item $coords $opts \
71
 
        -smooth true -state disabled -tag Smooth]
72
 
    set bzlid [eval $c create $item $coords $opts \
73
 
        -smooth spline -state disabled -tag Spline]
74
 
    set idx 0
75
 
    foreach {x y} $coords {
76
 
        set id [$c create oval -2 -2 2 2 \
77
 
            -fill yellow -outline black \
78
 
            -tags [list $lid.$slid.$bzlid $idx Point]]
79
 
        $c move $id $x $y 
80
 
        incr idx 2
81
 
    }
82
 
}
83
 
    
84
 
# show objects by type (from toolbar buttons)
85
 
proc show {typ show} {
86
 
    if {$show} {
87
 
        if {[string equal $typ "Point"]} {
88
 
            .c itemconfigure $typ -state normal
89
 
        } {
90
 
            .c itemconfigure $typ -state disabled
91
 
        }
92
 
    } {
93
 
        .c itemconfigure $typ -state hidden
94
 
    }
95
 
}
96
 
 
97
 
proc print {} {
98
 
    global tcl_platform
99
 
    if {[string equal $tcl_platform(platform) "windows"]} {
100
 
        # platform == "windows"
101
 
        if {[catch {package require Printer}] 
102
 
        && [catch {package require printer}]} {
103
 
            # Can't do this--no printer package
104
 
            puts stderr "No \"Printer\" package found"
105
 
        } {
106
 
            # Ask the user to select a printer
107
 
            set hdc [ printer dialog select ]
108
 
            # Now send raw postscript output to the device
109
 
            printer send -hdc $hdc -postscript \
110
 
                -data [.c postscript]
111
 
        }
112
 
    } {
113
 
        # platform != "windows" ... then probably unix
114
 
        set chan [open "| lpr" w]
115
 
        .c postscript -channel $chan
116
 
        close $chan
117
 
    }
118
 
}
119
 
 
120
 
# populate toolbar
121
 
foreach typ {Exit Print} {
122
 
    set cmd [string tolower $typ]
123
 
    pack [button .f.$cmd \
124
 
        -text $typ -width 6 -command $cmd \
125
 
        -padx 0 -pady 0 -width 6] \
126
 
            -side right
127
 
}
128
 
 
129
 
foreach typ {Line Smooth Spline Point} {
130
 
    pack [checkbutton .f.[string tolower $typ] \
131
 
        -text $typ -variable var$typ -width 6 \
132
 
        -selectcolor yellow -command "show $typ \$var$typ" \
133
 
        -indicatoron false] \
134
 
            -side left -fill both
135
 
    set var$typ 1
136
 
}
137
 
 
138
 
# mouse bindings on canvas objects
139
 
bind .c <1> "nextpoint .c %x %y"
140
 
bind .c <Motion> "motion .c %x %y"
141
 
 
142
 
# populate with demo objects
143
 
itemwithcontrolpoints .c line \
144
 
    {50 50 50 100 100 100 100 50 100 20 150 20 150 50}
145
 
itemwithcontrolpoints .c polygon \
146
 
    {50 200 100 150 150 200 150 250 100 300 50 250}
147
 
 
148
 
set help [.c create text 10 125 \
149
 
    -anchor w \
150
 
    -text "You can drag the points\nwith mouse button 1"]
151
 
after 5000 {.c delete $help}