blob: 97cd3624d0f85c30847fab29dd8161067fa818a7 (
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
|
# 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 .atomicGroups
catch {destroy $w}
toplevel $w
wm title $w "Zinc Atomicity Demonstration"
wm iconname $w "Atomic"
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
zinc $w.zinc -width 500 -height 350 -font "10x20" -borderwidth 0
pack $w.zinc
set groups_group_atomicity 0
set red_group_atomicity 0
set green_group_atomicity 0
set display_clipping_item_background 0
set clip 1
$w.zinc add "text" 1 -font $defaultfont -text "- There are 3 groups: a red group containing 2 redish objects\na green group containing 2 greenish objects,\nand groups_group containing both previous groups.\n- You can make some groups atomic or not by depressing \nthe toggle buttons at the bottom of the window\n- Try and then click on some items to observe that callbacks\n are then different: they modify either the item, or 2 items of\n a group or all items" -anchor "nw" -position "10 10"
############### creating the top group with its bindings ###############################
set groups_group [$w.zinc add group 1 -visible 1 -atomic $groups_group_atomicity -tags groups_group]
# the following callbacks will be called only if "groups_group" IS atomic
$w.zinc bind $groups_group <1> modify_bitmap_bg
$w.zinc bind $groups_group <ButtonRelease-1> modify_bitmap_bg
############### creating the red_group, with its binding and its content ################
# the red_group may be atomic, that is is makes all children as a single object
# and sensitive to red_group callbacks
set red_group [$w.zinc add group $groups_group -visible 1 -atomic $red_group_atomicity -sensitive 1 -tags red_group]
# the following callbacks will be called only if "groups_group" IS NOT-atomic
# and if "red_group" IS atomic
$w.zinc bind $red_group <1> "modify_item_lines $red_group"
$w.zinc bind $red_group <ButtonRelease-1> "modify_item_lines $red_group"
set rc [$w.zinc add arc $red_group {100 200 140 240} -filled 1 -fillcolor red2 -linewidth 3 -linecolor white -tags red_circle]
set rr [$w.zinc add rectangle $red_group {300 200 400 250} -filled 1 -fillcolor red2 -linewidth 3 -linecolor white -tags red_rectangle]
# the following callbacks will be called only if "groups_group" IS NOT atomic
# and if "red_group" IS NOT atomic
$w.zinc bind $rc <1> toggle_color
$w.zinc bind $rc <ButtonRelease-1> toggle_color
$w.zinc bind $rr <1> toggle_color
$w.zinc bind $rr <ButtonRelease-1> toggle_color
############### creating the green_group, with its binding and its content ################
# the green_group may be atomic, that is is makes all children as a single object
# and sensitive to green_group callbacks
set green_group [$w.zinc add group $groups_group -visible 1 -atomic $green_group_atomicity -sensitive 1 -tags green_group]
# the following callbacks will be called only if "groups_group" IS NOT atomic
# and if "green_group" IS atomic
$w.zinc bind $green_group <1> "modify_item_lines $green_group"
$w.zinc bind $green_group <ButtonRelease-1> "modify_item_lines $green_group"
set gc [$w.zinc add arc $green_group {100 270 140 310} -filled 1 -fillcolor green2 -linewidth 3 -linecolor white -tags green_circle]
set gr [$w.zinc add rectangle $green_group {300 270 400 320} -filled 1 -fillcolor green2 -linewidth 3 -linecolor white -tags green_rectangle]
# the following callbacks will be called only if "groups_group" IS NOT atomic
# and if "green_group" IS NOT atomic
$w.zinc bind $gc <1> toggle_color
$w.zinc bind $gc <ButtonRelease-1> toggle_color
$w.zinc bind $gr <1> toggle_color
$w.zinc bind $gr <ButtonRelease-1> toggle_color
set current_bg ""
###################### groups_group callback ##############
proc modify_bitmap_bg {} {
global current_bg
global rc rr gc gr
global w
if {$current_bg=="AlphaStipple2"} {
set current_bg {}
} else {
set current_bg AlphaStipple2
}
foreach item "$rc $rr $gc $gr" {
$w.zinc itemconfigure $item -fillpattern $current_bg
}
}
#################### red/green_group callback ##############
proc modify_item_lines {gr} {
global w
set children [$w.zinc find withtag ".$gr*"]
# we are using a pathtag (still undocumented feature of 3.2.6) to get items of an atomic group!
# we could also temporary modify the groups (make it un-atomic) to get its child
set current_linewidth [$w.zinc itemcget [lindex $children 0] -linewidth]
if {$current_linewidth == 3} {
set current_linewidth 0
} else {
set current_linewidth 3
}
foreach item $children {
$w.zinc itemconfigure $item -linewidth $current_linewidth
}
}
##################### items callback ######################
proc toggle_color {} {
global w
set item [$w.zinc find withtag current]
set fillcolor [$w.zinc itemcget $item -fillcolor]
regexp {([a-z]+)(\d)} $fillcolor "" color num
#my ($color $num) = $fillcolor =~ /("a-z"+)(\d)/
if {$num == 2} {
set val 1
set num 4
} else {
set num 2
}
$w.zinc itemconfigure $item -fillcolor "$color$num"
}
proc atomic_or_not {gr} {
global w
set val [lindex [$w.zinc itemconfigure $gr -atomic] 4]
if {$val==1} {
$w.zinc itemconfigure $gr -atomic 0
} else {
$w.zinc itemconfigure $gr -atomic 1
}
update_found_items
}
###################### toggle buttons at the bottom ####
frame $w.row
pack $w.row
checkbutton $w.row.cb -text "groups_group is atomic" -variable groups_group_atomicity -command "atomic_or_not $groups_group"
pack $w.row.cb -anchor "w"
checkbutton $w.row.cb2 -text "red group is atomic" -foreground red4 -variable red_group_atomicity -command "atomic_or_not $red_group"
pack $w.row.cb2 -anchor w
checkbutton $w.row.cb3 -text "green group is atomic" -foreground green4 -variable green_group_atomicity -command "atomic_or_not $green_group"
pack $w.row.cb3 -anchor w
label $w.row.lb
pack $w.row.lb -anchor w
label $w.row.lb2 -text "Following command $w.zinc find overlapping 0 200 500 400 returns:"
pack $w.row.lb2 -anchor w
set label [pack [label $w.row.label -background gray95] -anchor w]
##### to update the list of enclosed items
proc update_found_items {} {
global w
set found [$w.zinc find overlapping 0 200 500 400]
set str ""
foreach item $found {
set tags [$w.zinc itemcget $item -tags]
set str "$str $tags"
}
$w.row.label configure -text $str
}
# to init the list of enclosed items
update_found_items
|
