blob: 3f1f25bef596f0cda4a38b56281ef500503d7445 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
#!/usr/bin/wish -f
load tkzinc3.1.so
package require Img
set top 1
set lw 8
set arrow "8 10 6"
#
# Cap Filled Border Relief Title
#
set show {\
{round f 1 flat CapRound}\
{butt f 1 flat CapButt}\
{projecting f 1 flat CapProjecting}\
{round f 1 sunken Sunken}\
{round f 1 raised Raised}\
{round f 1 groove Groove}\
{round f 1 ridge Ridge}\
{round t 1 sunken FilledSunken}\
{round t 1 raised FilledRaised}\
{round t 1 groove FilledGroove}\
{round t 1 ridge FilledRidge}\
{round t 0 flat Fill}\
{round t 1 flat FillBorder}}
image create photo logo -file /usr/share/toccata/images/logo.gif
#image create photo papier -file /usr/share/toccata/images/dgtexture-dragstrip.xpm
set r [zinc .r -backcolor gray -relief sunken]
pack .r -expand t -fill both
.r configure -width 1024 -height 800
.r scale $top 1 -1
#.r configure -drawbboxes t
set view [.r add group $top -tags controls]
#
# Create the model
#
set model [.r add group $view]
set mp [.r add bezier $model "50 -150 100 -50 270 -130 220 -200 200 -180 180 -300 140 -160 70 -300" \
-linecolor yellow -fillcolor tan -fillpattern AlphaStipple8 \
-tags "bezier" -linewidth $lw]
#.r add rectangle $model "50 -150 100 -50"
set bbox [.r transform $model [.r bbox $mp]]
set x [expr ([lindex $bbox 2] + [lindex $bbox 0]) / 2]
set y [expr [lindex $bbox 1] + 5]
.r add text $model -text "CapRound" -color blue -alignment center -anchor s -tags "title" \
-position "$x $y"
#
# Now clone for each variation on the polygon
#
set col 0
set row 0
foreach current $show {
foreach {cap filled border relief title} $current {
set grp [.r clone $model]
.r translate $grp [expr $col * 240] [expr $row * (-290 - (2 * $lw))]
.r itemconfigure [.r find withtag "bezier" $grp] \
-capstyle $cap -filled $filled \
-linewidth [expr $border ? $lw : 0] -relief $relief
.r itemconfigure [.r find withtag "title" $grp] -text $title
incr col
if {$col >= 4} {
set col 0
incr row
}
}
}
#
# Suppress the model
#
.r remove $model
#
# Some optional graphic features
set closed 0
#set smooth 0
set arrows none
proc toggle_arrows { } {
global arrows arrow
if {$arrows == "none"} {
set arrows first
set f $arrow
set l ""
} elseif {$arrows == "first"} {
set arrows last
set f ""
set l $arrow
} elseif {$arrows == "last"} {
set arrows both
set f $arrow
set l $arrow
} elseif {$arrows == "both"} {
set arrows none
set f ""
set l ""
}
.r itemconfigure bezier -firstend $f -lastend $l
}
proc toggle_closed { } {
global closed
set closed [expr ! $closed]
foreach curve [.r find withtag "bezier"] {
if {$closed} {
.r coords $curve add [.r coords $curve 0]
} {
.r coords $curve remove -1
}
}
}
focus .r
bind .r "<a>" toggle_arrows
bind .r "<c>" toggle_closed
source "controls.tcl"
|
