blob: e4454fe75581dc7dacff4549477f115dbfebdd1b (
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
|
# 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 .allOptions
catch {destroy $w}
toplevel $w
wm title $w "Zinc All Option Demonstration"
wm iconname $w "All options"
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
# The explanation displayed when running this demo
label $w.label -text "Click on one of the following\nbuttons to get a list of Item\nattributes (or zinc options)\nwith their types.\n" -justify "left"
pack $w.label -padx 10 -pady 10
# Creating the zinc widget
zinc $w.zinc -width 1 -height 1 -font "10x20" -borderwidth 0 -relief "sunken"
pack $w.zinc
# Creating an instance of every item type
#my %itemtypes;
# These Items have fields! So the number of fields must be given at creation time
foreach type {tabular track waypoint} {
set itemtypes($type) [$w.zinc add $type 1 0]
}
# These items needs no specific initial values
foreach type {group icon map reticle text window} {
set itemtypes($type) [$w.zinc add $type 1]
}
# These items needs some coordinates at creation time
# However curves usually needs more than 2 points.
foreach type {arc curve rectangle} {
set itemtypes($type) [$w.zinc add $type 1 "0 0 1 1"]
}
# Triangles item needs at least 3 points for the coordinates
foreach type {triangles} {
set itemtypes($type) [$w.zinc add $type 1 "0 0 1 1 2 2"]
}
proc showAllOptions { w type} {
global itemtypes
if [winfo exists .tl] {destroy .tl}
toplevel .tl
set title "All options of an item $type"
#my @option return
if {[string compare $type "zinc"]==0} {
set options [$w.zinc configure]
set typeopt "optionClass"
set readopt "defaultValue"
set title "All options of zinc widget"
} else {
set options [$w.zinc itemconfigure $itemtypes($type)];
set title "All attributes of an item $type"
set typeopt "Type"
set readopt "ReadOnly"
}
#.tl configure -title $title
frame .tl.f1
set bgcolor "ivory"
label .tl.f1.opt -text "Option" -background $bgcolor -relief "ridge" -width 20
label .tl.f1.typ -text $typeopt -background $bgcolor -relief "ridge" -width 20
label .tl.f1.rd -text $readopt -background $bgcolor -relief "ridge" -width 21
pack .tl.f1.opt .tl.f1.typ .tl.f1.rd -side left
set nbelem [llength $options]
frame .tl.f2
listbox .tl.f2.l1 -width 20 -height $nbelem
listbox .tl.f2.l2 -width 20 -height $nbelem
listbox .tl.f2.l3 -width 20 -height $nbelem
pack .tl.f2.l1 .tl.f2.l2 .tl.f2.l3 -side left
pack .tl.f1 .tl.f2 -side top -anchor "nw"
# Remplissage des list box
foreach elem $options {
.tl.f2.l1 insert end [lindex $elem 0]
.tl.f2.l2 insert end [lindex $elem 1]
.tl.f2.l3 insert end [lindex $elem 3]
}
}
pack [frame $w.col]
set width 0;
foreach type [lsort [array names itemtypes]] {
if {[string length $type] > $width} {
set width [string length $type]
}
}
foreach type [lsort [array names itemtypes]] {
button $w.col.$type -text "$type" -width $width -command {showAllOptions $w $type}
pack $w.col.$type -pady 4
}
button $w.col.b -text "zinc widget options" -command {showAllOptions $w "zinc"}
pack $w.col.b -pady 4
|
