blob: e377657fc902d209bd7ed49de71d443eb3531804 (
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
200
201
202
203
204
205
206
207
208
209
210
211
|
package provide dialog_gatom 0.1
package require wheredoesthisgo
namespace eval ::dialog_gatom:: {
namespace export pdtk_gatom_dialog
}
# hashtable for communicating the position of the radiobuttons (Tk's
# radiobutton widget requires this to be global)
global gatomlabel_position
############ pdtk_gatom_dialog -- run a gatom dialog #########
# dialogs like this one can come up in many copies; but in TK the easiest
# way to get data from an "entry", etc., is to set an associated variable
# name. This is especially true for grouped "radio buttons". So we have
# to synthesize variable names for each instance of the dialog. The dialog
# gets a TK pathname $id, from which it strips the leading "." to make a
# variable suffix $vid. Then you can get the actual value out by asking for
# [eval concat $$variablename]. There should be an easier way but I don't see
# it yet.
proc ::dialog_gatom::escape {sym} {
if {[string length $sym] == 0} {
set ret "-"
} else {
if {[string equal -length 1 $sym "-"]} {
set ret [string replace $sym 0 0 "--"]
} else {
set ret [string map {"$" "#"} $sym]
}
}
return [unspace_text $ret]
}
proc ::dialog_gatom::unescape {sym} {
if {[string equal -length 1 $sym "-"]} {
set ret [string replace $sym 0 0 ""]
} else {
set ret [string map {"#" "$"} $sym]
}
return $ret
}
proc gatom_apply {mytoplevel} {
# TODO kludge!! until a common approach to ::pd_bindings::panel_bindings
# is sorted out
::dialog_gatom::apply $mytoplevel
}
proc ::dialog_gatom::apply {mytoplevel} {
global gatomlabel_position
pdsend "$mytoplevel param \
[$mytoplevel.width.entry get] \
[$mytoplevel.limits.lower.entry get] \
[$mytoplevel.limits.upper.entry get] \
[::dialog_gatom::escape [$mytoplevel.gatomlabel.name.entry get]] \
$gatomlabel_position($mytoplevel) \
[::dialog_gatom::escape [$mytoplevel.s_r.send.entry get]] \
[::dialog_gatom::escape [$mytoplevel.s_r.receive.entry get]]"
}
proc gatom_cancel {mytoplevel} {
# TODO kludge!! until a common approach to ::pd_bindings::panel_bindings
# is sorted out
::dialog_gatom::cancel $mytoplevel
}
proc ::dialog_gatom::cancel {mytoplevel} {
pdsend "$mytoplevel cancel"
}
proc gatom_ok {mytoplevel} {
# TODO kludge!! until a common approach to ::pd_bindings::panel_bindings
# is sorted out
::dialog_gatom::ok $mytoplevel
}
proc ::dialog_gatom::ok {mytoplevel} {
::dialog_gatom::apply $mytoplevel
::dialog_gatom::cancel $mytoplevel
}
# set up the panel with the info from pd
proc ::dialog_gatom::pdtk_gatom_dialog {mytoplevel initwidth initlower \
initupper initgatomlabel_position initgatomlabel initsend initreceive} {
global gatomlabel_position
set gatomlabel_position($mytoplevel) $initgatomlabel_position
if {[winfo exists $mytoplevel]} {
wm deiconify $mytoplevel
raise $mytoplevel
} else {
create_panel $mytoplevel
}
$mytoplevel.width.entry insert 0 $initwidth
$mytoplevel.limits.lower.entry insert 0 $initlower
$mytoplevel.limits.upper.entry insert 0 $initupper
if {$initgatomlabel ne "-"} {
$mytoplevel.gatomlabel.name.entry insert 0 $initgatomlabel
}
set gatomlabel_position($mytoplevel) $initgatomlabel_position
if {$initsend ne "-"} {
$mytoplevel.s_r.send.entry insert 0 $initsend
}
if {$initreceive ne "-"} {
$mytoplevel.s_r.receive.entry insert 0 $initreceive
}
}
proc ::dialog_gatom::create_panel {mytoplevel} {
global gatomlabel_position
toplevel $mytoplevel
wm title $mytoplevel "atom box properties"
wm resizable $mytoplevel 0 0
catch { # not all platforms/Tcls versions have these options
wm attributes $mytoplevel -topmost 1
#wm attributes $mytoplevel -transparent 1
#$mytoplevel configure -highlightthickness 1
}
wm protocol $mytoplevel WM_DELETE_WINDOW "::dialog_gatom::cancel $mytoplevel"
::pd_bindings::panel_bindings $mytoplevel "gatom"
frame $mytoplevel.width -height 7
pack $mytoplevel.width -side top
label $mytoplevel.width.label -text "width"
entry $mytoplevel.width.entry -width 4
pack $mytoplevel.width.label $mytoplevel.width.entry -side left
labelframe $mytoplevel.limits -text "limits" -padx 15 -pady 4 -borderwidth 1 \
-font highlight_font
pack $mytoplevel.limits -side top -fill x
frame $mytoplevel.limits.lower
pack $mytoplevel.limits.lower -side left
label $mytoplevel.limits.lower.label -text "lower"
entry $mytoplevel.limits.lower.entry -width 8
pack $mytoplevel.limits.lower.label $mytoplevel.limits.lower.entry -side left
frame $mytoplevel.limits.upper
pack $mytoplevel.limits.upper -side left
frame $mytoplevel.limits.upper.spacer -width 20
label $mytoplevel.limits.upper.label -text "upper"
entry $mytoplevel.limits.upper.entry -width 8
pack $mytoplevel.limits.upper.spacer $mytoplevel.limits.upper.label \
$mytoplevel.limits.upper.entry -side left
frame $mytoplevel.spacer1 -height 7
pack $mytoplevel.spacer1 -side top
labelframe $mytoplevel.gatomlabel -text "label" -padx 5 -pady 4 -borderwidth 1 \
-font highlight_font
pack $mytoplevel.gatomlabel -side top -fill x
frame $mytoplevel.gatomlabel.name
pack $mytoplevel.gatomlabel.name -side top
entry $mytoplevel.gatomlabel.name.entry -width 33
pack $mytoplevel.gatomlabel.name.entry -side left
frame $mytoplevel.gatomlabel.radio
pack $mytoplevel.gatomlabel.radio -side top
radiobutton $mytoplevel.gatomlabel.radio.left -value 0 -text "left " \
-variable gatomlabel_position($mytoplevel) -justify left -takefocus 0
radiobutton $mytoplevel.gatomlabel.radio.right -value 1 -text "right" \
-variable gatomlabel_position($mytoplevel) -justify left -takefocus 0
radiobutton $mytoplevel.gatomlabel.radio.top -value 2 -text "top" \
-variable gatomlabel_position($mytoplevel) -justify left -takefocus 0
radiobutton $mytoplevel.gatomlabel.radio.bottom -value 3 -text "bottom" \
-variable gatomlabel_position($mytoplevel) -justify left -takefocus 0
pack $mytoplevel.gatomlabel.radio.left -side left -anchor w
pack $mytoplevel.gatomlabel.radio.right -side right -anchor w
pack $mytoplevel.gatomlabel.radio.top -side top -anchor w
pack $mytoplevel.gatomlabel.radio.bottom -side bottom -anchor w
frame $mytoplevel.spacer2 -height 7
pack $mytoplevel.spacer2 -side top
labelframe $mytoplevel.s_r -text "messages" -padx 5 -pady 4 -borderwidth 1 \
-font highlight_font
pack $mytoplevel.s_r -side top -fill x
frame $mytoplevel.s_r.send
pack $mytoplevel.s_r.send -side top -anchor e
label $mytoplevel.s_r.send.label -text "send symbol"
entry $mytoplevel.s_r.send.entry -width 21
pack $mytoplevel.s_r.send.entry $mytoplevel.s_r.send.label -side right
frame $mytoplevel.s_r.receive
pack $mytoplevel.s_r.receive -side top -anchor e
label $mytoplevel.s_r.receive.label -text "receive symbol"
entry $mytoplevel.s_r.receive.entry -width 21
pack $mytoplevel.s_r.receive.entry $mytoplevel.s_r.receive.label -side right
frame $mytoplevel.buttonframe -pady 5
pack $mytoplevel.buttonframe -side top -fill x -pady 2m
button $mytoplevel.buttonframe.cancel -text {Cancel} \
-command "::dialog_gatom::cancel $mytoplevel"
pack $mytoplevel.buttonframe.cancel -side left -expand 1
button $mytoplevel.buttonframe.apply -text {Apply} \
-command "::dialog_gatom::apply $mytoplevel"
pack $mytoplevel.buttonframe.apply -side left -expand 1
button $mytoplevel.buttonframe.ok -text {OK} \
-command "::dialog_gatom::ok $mytoplevel"
pack $mytoplevel.buttonframe.ok -side left -expand 1
$mytoplevel.width.entry select from 0
$mytoplevel.width.entry select adjust end
focus $mytoplevel.width.entry
}
|
