blob: 435a581e1e7541049d951bf02894071ac01287bd (
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
|
# 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 .clipping
catch {destroy $w}
toplevel $w
wm title $w "Zinc Clipping Demonstration"
wm iconname $w "Clipping"
set defaultfont [font create -family Helvetica -size 10 -weight bold]
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 700 -height 600 -font 10x20 -borderwidth 3 -relief sunken
pack $w.zinc
set display_clipping_item_background 0
set clip 1
$w.zinc add text 1 -font $defaultfont -text "You can drag and drop the objects.\nThere are two groups of objects a tan group and a blue group\nTry to move them and discover the clipping area which is a curve.\nwith two contours" -anchor nw -position {10 10}
set clipped_group [$w.zinc add group 1 -visible 1]
set clipping_item [$w.zinc add curve $clipped_group {10 100 690 100 690 590 520 350 350 590 180 350 10 590} -closed 1 -priority 1 -fillcolor tan2 -linewidth 0 -filled $display_clipping_item_background]
$w.zinc contour $clipping_item add +1 {200 200 500 200 500 250 200 250}
############### creating the tan_group objects ################
# the tan_group is atomic that is is makes all children as a single object
# and sensitive to tan_group callbacks
set tan_group [$w.zinc add group $clipped_group -visible 1 -atomic 1 -sensitive 1]
$w.zinc add arc $tan_group {200 220 280 300} -filled 1 -linewidth 1 -startangle 45 -extent 270 -pieslice 1 -closed 1 -fillcolor tan
$w.zinc add curve $tan_group {400 400 440 450 400 500 500 500 460 450 500 400} -filled 1 -fillcolor tan -linecolor tan
############### creating the blue_group objects ################
# the blue_group is atomic too that is is makes all children as a single object
# and sensitive to blue_group callbacks
set blue_group [$w.zinc add group $clipped_group -visible 1 -atomic 1 -sensitive 1]
$w.zinc add rectangle $blue_group {570 180 470 280} -filled 1 -linewidth 1 -fillcolor blue2
$w.zinc add curve $blue_group {200 400 200 500 300 500 300 400 300 300} -filled 1 -fillcolor blue -linewidth 0
$w.zinc itemconfigure $clipped_group -clip $clipping_item
###################### drag and drop callbacks ############
# for both tan_group and blue_group
$w.zinc bind $tan_group <1> "itemStartDrag $tan_group %x %y"
$w.zinc bind $tan_group <B1-Motion> "itemDrag $tan_group %x %y"
$w.zinc bind $blue_group <1> "itemStartDrag $blue_group %x %y"
$w.zinc bind $blue_group <B1-Motion> "itemDrag $blue_group %x %y"
# callback for starting a drag
set x_orig ""
set y_orig ""
proc itemStartDrag {item x y} {
global x_orig y_orig
set x_orig $x
set y_orig $y
}
# Callback for moving an item
proc itemDrag {item x y} {
global x_orig y_orig
global w
$w.zinc translate $item [expr $x-$x_orig] [expr $y-$y_orig];
set x_orig $x;
set y_orig $y;
}
###################### toggle buttons at the bottom #######
frame $w.row
pack $w.row
checkbutton $w.row.show -text "Show clipping item" -variable display_clipping_item_background -command "display_clipping_area"
checkbutton $w.row.clip -text Clip -variable clip -command "clipcommand "
pack $w.row.show $w.row.clip
proc display_clipping_area {} {
global clipping_item
global w
global display_clipping_item_background
$w.zinc itemconfigure $clipping_item -filled $display_clipping_item_background
}
proc clipcommand {} {
global clip
global clipped_group
global clipping_item
global w
if {$clip} {
$w.zinc itemconfigure $clipped_group -clip $clipping_item
} else {
$w.zinc itemconfigure $clipped_group -clip ""
}
}
|
