aboutsummaryrefslogtreecommitdiff
path: root/demos/curveBezier.tcl
blob: e8f66710bc7eeedb55a22f585f71ab4b49a1ff66 (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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
# these simple samples have been developped by C. Mertz mertz@cena.fr in perl
# tcl version by Jean-Paul Imbert imbert@cena.fr

if {![info exists zincDemo]} {
    error "This script should be run from the zinc-widget demo."
}


set w .curve_bezier
catch {destroy $w}
toplevel $w
wm title $w "Zinc Curve Bezier Demonstration"
wm iconname $w Curve

set defaultfont "-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*"

frame $w.buttons
pack $w.buttons -side bottom -fill x -pady 2m
button $w.buttons.dismiss -text Dismiss -command "destroy $w"
button $w.buttons.code -text "See Code" -command "showCode $w"
pack $w.buttons.dismiss $w.buttons.code -side left -expand 1


text $w.text -relief sunken -borderwidth 2 -setgrid true -height 3
pack $w.text -expand yes -fill both

$w.text insert 0.0 {
6 examples of curves containing control points are displayed 
 with the list of control points written just below.
You can move the handles to modify the bezier curves
}

zinc $w.zinc -width 700 -height 650 -font 9x15 -borderwidth 0 -backcolor white
pack $w.zinc


set group [$w.zinc add group 1]

$w.zinc add text $group -position {50 20} -anchor w -text "Examples of curve items using cubic bezier control points" -color grey20

## Please note: much of the following items below could be computed
$w.zinc add curve $group {100 200 100 100} -tags {line1 l1-2} -linecolor \#888888 -filled 0 -linewidth 2
$w.zinc add curve $group {400 100 400 200} -tags {line1 l3-4} -linecolor \#888888 -filled 0 -linewidth 2
$w.zinc add curve $group {{100 200} {100 100 c} {400 100 c} {400 200}} -tags {bezier1} -closed 0 -linecolor red -linewidth 5
$w.zinc add arc $group {90 190 110 210} -tags {handle1 p1} -filled 1 -fillcolor \#BBBBBB
$w.zinc add arc $group {90 90 110 110} -tags {handle1 p2} -filled 1 -linewidth 0 -fillcolor grey80 -filled 1
$w.zinc add arc $group {390 90 410 110} -tags {handle1 p3} -filled 1 -linewidth 0 -fillcolor grey80 -filled 1
$w.zinc add arc $group {390 190 410 210} -tags {handle1 p4} -filled 1 -fillcolor \#BBBBBB

$w.zinc add curve $group {600 200 675 100} -tags {line2 l1-2} -linecolor \#888888 -linewidth 2
$w.zinc add curve $group {975 100 900 200} -tags {line2 l3-4} -linecolor \#888888 -linewidth 2
$w.zinc add curve $group {{600 200} {675 100 c} {975 100 c} {900 200}} -tags {bezier2} -closed 0 -linecolor red -linewidth 5
$w.zinc add arc $group {590 190 610 210} -tags {handle2 p1} -filled 1 -linecolor grey80 -linewidth 2
$w.zinc add arc $group {665 90 685 110} -tags {handle2 p2} -filled 1 -linewidth 0 -fillcolor grey80
$w.zinc add arc $group {965 90 985 110} -tags {handle2 p3} -filled 1 -linewidth 0 -fillcolor grey80
$w.zinc add arc $group {890 190 910 210} -tags {handle2 p4} -filled 1 -linecolor grey80 -linewidth 2

$w.zinc add curve $group {100 500 25 400} -tags {line3 l1-2} -linecolor \#888888 -linewidth 2
$w.zinc add curve $group {475 400 400 500} -tags {line3 l3-4} -linecolor \#888888 -linewidth 2
$w.zinc add curve $group {{100 500} {25 400 c} {475 400 c} {400 500}} -tags {bezier3} -closed 0 -linecolor red -linewidth 5
$w.zinc add arc $group {90 490 110 510} -tags {handle3 p1} -filled 1 -linecolor grey80 -linewidth 2
$w.zinc add arc $group {15 390 35 410} -tags {handle3 p2} -filled 1 -linewidth 0 -fillcolor grey80 
$w.zinc add arc $group {465 390 485 410} -tags {handle3 p3} -filled 1 -linewidth 0 -fillcolor grey80 
$w.zinc add arc $group {390 490 410 510} -tags {handle3 p4} -filled 1 -linecolor grey80 -linewidth 2

#$w.zinc add "text" $group -position {570 570} -anchor w -tags {"bezier4"} -color "grey20"
$w.zinc add curve $group {600 500 600 350} -tags {line4 l1-2} -linecolor \#888888 -linewidth 2
$w.zinc add curve $group {900 650 900 500} -tags {line4 l3-4} -linecolor \#888888 -linewidth 2
$w.zinc add curve $group {{600 500} {600 350 c} {900 650 c} {900 500}} -tags {bezier4} -closed 0 -linecolor red -linewidth 5
$w.zinc add arc $group {590 490 610 510} -tags {handle4 p1} -filled 1 -linecolor grey80 -linewidth 2
$w.zinc add arc $group {590 340 610 360} -tags {handle4 p2} -filled 1 -linewidth 0 -fillcolor grey80
$w.zinc add arc $group {890 640 910 660} -tags {handle4 p3} -filled 1 -linewidth 0 -fillcolor grey80
$w.zinc add arc $group {890 490 910 510} -tags {handle4 p4} -filled 1 -linecolor grey80 -linewidth 2

$w.zinc add curve $group {100 800 175 700} -tags {line5 l1-2} -linecolor \#888888 -filled 0 -linewidth 2
$w.zinc add curve $group {325 700 400 800} -tags {line5 l3-4} -linecolor \#888888 -filled 0 -linewidth 2
$w.zinc add curve $group {{100 800} {175 700 c} {325 700 c} {400 800}} -tags {bezier5} -closed 0 -linecolor red -linewidth 5
$w.zinc add arc $group {90 790 110 810} -tags {handle5 p1} -filled 1 -linecolor grey80 -linewidth 2
$w.zinc add arc $group {165 690 185 710} -tags {handle5 p2} -filled 1 -linewidth 0 -fillcolor grey80 -filled 1
$w.zinc add arc $group {315 690 335 710} -tags {handle5 p3} -filled 1 -linewidth 0 -fillcolor grey80 -filled 1
$w.zinc add arc $group {390 790 410 810} -tags {handle5 p4} -filled 1 -linecolor grey80 -linewidth 2

$w.zinc add curve $group {600 800 625 700} -tags {line6 l1-2} -linecolor \#888888 -linewidth 2
$w.zinc add curve $group {725 700 750 800} -tags {line6 l3-4} -linecolor \#888888 -linewidth 2
$w.zinc add curve $group {750 800 775 900} -tags {line6 l4-5} -linecolor \#888888 -linewidth 2
$w.zinc add curve $group {875 900 900 800} -tags {line6 l6-7} -linecolor \#888888 -linewidth 2
$w.zinc add curve $group {{600 800} {625 700 c} {725 700 c} {750 800} {775 900 c} {875 900 c} {900 800}} -tags {bezier6} -filled 0 -closed 0 -linecolor red -linewidth 5
$w.zinc add arc $group {590 790 610 810} -tags {handle6 p1} -filled 1 -linecolor grey80 -linewidth 2
$w.zinc add arc $group {615 690 635 710} -tags {handle6 p2} -filled 1 -linewidth 0 -fillcolor grey80
$w.zinc add arc $group {715 690 735 710} -tags {handle6 p3} -filled 1 -linewidth 0 -fillcolor grey80
$w.zinc add arc $group {740 790 760 810} -tags {handle6 p4} -filled 1 -linecolor blue -fillcolor blue -linewidth 2
$w.zinc add arc $group {766 891 784 909} -tags {handle6 p5} -filled 1 -linecolor grey80 -linewidth 4
$w.zinc add arc $group {865 890 885 910} -tags {handle6 p6} -filled 1 -linewidth 0 -fillcolor grey80
$w.zinc add arc $group {890 790 910 810} -tags {handle6 p7} -filled 1 -linecolor grey80 -linewidth 2

$w.zinc add text $group -position {25 980} -anchor w -tags coords -color grey20


$w.zinc scale $group 0.6 0.6

## Set the text of the text item with a tag "tag"
## to a human-readable form of the coords of the
## corresponding curve with the same tag "tag"
proc setText {tag} {
    global w
    set textItem  [$w.zinc find withtype text coords]
    set curveItem [$w.zinc find withtype curve $tag]
    set coords [$w.zinc coords $curveItem]
    set count 0
    $w.zinc itemconfigure $textItem -text $coords
}

foreach bezierCount {1 2 3 4 5 6} {
    set setText "bezier$bezierCount"
    set curveItem [$w.zinc find withtype curve "bezier$bezierCount"]
    set coords [$w.zinc coords $curveItem]
    #puts "$bezierCount : $curveItem : $coords"
    $w.zinc bind "handle$bezierCount" <1> {itemStartDrag %x %y}
    $w.zinc bind "handle$bezierCount" <B1-Motion> {itemDrag %x %y}
    #$w.zinc bind "handle$bezierCount" "<ButtonPress-1>" {\&press \&motion}
    #$w.zinc bind "handle$bezierCount" "<ButtonRelease-1>" {\&release}
}




##### bindings for moving the handles
set item ""
set bezierNum "" 
set ptNum ""

set x_orig ""
set y_orig ""

proc itemStartDrag {x y} {
    global w
    global x_orig y_orig
    global bezierNum ptNum
    global item
    set x_orig $x
    set y_orig $y
    set item [$w.zinc find withtag current]
    
    foreach val [$w.zinc gettags $item] {
	regexp {([a-z]+)(\d)} $val "" name num
	if {$name=="handle"} {set bezierNum $num}
	if {$name=="p"} {set ptNum $num}
    }
    #puts "bezierNum=$bezierNum ptNum=$ptNum"
}

# Callback for moving an item
proc itemDrag {x y} {
    global x_orig y_orig
    global w
    global item
    $w.zinc transform $item "[expr $x-$x_orig] [expr $y-$y_orig]"
    moveHandle [expr $x-$x_orig] [expr $y-$y_orig]
    set x_orig $x;
    set y_orig $y;
}


proc moveHandle {dx dy} {
    global w
    global bezierNum
    global ptNum
    global item
    set pt1 [lindex [$w.zinc coords $item] 0]
    set pt2 [lindex [$w.zinc coords $item] 1]
    
    ## modifying the handle coords
    $w.zinc coords $item "[expr [lindex $pt1 0]+$dx] [expr [lindex $pt1 1]+$dy] [expr [lindex $pt2 0]+$dx] [expr [lindex $pt2 1]+$dy]"
    set prevPtNum [expr $ptNum-1]
    
    # there should only be one such item!
    set lineA [$w.zinc find withtag "line$bezierNum && l$prevPtNum-$ptNum"]
    if {$lineA!=""} {
	set x [lindex [$w.zinc coords $lineA 0 1] 0]
	set y [lindex [$w.zinc coords $lineA 0 1] 1]
	$w.zinc coords $lineA 0 1 "[expr $x+$dx] [expr $y+$dy]"
    }
    
    set nextPtNum [expr $ptNum+1]
    # there should only be one such item:
    set lineB [$w.zinc find withtag "line$bezierNum && l$ptNum-$nextPtNum"]
    if {$lineB!=""} {
	set x [lindex [$w.zinc coords $lineB 0 0] 0]
	set y [lindex [$w.zinc coords $lineB 0 0] 1]
	$w.zinc coords $lineB 0 0 "[expr $x+$dx] [expr $y+$dy]"
    }
    set tab [$w.zinc coords "bezier$bezierNum" 0 [expr $ptNum-1]]
    set x [lindex $tab 0]
    set y [lindex $tab 1]
    set control [lindex $tab 2]
    $w.zinc coords "bezier$bezierNum" 0 [expr $ptNum-1] "[expr $x+$dx] [expr $y+$dy] $control"
    setText "bezier$bezierNum"  
}