diff options
author | Wincent Balin <wincent@rockbox.org> | 2010-06-03 00:39:13 +0000 |
---|---|---|
committer | Wincent Balin <wincent@rockbox.org> | 2010-06-03 00:39:13 +0000 |
commit | c1ae4414d4ac6504992434b949b252c30daf0c48 (patch) | |
tree | 696c5781e9a00cea694117eb3ef404d37f10930e /apps/plugins/pdbox/PDa/src/u_main.tk | |
parent | 5edd8cf736232a240e2f4f47eb847e1901d18379 (diff) | |
download | rockbox-c1ae4414d4ac6504992434b949b252c30daf0c48.tar.gz rockbox-c1ae4414d4ac6504992434b949b252c30daf0c48.zip |
pdbox: Source cleanup. Removed unneeded files.
git-svn-id: svn://svn.rockbox.org/rockbox/trunk@26497 a1c6a512-1295-4272-9138-f99709370657
Diffstat (limited to 'apps/plugins/pdbox/PDa/src/u_main.tk')
-rw-r--r-- | apps/plugins/pdbox/PDa/src/u_main.tk | 3368 |
1 files changed, 0 insertions, 3368 deletions
diff --git a/apps/plugins/pdbox/PDa/src/u_main.tk b/apps/plugins/pdbox/PDa/src/u_main.tk deleted file mode 100644 index e8d5702f32..0000000000 --- a/apps/plugins/pdbox/PDa/src/u_main.tk +++ /dev/null | |||
@@ -1,3368 +0,0 @@ | |||
1 | set pd_nt 1 | ||
2 | # (The above is 0 for unix, 1 for microsoft, and 2 for Mac OSX. The first | ||
3 | # line is automatically munged by the relevant makefiles.) | ||
4 | |||
5 | # Copyright (c) 1997-1999 Miller Puckette. | ||
6 | # For information on usage and redistribution, and for a DISCLAIMER OF ALL | ||
7 | # WARRANTIES, see the file, "LICENSE.txt," in this distribution. | ||
8 | |||
9 | # changed by Thomas Musil 09.2001 | ||
10 | # between "pdtk_graph_dialog -- dialog window for graphs" | ||
11 | # and "pdtk_array_dialog -- dialog window for arrays" | ||
12 | # a new dialogbox was inserted, named: | ||
13 | # "pdtk_iemgui_dialog -- dialog window for iem guis" | ||
14 | # | ||
15 | # all this changes are labeled with #######iemlib########## | ||
16 | |||
17 | # Tearoff is set to true by default: | ||
18 | set pd_tearoff 0 | ||
19 | set menubar 1 | ||
20 | |||
21 | set File "F" | ||
22 | set Windows "W" | ||
23 | set Edit "E" | ||
24 | set Find "F" | ||
25 | set Put "P" | ||
26 | set Media "M" | ||
27 | set Help "H" | ||
28 | |||
29 | set color grey16 | ||
30 | set lightcolor grey24 | ||
31 | |||
32 | option add *font -*-helvetica-*--bold--9-* | ||
33 | |||
34 | # los colores de la muerte | ||
35 | |||
36 | option add *background $color | ||
37 | option add *activeBackground $lightcolor | ||
38 | |||
39 | option add *foreground white | ||
40 | option add *activeForeground white | ||
41 | |||
42 | option add *troughColor $lightcolor | ||
43 | |||
44 | option add *highlightThickness 0 | ||
45 | option add *relief solid startupFile | ||
46 | |||
47 | if {$pd_nt == 1} { | ||
48 | global pd_guidir | ||
49 | global pd_tearoff | ||
50 | set pd_gui2 [string range $argv0 0 [expr [string last \\ $argv0 ] - 1]] | ||
51 | regsub -all \\\\ $pd_gui2 / pd_gui3 | ||
52 | set pd_guidir $pd_gui3/.. | ||
53 | load $pd_guidir/bin/pdtcl | ||
54 | set pd_tearoff 1 | ||
55 | } | ||
56 | |||
57 | if {$pd_nt == 2} { | ||
58 | global pd_guidir | ||
59 | global pd_tearoff | ||
60 | set pd_gui2 [string range $argv0 0 [expr [string last / $argv0 ] - 1]] | ||
61 | set pd_guidir $pd_gui2/.. | ||
62 | load $pd_guidir/bin/pdtcl | ||
63 | set pd_tearoff 0 | ||
64 | } | ||
65 | |||
66 | # hack so you can easily test-run this script in linux... define pd_guidir | ||
67 | # (which is normally defined at startup in pd under linux...) | ||
68 | |||
69 | if {$pd_nt == 0} { | ||
70 | if {! [info exists pd_guidir]} { | ||
71 | global pd_guidir | ||
72 | puts stderr {setting pd_guidir to '.'} | ||
73 | set pd_guidir . | ||
74 | } | ||
75 | } | ||
76 | |||
77 | # it's unfortunate but we seem to have to turn off global bindings | ||
78 | # for Text objects to get control-s and control-t to do what we want for | ||
79 | # "text" dialogs below. Also we have to get rid of tab's changing the focus. | ||
80 | |||
81 | bind all <Key-Tab> "" | ||
82 | bind all <<PrevWindow>> "" | ||
83 | bind Text <Control-t> {} | ||
84 | bind Text <Control-s> {} | ||
85 | # puts stderr [bind all] | ||
86 | |||
87 | ################## set up main window ######################### | ||
88 | menu .mbar | ||
89 | canvas .dummy -height 2p -width 6c | ||
90 | |||
91 | frame .controls | ||
92 | pack .controls .dummy -side top -fill x | ||
93 | menu .mbar.file -tearoff $pd_tearoff | ||
94 | .mbar add cascade -label "$File" -menu .mbar.file | ||
95 | menu .mbar.find -tearoff $pd_tearoff | ||
96 | .mbar add cascade -label "$Find" -menu .mbar.find | ||
97 | menu .mbar.windows -postcommand [concat pdtk_fixwindowmenu] -tearoff $pd_tearoff | ||
98 | menu .mbar.audio -tearoff $pd_tearoff | ||
99 | if {$pd_nt != 2} { | ||
100 | .mbar add cascade -label "$Windows" -menu .mbar.windows | ||
101 | .mbar add cascade -label "$Media" -menu .mbar.audio | ||
102 | } else { | ||
103 | # Perhaps this is silly, but Mac HIG want "Window Help" as the last menus | ||
104 | .mbar add cascade -label "$Media" -menu .mbar.audio | ||
105 | .mbar add cascade -label "$Windows" -menu .mbar.windows | ||
106 | } | ||
107 | menu .mbar.help -tearoff $pd_tearoff | ||
108 | .mbar add cascade -label "$Help" -menu .mbar.help | ||
109 | |||
110 | set ctrls_audio_on 0 | ||
111 | set ctrls_meter_on 0 | ||
112 | set ctrls_inlevel 0 | ||
113 | set ctrls_outlevel 0 | ||
114 | |||
115 | frame .controls.switches | ||
116 | checkbutton .controls.switches.audiobutton -text {compute audio} \ | ||
117 | -variable ctrls_audio_on \ | ||
118 | -anchor w \ | ||
119 | -command {pd [concat pd dsp $ctrls_audio_on \;]} | ||
120 | |||
121 | checkbutton .controls.switches.meterbutton -text {peak meters} \ | ||
122 | -variable ctrls_meter_on \ | ||
123 | -anchor w \ | ||
124 | -command {pd [concat pd meters $ctrls_meter_on \;]} | ||
125 | |||
126 | pack .controls.switches.meterbutton .controls.switches.audiobutton -side left | ||
127 | |||
128 | frame .controls.inout | ||
129 | frame .controls.inout.in | ||
130 | label .controls.inout.in.label -text IN | ||
131 | entry .controls.inout.in.level -textvariable ctrls_inlevel -width 3 | ||
132 | button .controls.inout.in.clip -text {CLIP} -state disabled | ||
133 | pack .controls.inout.in.label .controls.inout.in.level \ | ||
134 | .controls.inout.in.clip -side top -pady 2 | ||
135 | |||
136 | frame .controls.inout.out | ||
137 | label .controls.inout.out.label -text OUT | ||
138 | entry .controls.inout.out.level -textvariable ctrls_outlevel -width 3 | ||
139 | button .controls.inout.out.clip -text {CLIP} -state disabled | ||
140 | pack .controls.inout.out.label .controls.inout.out.level \ | ||
141 | .controls.inout.out.clip -side top -pady 2 | ||
142 | |||
143 | button .controls.dio -text "DIO\nerrors" \ | ||
144 | -command {pd [concat pd audiostatus \;]} | ||
145 | |||
146 | pack .controls.switches -side bottom -pady 12 | ||
147 | pack .controls.inout.in .controls.inout.out -side left -padx 6 | ||
148 | pack .controls.inout -side left -padx 14 | ||
149 | pack .controls.dio -side right -padx 20 | ||
150 | |||
151 | bind . <Control-Key> {pdtk_pd_ctrlkey %W %K 0} | ||
152 | bind . <Control-Shift-Key> {pdtk_pd_ctrlkey %W %K 1} | ||
153 | if {$pd_nt == 2} { | ||
154 | bind . <Mod1-Key> {pdtk_canvas_ctrlkey %W %K 0} | ||
155 | bind . <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1} | ||
156 | } | ||
157 | |||
158 | |||
159 | wm title . "PDa" | ||
160 | . configure -menu .mbar -width 200 -height 150 | ||
161 | |||
162 | ############### set up global variables ################################ | ||
163 | |||
164 | set untitled_number 1 | ||
165 | set untitled_directory [pwd] | ||
166 | set saveas_client doggy | ||
167 | set pd_opendir $untitled_directory | ||
168 | set pd_undoaction no | ||
169 | set pd_redoaction no | ||
170 | set pd_undocanvas no | ||
171 | |||
172 | ################ utility functions ######################### | ||
173 | |||
174 | proc pdtk_enquote {x} { | ||
175 | set foo [string map {"," "" ";" "" \" ""} $x] | ||
176 | set foo2 [string map {" " "\\ "} $foo] | ||
177 | concat $foo2 | ||
178 | } | ||
179 | |||
180 | proc pdtk_debug {x} { | ||
181 | tk_messageBox -message $x -type ok | ||
182 | } | ||
183 | |||
184 | proc pdtk_watchdog {} { | ||
185 | pd [concat pd ping \;] | ||
186 | after 2000 {pdtk_watchdog} | ||
187 | } | ||
188 | |||
189 | proc pdtk_check {x message} { | ||
190 | set answer [tk_messageBox \-message $x \-type yesno \-icon question] | ||
191 | switch $answer { | ||
192 | yes {pd $message} } | ||
193 | # no {tk_messageBox \-message "cancelled" \-type ok} | ||
194 | } | ||
195 | |||
196 | set menu_windowlist {} | ||
197 | |||
198 | proc pdtk_fixwindowmenu {} { | ||
199 | global menu_windowlist | ||
200 | .mbar.windows delete 0 end | ||
201 | foreach i $menu_windowlist { | ||
202 | .mbar.windows add command -label [lindex $i 0] \ | ||
203 | -command [concat menu_domenuwindow [lindex $i 1]] | ||
204 | menu_fixwindowmenu [lindex $i 1] | ||
205 | } | ||
206 | } | ||
207 | |||
208 | ####### Odd little function to make better Mac accelerators ##### | ||
209 | |||
210 | proc accel_munge {acc} { | ||
211 | global pd_nt | ||
212 | |||
213 | if {$pd_nt == 2} { | ||
214 | if [string is upper [string index $acc end]] { | ||
215 | return [format "%s%s" "Shift+" \ | ||
216 | [string toupper [string map {Ctrl Meta} $acc] end]] | ||
217 | } else { | ||
218 | return [string toupper [string map {Ctrl Meta} $acc] end] | ||
219 | } | ||
220 | } else { | ||
221 | return $acc | ||
222 | } | ||
223 | } | ||
224 | |||
225 | |||
226 | |||
227 | ############### the "New" menu command ######################## | ||
228 | proc menu_new {} { | ||
229 | global untitled_number | ||
230 | global untitled_directory | ||
231 | pd [concat pd filename Untitled-$untitled_number $untitled_directory \;] | ||
232 | pd { | ||
233 | #N canvas; | ||
234 | #X pop 1; | ||
235 | } | ||
236 | set untitled_number [expr $untitled_number + 1] | ||
237 | } | ||
238 | |||
239 | ################## the "Open" menu command ######################### | ||
240 | |||
241 | proc menu_open {} { | ||
242 | global pd_opendir | ||
243 | |||
244 | set filename [tk_getOpenFile -defaultextension .pd \ | ||
245 | -filetypes { {{pd files} {.pd}} {{max files} {.pat}}} \ | ||
246 | -initialdir $pd_opendir] | ||
247 | |||
248 | if {$filename != ""} { | ||
249 | set directory [string range $filename 0 \ | ||
250 | [expr [string last / $filename ] - 1]] | ||
251 | set pd_opendir $directory | ||
252 | set basename [string range $filename \ | ||
253 | [expr [string last / $filename ] + 1] end] | ||
254 | |||
255 | # pd_debug [concat file $filename base $basename dir $directory] | ||
256 | |||
257 | pd [concat pd open [pdtk_enquote $basename] \ | ||
258 | [pdtk_enquote $directory]\;] | ||
259 | } | ||
260 | } | ||
261 | |||
262 | ################## the "Message" menu command ######################### | ||
263 | proc menu_send {} { | ||
264 | toplevel .sendpanel | ||
265 | entry .sendpanel.entry -textvariable send_textvariable | ||
266 | pack .sendpanel.entry -side bottom -fill both -ipadx 100 | ||
267 | .sendpanel.entry select from 0 | ||
268 | .sendpanel.entry select adjust end | ||
269 | bind .sendpanel.entry <KeyPress-Return> { | ||
270 | pd [concat $send_textvariable \;] | ||
271 | after 50 {destroy .sendpanel} | ||
272 | } | ||
273 | focus .sendpanel.entry | ||
274 | } | ||
275 | |||
276 | ################## the "Quit" menu command ######################### | ||
277 | proc menu_really_quit {} {pd {pd quit;}} | ||
278 | |||
279 | proc menu_quit {} {pd {pd quit;}} | ||
280 | |||
281 | ######### the "Pd" menu command, which puts the Pd window on top ######## | ||
282 | proc menu_pop_pd {} {raise .} | ||
283 | |||
284 | ######### the "audio" menu command ############### | ||
285 | proc menu_audio {flag} {pd [concat pd dsp $flag \;]} | ||
286 | |||
287 | ######### the "documentation" menu command ############### | ||
288 | |||
289 | set doc_number 1 | ||
290 | |||
291 | proc menu_opentext {filename} { | ||
292 | global doc_number | ||
293 | global pd_guidir | ||
294 | global pd_myversion | ||
295 | set name [format ".help%d" $doc_number] | ||
296 | toplevel $name | ||
297 | text $name.text -fg black -relief raised -bd 2 -font -*-courier-bold--normal--12-* \ | ||
298 | -yscrollcommand "$name.scroll set" -background white | ||
299 | scrollbar $name.scroll -command "$name.text yview" | ||
300 | pack $name.scroll -side right -fill y | ||
301 | pack $name.text -side left -fill both -expand 1 | ||
302 | |||
303 | set f [open $filename] | ||
304 | while {![eof $f]} { | ||
305 | set bigstring [read $f 1000] | ||
306 | regsub -all PD_BASEDIR $bigstring $pd_guidir bigstring2 | ||
307 | regsub -all PD_VERSION $bigstring2 $pd_myversion bigstring3 | ||
308 | $name.text insert end $bigstring3 | ||
309 | } | ||
310 | close $f | ||
311 | set doc_number [expr $doc_number + 1] | ||
312 | } | ||
313 | |||
314 | set help_directory $pd_guidir/doc | ||
315 | |||
316 | proc menu_documentation {} { | ||
317 | global help_directory | ||
318 | global pd_nt | ||
319 | |||
320 | set filename [tk_getOpenFile -defaultextension .pd \ | ||
321 | -filetypes { {{documentation} {.pd .txt .htm}} } \ | ||
322 | -initialdir $help_directory] | ||
323 | |||
324 | if {$filename != ""} { | ||
325 | if {[string first .txt $filename] >= 0} { | ||
326 | menu_opentext $filename | ||
327 | } elseif {[string first .htm $filename] >= 0} { | ||
328 | if {$pd_nt == 0} { | ||
329 | exec sh -c \ | ||
330 | [format "mozilla file:%s || netscape file:%s &\n" \ | ||
331 | $filename $filename] | ||
332 | } elseif {$pd_nt == 2} { | ||
333 | puts stderr [format "open %s" $filename] | ||
334 | exec sh -c \ | ||
335 | [format "open %s" $filename] | ||
336 | } else { | ||
337 | exec rundll32 url.dll,FileProtocolHandler \ | ||
338 | [format "file:%s" $filename] & | ||
339 | } | ||
340 | } else { | ||
341 | set help_directory [string range $filename 0 \ | ||
342 | [expr [string last / $filename ] - 1]] | ||
343 | set basename [string range $filename \ | ||
344 | [expr [string last / $filename ] + 1] end] | ||
345 | pd [concat pd open [pdtk_enquote $basename] \ | ||
346 | [pdtk_enquote $help_directory] \;] | ||
347 | } | ||
348 | } | ||
349 | } | ||
350 | |||
351 | proc menu_doc_open {subdir basename} { | ||
352 | global pd_guidir | ||
353 | |||
354 | set dirname $pd_guidir/$subdir | ||
355 | |||
356 | if {[string first .txt $basename] >= 0} { | ||
357 | menu_opentext $dirname/$basename | ||
358 | } else { | ||
359 | pd [concat pd open [pdtk_enquote $basename] \ | ||
360 | [pdtk_enquote $dirname] \;] | ||
361 | } | ||
362 | } | ||
363 | |||
364 | ############# routine to add audio and help menus ############### | ||
365 | |||
366 | proc menu_addstd {mbar} { | ||
367 | global pd_apilist | ||
368 | # the "Audio" menu | ||
369 | $mbar.audio add command -label {audio ON} -accelerator [accel_munge "Ctrl+/"] \ | ||
370 | -command {menu_audio 1} | ||
371 | $mbar.audio add command -label {audio OFF} -accelerator [accel_munge "Ctrl+."] \ | ||
372 | -command {menu_audio 0} | ||
373 | for {set x 0} {$x<[llength $pd_apilist]} {incr x} { | ||
374 | $mbar.audio add radiobutton -label [lindex [lindex $pd_apilist $x] 0] \ | ||
375 | -command {menu_audio 0} -variable pd_whichapi \ | ||
376 | -value [lindex [lindex $pd_apilist $x] 1]\ | ||
377 | -command {pd [concat pd audio-setapi $pd_whichapi \;]} | ||
378 | } | ||
379 | $mbar.audio add command -label {Audio settings...} \ | ||
380 | -command {pd pd audio-properties \;} | ||
381 | |||
382 | $mbar.audio add command -label {MIDI settings...} \ | ||
383 | -command {pd pd midi-properties \;} | ||
384 | $mbar.audio add command -label {Test Audio and MIDI} \ | ||
385 | -command {menu_doc_open doc/7.stuff/tools testtone.pd} | ||
386 | $mbar.audio add command -label {Load Meter} \ | ||
387 | -command {menu_doc_open doc/7.stuff/tools load-meter.pd} | ||
388 | |||
389 | |||
390 | $mbar.audio add checkbutton -label "Show Menubar" \ | ||
391 | -indicatoron true -selectcolor grey85 \ | ||
392 | -variable menubar | ||
393 | |||
394 | # the "Help" menu | ||
395 | $mbar.help add command -label {About Pd} \ | ||
396 | -command {menu_doc_open doc/1.manual 1.introduction.txt} | ||
397 | $mbar.help add command -label {Pure Documentation...} \ | ||
398 | -command {menu_documentation} | ||
399 | } | ||
400 | |||
401 | #################### the "File" menu for the Pd window ############## | ||
402 | |||
403 | .mbar.file add command -label New -command {menu_new} \ | ||
404 | -accelerator [accel_munge "Ctrl+n"] | ||
405 | .mbar.file add command -label Open -command {menu_open} \ | ||
406 | -accelerator [accel_munge "Ctrl+o"] | ||
407 | .mbar.file add separator | ||
408 | .mbar.file add command -label Message -command {menu_send} \ | ||
409 | -accelerator [accel_munge "Ctrl+m"] | ||
410 | .mbar.file add command -label Path... \ | ||
411 | -command {pd pd start-path-dialog \;} | ||
412 | .mbar.file add separator | ||
413 | .mbar.file add command -label Quit -command {menu_quit} \ | ||
414 | -accelerator [accel_munge "Ctrl+q"] | ||
415 | |||
416 | #################### the "Find" menu for the Pd window ############## | ||
417 | .mbar.find add command -label {last error?} -command {menu_finderror} | ||
418 | |||
419 | ########### functions for menu functions on document windows ######## | ||
420 | |||
421 | proc menu_save {name} { | ||
422 | pdtk_canvas_checkgeometry $name | ||
423 | pd [concat $name menusave \;] | ||
424 | } | ||
425 | |||
426 | proc menu_saveas {name} { | ||
427 | pdtk_canvas_checkgeometry $name | ||
428 | pd [concat $name menusaveas \;] | ||
429 | } | ||
430 | |||
431 | proc menu_print {name} { | ||
432 | set filename [tk_getSaveFile -initialfile pd.ps \ | ||
433 | -defaultextension .ps \ | ||
434 | -filetypes { {{postscript} {.ps}} }] | ||
435 | |||
436 | if {$filename != ""} { | ||
437 | $name.c postscript -file $filename | ||
438 | } | ||
439 | } | ||
440 | |||
441 | proc menu_close {name} { | ||
442 | pd [concat $name menuclose \;] | ||
443 | } | ||
444 | |||
445 | proc menu_undo {name} { | ||
446 | global pd_undoaction | ||
447 | global pd_redoaction | ||
448 | global pd_undocanvas | ||
449 | if {$name == $pd_undocanvas && $pd_undoaction != "no"} { | ||
450 | pd [concat $name undo \;] | ||
451 | } | ||
452 | } | ||
453 | |||
454 | proc menu_redo {name} { | ||
455 | global pd_undoaction | ||
456 | global pd_redoaction | ||
457 | global pd_undocanvas | ||
458 | if {$name == $pd_undocanvas && $pd_redoaction != "no"} { | ||
459 | pd [concat $name redo \;] | ||
460 | } | ||
461 | } | ||
462 | |||
463 | proc menu_cut {name} { | ||
464 | pd [concat $name cut \;] | ||
465 | } | ||
466 | |||
467 | proc menu_copy {name} { | ||
468 | pd [concat $name copy \;] | ||
469 | } | ||
470 | |||
471 | proc menu_paste {name} { | ||
472 | pd [concat $name paste \;] | ||
473 | } | ||
474 | |||
475 | proc menu_duplicate {name} { | ||
476 | pd [concat $name duplicate \;] | ||
477 | } | ||
478 | |||
479 | proc menu_selectall {name} { | ||
480 | pd [concat $name selectall \;] | ||
481 | } | ||
482 | |||
483 | proc menu_texteditor {name} { | ||
484 | pd [concat $name texteditor \;] | ||
485 | } | ||
486 | |||
487 | proc menu_font {name} { | ||
488 | pd [concat $name menufont \;] | ||
489 | } | ||
490 | |||
491 | proc menu_tidyup {name} { | ||
492 | pd [concat $name tidy \;] | ||
493 | } | ||
494 | |||
495 | proc menu_editmode {name} { | ||
496 | pd [concat $name editmode 0 \;] | ||
497 | } | ||
498 | |||
499 | proc menu_object {name accel} { | ||
500 | pd [concat $name obj $accel \;] | ||
501 | } | ||
502 | |||
503 | proc menu_message {name accel} { | ||
504 | pd [concat $name msg $accel \;] | ||
505 | } | ||
506 | |||
507 | proc menu_floatatom {name accel} { | ||
508 | pd [concat $name floatatom $accel \;] | ||
509 | } | ||
510 | |||
511 | proc menu_symbolatom {name accel} { | ||
512 | pd [concat $name symbolatom $accel \;] | ||
513 | } | ||
514 | |||
515 | proc menu_comment {name accel} { | ||
516 | pd [concat $name text $accel \;] | ||
517 | } | ||
518 | |||
519 | proc menu_graph {name} { | ||
520 | pd [concat $name graph \;] | ||
521 | } | ||
522 | |||
523 | proc menu_array {name} { | ||
524 | pd [concat $name menuarray \;] | ||
525 | } | ||
526 | |||
527 | ############iemlib################## | ||
528 | proc menu_bng {name accel} { | ||
529 | pd [concat $name bng $accel \;] | ||
530 | } | ||
531 | |||
532 | proc menu_toggle {name accel} { | ||
533 | pd [concat $name toggle $accel \;] | ||
534 | } | ||
535 | |||
536 | proc menu_numbox {name accel} { | ||
537 | pd [concat $name numbox $accel \;] | ||
538 | } | ||
539 | |||
540 | proc menu_vslider {name accel} { | ||
541 | pd [concat $name vslider $accel \;] | ||
542 | } | ||
543 | |||
544 | proc menu_hslider {name accel} { | ||
545 | pd [concat $name hslider $accel \;] | ||
546 | } | ||
547 | |||
548 | proc menu_hradio {name accel} { | ||
549 | pd [concat $name hradio $accel \;] | ||
550 | } | ||
551 | |||
552 | proc menu_vradio {name accel} { | ||
553 | pd [concat $name vradio $accel \;] | ||
554 | } | ||
555 | |||
556 | proc menu_vumeter {name accel} { | ||
557 | pd [concat $name vumeter $accel \;] | ||
558 | } | ||
559 | |||
560 | proc menu_mycnv {name accel} { | ||
561 | pd [concat $name mycnv $accel \;] | ||
562 | } | ||
563 | |||
564 | ############iemlib################## | ||
565 | |||
566 | # correct edit menu, enabling or disabling undo/redo | ||
567 | # LATER also cut/copy/paste | ||
568 | proc menu_fixeditmenu {name} { | ||
569 | global pd_undoaction | ||
570 | global pd_redoaction | ||
571 | global pd_undocanvas | ||
572 | # puts stderr [concat menu_fixeditmenu $name $pd_undocanvas $pd_undoaction] | ||
573 | if {$name == $pd_undocanvas && $pd_undoaction != "no"} { | ||
574 | $name.m.edit entryconfigure "Undo*" -state normal \ | ||
575 | -label [concat "Undo " $pd_undoaction] | ||
576 | } else { | ||
577 | $name.m.edit entryconfigure "Undo*" -state disabled -label "Undo" | ||
578 | } | ||
579 | if {$name == $pd_undocanvas && $pd_redoaction != "no"} { | ||
580 | $name.m.edit entryconfigure "Redo*" -state normal\ | ||
581 | -label [concat "Redo " $pd_redoaction] | ||
582 | } else { | ||
583 | $name.m.edit entryconfigure "Redo*" -state disabled | ||
584 | } | ||
585 | } | ||
586 | |||
587 | # message from Pd to update the currently available undo/redo action | ||
588 | proc pdtk_undomenu {name undoaction redoaction} { | ||
589 | global pd_undoaction | ||
590 | global pd_redoaction | ||
591 | global pd_undocanvas | ||
592 | # puts stderr [concat pdtk_undomenu $name $undoaction $redoaction] | ||
593 | set pd_undocanvas $name | ||
594 | set pd_undoaction $undoaction | ||
595 | set pd_redoaction $redoaction | ||
596 | if {$name != "nobody"} { | ||
597 | # unpleasant way of avoiding a more unpleasant bug situation --atl 2002.11.25 | ||
598 | menu_fixeditmenu $name | ||
599 | } | ||
600 | } | ||
601 | |||
602 | proc menu_windowparent {name} { | ||
603 | pd [concat $name findparent \;] | ||
604 | } | ||
605 | |||
606 | proc menu_findagain {name} { | ||
607 | pd [concat $name findagain \;] | ||
608 | } | ||
609 | |||
610 | proc menu_finderror {} { | ||
611 | pd [concat pd finderror \;] | ||
612 | } | ||
613 | |||
614 | proc menu_domenuwindow {i} { | ||
615 | raise $i | ||
616 | } | ||
617 | |||
618 | proc menu_fixwindowmenu {name} { | ||
619 | global menu_windowlist | ||
620 | global pd_tearoff | ||
621 | global menubar | ||
622 | |||
623 | if { $menubar == 1 } { | ||
624 | $name.m.windows add command | ||
625 | if $pd_tearoff { | ||
626 | $name.m.windows delete 4 end | ||
627 | } else { | ||
628 | $name.m.windows delete 3 end | ||
629 | } | ||
630 | foreach i $menu_windowlist { | ||
631 | $name.m.windows add command -label [lindex $i 0] \ | ||
632 | -command [concat menu_domenuwindow [lindex $i 1]] | ||
633 | } | ||
634 | } | ||
635 | } | ||
636 | |||
637 | ################## the "find" menu item ################### | ||
638 | |||
639 | set find_canvas nobody | ||
640 | set find_string "" | ||
641 | set find_count 1 | ||
642 | |||
643 | proc find_apply {name} { | ||
644 | global find_string | ||
645 | global find_canvas | ||
646 | regsub -all \; $find_string " _semi_ " find_string2 | ||
647 | regsub -all \, $find_string2 " _comma_ " find_string3 | ||
648 | # puts stderr [concat $find_canvas find $find_string3 \ | ||
649 | # \;] | ||
650 | pd [concat $find_canvas find $find_string3 \ | ||
651 | \;] | ||
652 | after 50 destroy $name | ||
653 | } | ||
654 | |||
655 | proc find_cancel {name} { | ||
656 | after 50 destroy $name | ||
657 | } | ||
658 | |||
659 | proc menu_findobject {canvas} { | ||
660 | global find_string | ||
661 | global find_canvas | ||
662 | global find_count | ||
663 | |||
664 | set name [format ".find%d" $find_count] | ||
665 | set find_count [expr $find_count + 1] | ||
666 | |||
667 | set find_canvas $canvas | ||
668 | |||
669 | toplevel $name | ||
670 | |||
671 | label $name.label -text {find...} | ||
672 | pack $name.label -side top | ||
673 | |||
674 | entry $name.entry -textvariable find_string | ||
675 | pack $name.entry -side top | ||
676 | |||
677 | frame $name.buttonframe | ||
678 | pack $name.buttonframe -side bottom -fill x -pady 2m | ||
679 | button $name.buttonframe.cancel -text {Cancel}\ | ||
680 | -command "find_cancel $name" | ||
681 | button $name.buttonframe.ok -text {OK}\ | ||
682 | -command "find_apply $name" | ||
683 | pack $name.buttonframe.cancel -side left -expand 1 | ||
684 | pack $name.buttonframe.ok -side left -expand 1 | ||
685 | |||
686 | $name.entry select from 0 | ||
687 | $name.entry select adjust end | ||
688 | bind $name.entry <KeyPress-Return> [ concat find_apply $name] | ||
689 | focus $name.entry | ||
690 | } | ||
691 | |||
692 | |||
693 | |||
694 | proc pdtk_canvas_menubar {name width height geometry editable} { | ||
695 | global pd_opendir | ||
696 | global pd_tearoff | ||
697 | global pd_nt | ||
698 | |||
699 | global File Edit Find Put Windows Media Help | ||
700 | |||
701 | |||
702 | menu $name.m.file -tearoff $pd_tearoff | ||
703 | $name.m add cascade -label "$File" -menu $name.m.file | ||
704 | |||
705 | $name.m.file add command -label New -command {menu_new} \ | ||
706 | -accelerator [accel_munge "Ctrl+n"] | ||
707 | |||
708 | $name.m.file add command -label Open -command {menu_open} \ | ||
709 | -accelerator [accel_munge "Ctrl+o"] | ||
710 | |||
711 | $name.m.file add separator | ||
712 | $name.m.file add command -label Message -command {menu_send} \ | ||
713 | -accelerator [accel_munge "Ctrl+m"] | ||
714 | |||
715 | $name.m.file add command -label Path... \ | ||
716 | -command {pd pd start-path-dialog \;} | ||
717 | |||
718 | $name.m.file add separator | ||
719 | $name.m.file add command -label Close \ | ||
720 | -command [concat menu_close $name] \ | ||
721 | -accelerator [accel_munge "Ctrl+w"] | ||
722 | |||
723 | $name.m.file add command -label Save -command [concat menu_save $name] \ | ||
724 | -accelerator [accel_munge "Ctrl+s"] | ||
725 | |||
726 | $name.m.file add command -label "Save as..." \ | ||
727 | -command [concat menu_saveas $name] \ | ||
728 | -accelerator [accel_munge "Ctrl+S"] | ||
729 | |||
730 | $name.m.file add command -label Print -command [concat menu_print $name] \ | ||
731 | -accelerator [accel_munge "Ctrl+p"] | ||
732 | |||
733 | $name.m.file add separator | ||
734 | |||
735 | $name.m.file add command -label Quit -command {menu_quit} \ | ||
736 | -accelerator [accel_munge "Ctrl+q"] | ||
737 | |||
738 | # the edit menu | ||
739 | menu $name.m.edit -postcommand [concat menu_fixeditmenu $name] -tearoff $pd_tearoff | ||
740 | $name.m add cascade -label $Edit -menu $name.m.edit | ||
741 | |||
742 | $name.m.edit add command -label Undo -command [concat menu_undo $name] \ | ||
743 | -accelerator [accel_munge "Ctrl+z"] | ||
744 | |||
745 | $name.m.edit add command -label Redo -command [concat menu_redo $name] \ | ||
746 | -accelerator [accel_munge "Ctrl+Z"] | ||
747 | |||
748 | $name.m.edit add separator | ||
749 | |||
750 | $name.m.edit add command -label Cut -command [concat menu_cut $name] \ | ||
751 | -accelerator [accel_munge "Ctrl+x"] | ||
752 | |||
753 | $name.m.edit add command -label Copy -command [concat menu_copy $name] \ | ||
754 | -accelerator [accel_munge "Ctrl+c"] | ||
755 | |||
756 | $name.m.edit add command -label Paste \ | ||
757 | -command [concat menu_paste $name] \ | ||
758 | -accelerator [accel_munge "Ctrl+v"] | ||
759 | |||
760 | $name.m.edit add command -label Duplicate \ | ||
761 | -command [concat menu_duplicate $name] \ | ||
762 | -accelerator [accel_munge "Ctrl+d"] | ||
763 | |||
764 | $name.m.edit add command -label {Select all} \ | ||
765 | -command [concat menu_selectall $name] \ | ||
766 | -accelerator [accel_munge "Ctrl+a"] | ||
767 | |||
768 | $name.m.edit add separator | ||
769 | |||
770 | $name.m.edit add command -label {Text Editor} \ | ||
771 | -command [concat menu_texteditor $name] \ | ||
772 | -accelerator [accel_munge "Ctrl+t"] | ||
773 | |||
774 | $name.m.edit add command -label Font \ | ||
775 | -command [concat menu_font $name] | ||
776 | |||
777 | $name.m.edit add command -label {Tidy Up} \ | ||
778 | -command [concat menu_tidyup $name] | ||
779 | |||
780 | $name.m.edit add separator | ||
781 | |||
782 | ############iemlib################## | ||
783 | # instead of "red = #BC3C60" we take "grey85", so there is no difference, | ||
784 | # if widget is selected or not. | ||
785 | |||
786 | $name.m.edit add checkbutton -label "Edit mode" \ | ||
787 | -indicatoron true -selectcolor grey85 \ | ||
788 | -command [concat menu_editmode $name] \ | ||
789 | -accelerator [accel_munge "Ctrl+e"] | ||
790 | |||
791 | if { $editable == 0 } { | ||
792 | $name.m.edit entryconfigure "Edit mode" -indicatoron false } | ||
793 | |||
794 | ############iemlib################## | ||
795 | |||
796 | # the put menu | ||
797 | menu $name.m.put -tearoff $pd_tearoff | ||
798 | $name.m add cascade -label $Put -menu $name.m.put | ||
799 | |||
800 | $name.m.put add command -label Object \ | ||
801 | -command [concat menu_object $name 0] \ | ||
802 | -accelerator [accel_munge "Ctrl+1"] | ||
803 | |||
804 | $name.m.put add command -label Message \ | ||
805 | -command [concat menu_message $name 0] \ | ||
806 | -accelerator [accel_munge "Ctrl+2"] | ||
807 | |||
808 | $name.m.put add command -label Number \ | ||
809 | -command [concat menu_floatatom $name 0] \ | ||
810 | -accelerator [accel_munge "Ctrl+3"] | ||
811 | |||
812 | $name.m.put add command -label Symbol \ | ||
813 | -command [concat menu_symbolatom $name 0] \ | ||
814 | -accelerator [accel_munge "Ctrl+4"] | ||
815 | |||
816 | $name.m.put add command -label Comment \ | ||
817 | -command [concat menu_comment $name 0] \ | ||
818 | -accelerator [accel_munge "Ctrl+5"] | ||
819 | |||
820 | $name.m.put add separator | ||
821 | |||
822 | ############iemlib################## | ||
823 | |||
824 | $name.m.put add command -label Bang \ | ||
825 | -command [concat menu_bng $name 0] \ | ||
826 | -accelerator [accel_munge "Alt+b"] | ||
827 | |||
828 | $name.m.put add command -label Toggle \ | ||
829 | -command [concat menu_toggle $name 0] \ | ||
830 | -accelerator [accel_munge "Alt+t"] | ||
831 | |||
832 | $name.m.put add command -label Number2 \ | ||
833 | -command [concat menu_numbox $name 0] \ | ||
834 | -accelerator [accel_munge "Alt+n"] | ||
835 | |||
836 | $name.m.put add command -label Vslider \ | ||
837 | -command [concat menu_vslider $name 0] \ | ||
838 | -accelerator [accel_munge "Alt+v"] | ||
839 | |||
840 | $name.m.put add command -label Hslider \ | ||
841 | -command [concat menu_hslider $name 0] \ | ||
842 | -accelerator [accel_munge "Alt+h"] | ||
843 | |||
844 | $name.m.put add command -label Vradio \ | ||
845 | -command [concat menu_vradio $name 0] \ | ||
846 | -accelerator [accel_munge "Alt+d"] | ||
847 | |||
848 | $name.m.put add command -label Hradio \ | ||
849 | -command [concat menu_hradio $name 0] \ | ||
850 | -accelerator [accel_munge "Alt+i"] | ||
851 | |||
852 | $name.m.put add command -label VU \ | ||
853 | -command [concat menu_vumeter $name 0] \ | ||
854 | -accelerator [accel_munge "Alt+u"] | ||
855 | |||
856 | $name.m.put add command -label Canvas \ | ||
857 | -command [concat menu_mycnv $name 0] \ | ||
858 | -accelerator [accel_munge "Alt+c"] | ||
859 | |||
860 | ############iemlib################## | ||
861 | |||
862 | $name.m.put add separator | ||
863 | |||
864 | $name.m.put add command -label Graph \ | ||
865 | -command [concat menu_graph $name] | ||
866 | |||
867 | $name.m.put add command -label Array \ | ||
868 | -command [concat menu_array $name] | ||
869 | |||
870 | # the find menu | ||
871 | menu $name.m.find -tearoff $pd_tearoff | ||
872 | $name.m add cascade -label "$Find" -menu $name.m.find | ||
873 | |||
874 | $name.m.find add command -label {Find...} \ | ||
875 | -accelerator [accel_munge "Ctrl+f"] \ | ||
876 | -command [concat menu_findobject $name] | ||
877 | $name.m.find add command -label {Find Again} \ | ||
878 | -accelerator [accel_munge "Ctrl+g"] \ | ||
879 | -command [concat menu_findagain $name] | ||
880 | $name.m.find add command -label {Find last error} \ | ||
881 | -command [concat menu_finderror] | ||
882 | |||
883 | # the window menu | ||
884 | menu $name.m.windows -postcommand [concat menu_fixwindowmenu $name] \ | ||
885 | -tearoff $pd_tearoff | ||
886 | |||
887 | $name.m.windows add command -label {parent window}\ | ||
888 | -command [concat menu_windowparent $name] | ||
889 | $name.m.windows add command -label {Pd window} -command menu_pop_pd | ||
890 | $name.m.windows add separator | ||
891 | |||
892 | # the audio menu | ||
893 | menu $name.m.audio -tearoff $pd_tearoff | ||
894 | |||
895 | if {$pd_nt != 2} { | ||
896 | $name.m add cascade -label $Windows -menu $name.m.windows | ||
897 | $name.m add cascade -label $Media -menu $name.m.audio | ||
898 | } else { | ||
899 | $name.m add cascade -label $Media -menu $name.m.audio | ||
900 | $name.m add cascade -label $Windows -menu $name.m.windows | ||
901 | } | ||
902 | |||
903 | # the help menu | ||
904 | menu $name.m.help -tearoff $pd_tearoff | ||
905 | $name.m add cascade -label $Help -menu $name.m.help | ||
906 | |||
907 | menu_addstd $name.m | ||
908 | } | ||
909 | |||
910 | |||
911 | ############# pdtk_canvas_new -- create a new canvas ############### | ||
912 | proc pdtk_canvas_new {name width height geometry editable} { | ||
913 | global pd_opendir | ||
914 | global pd_tearoff | ||
915 | global pd_nt | ||
916 | global menubar | ||
917 | |||
918 | toplevel $name -menu $name.m | ||
919 | # puts stderr [concat geometry: $geometry] | ||
920 | wm geometry $name $geometry | ||
921 | wm minsize $name 1 1 | ||
922 | |||
923 | canvas $name.c -width $width -height $height -background white \ | ||
924 | -yscrollcommand "$name.scrollvert set" \ | ||
925 | -xscrollcommand "$name.scrollhort set" \ | ||
926 | -scrollregion [concat 0 0 $width $height] | ||
927 | |||
928 | |||
929 | scrollbar $name.scrollvert -command "$name.c yview" -width 7 | ||
930 | scrollbar $name.scrollhort -command "$name.c xview" \ | ||
931 | -orient horizontal -width 7 | ||
932 | |||
933 | pack $name.scrollhort -side bottom -fill x | ||
934 | pack $name.scrollvert -side right -fill y | ||
935 | pack $name.c -side left -expand 1 -fill both | ||
936 | |||
937 | # the menubar | ||
938 | |||
939 | menu $name.m | ||
940 | |||
941 | if { $menubar == 1 } { | ||
942 | pdtk_canvas_menubar $name $width $height $geometry $editable | ||
943 | } | ||
944 | |||
945 | # the popup menu | ||
946 | menu $name.popup -tearoff false | ||
947 | $name.popup add command -label {Properties} \ | ||
948 | -command [concat popup_action $name 0] | ||
949 | $name.popup add command -label {Open} \ | ||
950 | -command [concat popup_action $name 1] | ||
951 | $name.popup add command -label {Help} \ | ||
952 | -command [concat popup_action $name 2] | ||
953 | |||
954 | # WM protocol | ||
955 | wm protocol $name WM_DELETE_WINDOW [concat menu_close $name] | ||
956 | |||
957 | # bindings. | ||
958 | # this is idiotic -- how do you just sense what mod keys are down and | ||
959 | # pass them on? I can't find it anywhere. | ||
960 | # Here we encode shift as 1, control 2, alt 4, in agreement | ||
961 | # with definitions in g_canvas.c. The third button gets "8" but we don't | ||
962 | # bother with modifiers there. | ||
963 | # We don't handle multiple clicks yet. | ||
964 | |||
965 | bind $name.c <Button> {pdtk_canvas_click %W %x %y %b 0} | ||
966 | bind $name.c <Shift-Button> {pdtk_canvas_click %W %x %y %b 1} | ||
967 | bind $name.c <Control-Shift-Button> {pdtk_canvas_click %W %x %y %b 3} | ||
968 | bind $name.c <Alt-Button> {pdtk_canvas_click %W %x %y %b 4} | ||
969 | bind $name.c <Alt-Shift-Button> {pdtk_canvas_click %W %x %y %b 5} | ||
970 | bind $name.c <Alt-Control-Button> {pdtk_canvas_click %W %x %y %b 6} | ||
971 | bind $name.c <Alt-Control-Shift-Button> {pdtk_canvas_click %W %x %y %b 7} | ||
972 | global pd_nt | ||
973 | if {$pd_nt == 2} { | ||
974 | bind $name.c <Button-2> {pdtk_canvas_click %W %x %y %b 8} | ||
975 | bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 8} | ||
976 | } else { | ||
977 | bind $name.c <Button-3> {pdtk_canvas_click %W %x %y %b 8} | ||
978 | bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 2} | ||
979 | } | ||
980 | # change mac to right-click, not middle click -atl 2002.09.02 | ||
981 | |||
982 | bind $name.c <ButtonRelease> {pdtk_canvas_mouseup %W %x %y %b} | ||
983 | bind $name.c <Control-Key> {pdtk_canvas_ctrlkey %W %K 0} | ||
984 | bind $name.c <Control-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1} | ||
985 | bind $name.c <Alt-Key> {pdtk_canvas_altkey %W %K %A} | ||
986 | # bind $name.c <Mod1-Key> {puts stderr [concat mod1 %W %K %A]} | ||
987 | if {$pd_nt == 2} { | ||
988 | bind $name.c <Mod1-Key> {pdtk_canvas_ctrlkey %W %K 0} | ||
989 | bind $name.c <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1} | ||
990 | } | ||
991 | bind $name.c <Key> {pdtk_canvas_key %W %K %A 0} | ||
992 | bind $name.c <Shift-Key> {pdtk_canvas_key %W %K %A 1} | ||
993 | bind $name.c <KeyRelease> {pdtk_canvas_keyup %W %K %A} | ||
994 | bind $name.c <Motion> {pdtk_canvas_motion %W %x %y 0} | ||
995 | bind $name.c <Alt-Motion> {pdtk_canvas_motion %W %x %y 4} | ||
996 | bind $name.c <Map> {pdtk_canvas_map %W} | ||
997 | bind $name.c <Unmap> {pdtk_canvas_unmap %W} | ||
998 | focus $name.c | ||
999 | # puts stderr "all done" | ||
1000 | # after 1 [concat raise $name] | ||
1001 | } | ||
1002 | |||
1003 | #################### event binding procedures ################ | ||
1004 | |||
1005 | #get the name of the toplevel window for a canvas; this is also | ||
1006 | #the name of the canvas object in Pd. | ||
1007 | |||
1008 | proc canvastosym {name} { | ||
1009 | string range $name 0 [expr [string length $name] - 3] | ||
1010 | } | ||
1011 | |||
1012 | set pdtk_lastcanvasconfigured "" | ||
1013 | set pdtk_lastcanvasconfiguration "" | ||
1014 | |||
1015 | proc pdtk_canvas_checkgeometry {topname} { | ||
1016 | set boo [winfo geometry $topname.c] | ||
1017 | set boo2 [wm geometry $topname] | ||
1018 | global pdtk_lastcanvasconfigured | ||
1019 | global pdtk_lastcanvasconfiguration | ||
1020 | if {$topname != $pdtk_lastcanvasconfigured || \ | ||
1021 | $boo != $pdtk_lastcanvasconfiguration} { | ||
1022 | set pdtk_lastcanvasconfigured $topname | ||
1023 | set pdtk_lastcanvasconfiguration $boo | ||
1024 | pd $topname relocate $boo $boo2 \; | ||
1025 | } | ||
1026 | } | ||
1027 | |||
1028 | proc pdtk_canvas_click {name x y b f} { | ||
1029 | # puts stderr [concat got $f] | ||
1030 | pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b $f \; | ||
1031 | } | ||
1032 | |||
1033 | proc pdtk_canvas_shiftclick {name x y b} { | ||
1034 | pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 1 \; | ||
1035 | } | ||
1036 | |||
1037 | proc pdtk_canvas_ctrlclick {name x y b} { | ||
1038 | pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 2 \; | ||
1039 | } | ||
1040 | |||
1041 | proc pdtk_canvas_altclick {name x y b} { | ||
1042 | pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 3 \; | ||
1043 | } | ||
1044 | |||
1045 | proc pdtk_canvas_dblclick {name x y b} { | ||
1046 | pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 4 \; | ||
1047 | } | ||
1048 | |||
1049 | set pdtk_canvas_mouseup_name 0 | ||
1050 | set pdtk_canvas_mouseup_xminval 0 | ||
1051 | set pdtk_canvas_mouseup_xmaxval 0 | ||
1052 | set pdtk_canvas_mouseup_yminval 0 | ||
1053 | set pdtk_canvas_mouseup_ymaxval 0 | ||
1054 | |||
1055 | proc pdtk_canvas_mouseup {name x y b} { | ||
1056 | pd [concat [canvastosym $name] mouseup [$name canvasx $x] \ | ||
1057 | [$name canvasy $y] $b \;] | ||
1058 | |||
1059 | # we use the mouseup event to update scrollbar ranges and recheck the | ||
1060 | # geometry of the window since I haven't taken the time to figure out | ||
1061 | # how to do it right. | ||
1062 | |||
1063 | global pdtk_canvas_mouseup_name | ||
1064 | global pdtk_canvas_mouseup_xminval | ||
1065 | global pdtk_canvas_mouseup_xmaxval | ||
1066 | global pdtk_canvas_mouseup_yminval | ||
1067 | global pdtk_canvas_mouseup_ymaxval | ||
1068 | |||
1069 | set size [$name bbox all] | ||
1070 | if {$size != ""} { | ||
1071 | set xminval 0 | ||
1072 | set yminval 0 | ||
1073 | set xmaxval 100 | ||
1074 | set ymaxval 100 | ||
1075 | set x1 [lindex $size 0] | ||
1076 | set x2 [lindex $size 2] | ||
1077 | set y1 [lindex $size 1] | ||
1078 | set y2 [lindex $size 3] | ||
1079 | |||
1080 | if {$x1 < 0} {set xminval $x1} | ||
1081 | if {$y1 < 0} {set yminval $y1} | ||
1082 | |||
1083 | if {$x2 > 100} {set xmaxval $x2} | ||
1084 | if {$y2 > 100} {set ymaxval $y2} | ||
1085 | |||
1086 | if {$pdtk_canvas_mouseup_name != $name || \ | ||
1087 | $pdtk_canvas_mouseup_xminval != $xminval || \ | ||
1088 | $pdtk_canvas_mouseup_xmaxval != $xmaxval || \ | ||
1089 | $pdtk_canvas_mouseup_yminval != $yminval || \ | ||
1090 | $pdtk_canvas_mouseup_ymaxval != $ymaxval } { | ||
1091 | |||
1092 | set newsize "$xminval $yminval $xmaxval $ymaxval" | ||
1093 | $name configure -scrollregion $newsize | ||
1094 | set pdtk_canvas_mouseup_name $name | ||
1095 | set pdtk_canvas_mouseup_xminval $xminval | ||
1096 | set pdtk_canvas_mouseup_xmaxval $xmaxval | ||
1097 | set pdtk_canvas_mouseup_yminval $yminval | ||
1098 | set pdtk_canvas_mouseup_ymaxval $ymaxval | ||
1099 | } | ||
1100 | |||
1101 | } | ||
1102 | pdtk_canvas_checkgeometry [canvastosym $name] | ||
1103 | } | ||
1104 | |||
1105 | proc pdtk_canvas_key {name key iso shift} { | ||
1106 | # puts stderr [concat down key= $key iso= $iso] | ||
1107 | # .controls.switches.meterbutton configure -text $key | ||
1108 | # HACK for MAC OSX -- backspace seems different; I don't understand why. | ||
1109 | # invesigate this LATER... | ||
1110 | global pd_nt | ||
1111 | if {$pd_nt == 2} { | ||
1112 | if {$key == "BackSpace"} { | ||
1113 | set key 8 | ||
1114 | set keynum 8 | ||
1115 | } | ||
1116 | if {$key == "Delete"} { | ||
1117 | set key 8 | ||
1118 | set keynum 8 | ||
1119 | } | ||
1120 | } | ||
1121 | if {$key == "KP_Delete"} { | ||
1122 | set key 127 | ||
1123 | set keynum 127 | ||
1124 | } | ||
1125 | if {$iso != ""} { | ||
1126 | scan $iso %c keynum | ||
1127 | pd [canvastosym $name] key 1 $keynum $shift\; | ||
1128 | } else { | ||
1129 | pd [canvastosym $name] key 1 $key $shift\; | ||
1130 | } | ||
1131 | } | ||
1132 | |||
1133 | proc pdtk_canvas_keyup {name key iso} { | ||
1134 | # puts stderr [concat up key= $key iso= $iso] | ||
1135 | if {$iso != ""} { | ||
1136 | scan $iso %c keynum | ||
1137 | pd [canvastosym $name] key 0 $keynum 0 \; | ||
1138 | } else { | ||
1139 | pd [canvastosym $name] key 0 $key 0 \; | ||
1140 | } | ||
1141 | } | ||
1142 | |||
1143 | proc pdtk_canvas_altkey {name key iso} { | ||
1144 | # puts stderr [concat alt-key $iso] | ||
1145 | ############iemlib################## | ||
1146 | set topname [string trimright $name .c] | ||
1147 | if {$key == "b" || $key == "B"} {menu_bng $topname 1} | ||
1148 | if {$key == "t" || $key == "T"} {menu_toggle $topname 1} | ||
1149 | if {$key == "n" || $key == "N"} {menu_numbox $topname 1} | ||
1150 | if {$key == "v" || $key == "V"} {menu_vslider $topname 1} | ||
1151 | if {$key == "h" || $key == "H"} {menu_hslider $topname 1} | ||
1152 | if {$key == "i" || $key == "I"} {menu_hradio $topname 1} | ||
1153 | if {$key == "d" || $key == "D"} {menu_vradio $topname 1} | ||
1154 | if {$key == "u" || $key == "U"} {menu_vumeter $topname 1} | ||
1155 | if {$key == "c" || $key == "C"} {menu_mycnv $topname 1} | ||
1156 | ############iemlib################## | ||
1157 | } | ||
1158 | |||
1159 | proc pdtk_canvas_ctrlkey {name key shift} { | ||
1160 | # first get rid of ".c" suffix; we'll refer to the toplevel instead | ||
1161 | set topname [string trimright $name .c] | ||
1162 | # puts stderr [concat ctrl-key $key $topname] | ||
1163 | |||
1164 | if {$key == "n" || $key == "N"} {menu_new} | ||
1165 | if {$key == "o" || $key == "O"} {menu_open} | ||
1166 | if {$key == "m" || $key == "M"} {menu_send} | ||
1167 | if {$key == "q" || $key == "Q"} { | ||
1168 | if {$shift == 1} {menu_really_quit} else {menu_quit} | ||
1169 | } | ||
1170 | if {$key == "s" || $key == "S"} { | ||
1171 | if {$shift == 1} {menu_saveas $topname} else {menu_save $topname} | ||
1172 | } | ||
1173 | if {$key == "z" || $key == "Z"} { | ||
1174 | if {$shift == 1} {menu_redo $topname} else {menu_undo $topname} | ||
1175 | } | ||
1176 | if {$key == "w" || $key == "W"} {menu_close $topname} | ||
1177 | if {$key == "p" || $key == "P"} {menu_print $topname} | ||
1178 | if {$key == "x" || $key == "X"} {menu_cut $topname} | ||
1179 | if {$key == "c" || $key == "C"} {menu_copy $topname} | ||
1180 | if {$key == "v" || $key == "V"} {menu_paste $topname} | ||
1181 | if {$key == "d" || $key == "D"} {menu_duplicate $topname} | ||
1182 | if {$key == "a" || $key == "A"} {menu_selectall $topname} | ||
1183 | if {$key == "t" || $key == "T"} {menu_texteditor $topname} | ||
1184 | if {$key == "f" || $key == "F"} {menu_findobject $topname} | ||
1185 | if {$key == "g" || $key == "G"} {menu_findagain $topname} | ||
1186 | if {$key == "1"} {menu_object $topname 1} | ||
1187 | if {$key == "2"} {menu_message $topname 1} | ||
1188 | if {$key == "3"} {menu_floatatom $topname 1} | ||
1189 | if {$key == "4"} {menu_symbolatom $topname 1} | ||
1190 | if {$key == "5"} {menu_comment $topname 1} | ||
1191 | if {$key == "slash"} {menu_audio 1} | ||
1192 | if {$key == "period"} {menu_audio 0} | ||
1193 | if {$key == "e" || $key == "E"} {menu_editmode $topname} | ||
1194 | } | ||
1195 | |||
1196 | proc pdtk_canvas_motion {name x y mods} { | ||
1197 | # puts stderr [concat [canvastosym $name] $name $x $y] | ||
1198 | pd [canvastosym $name] motion [$name canvasx $x] [$name canvasy $y] $mods \; | ||
1199 | } | ||
1200 | |||
1201 | # "map" event tells us when the canvas becomes visible (arg is "0") or | ||
1202 | # invisible (arg is ""). Invisibility means the Window Manager has minimized | ||
1203 | # us. We don't get a final "unmap" event when we destroy the window. | ||
1204 | proc pdtk_canvas_map {name} { | ||
1205 | # puts stderr [concat map $name] | ||
1206 | pd [canvastosym $name] map 1 \; | ||
1207 | } | ||
1208 | |||
1209 | proc pdtk_canvas_unmap {name} { | ||
1210 | # puts stderr [concat unmap $name] | ||
1211 | pd [canvastosym $name] map 0 \; | ||
1212 | } | ||
1213 | |||
1214 | set saveas_dir nowhere | ||
1215 | |||
1216 | ############ pdtk_canvas_saveas -- run a saveas dialog ############## | ||
1217 | |||
1218 | proc pdtk_canvas_saveas {name initfile initdir} { | ||
1219 | set filename [tk_getSaveFile -initialfile $initfile \ | ||
1220 | -initialdir $initdir -defaultextension .pd \ | ||
1221 | -filetypes { {{pd files} {.pd}} {{max files} {.pat}} }] | ||
1222 | |||
1223 | if {$filename != ""} { | ||
1224 | set directory [string range $filename 0 \ | ||
1225 | [expr [string last / $filename ] - 1]] | ||
1226 | set basename [string range $filename \ | ||
1227 | [expr [string last / $filename ] + 1] end] | ||
1228 | pd [concat $name savetofile [pdtk_enquote $basename] \ | ||
1229 | [pdtk_enquote $directory] \;] | ||
1230 | # pd [concat $name savetofile $basename $directory \;] | ||
1231 | } | ||
1232 | } | ||
1233 | |||
1234 | ############ pdtk_canvas_dofont -- run a font and resize dialog ######### | ||
1235 | |||
1236 | set fontsize 0 | ||
1237 | set stretchval 0 | ||
1238 | set whichstretch 0 | ||
1239 | |||
1240 | proc dofont_apply {name} { | ||
1241 | global fontsize | ||
1242 | global stretchval | ||
1243 | global whichstretch | ||
1244 | set cmd [concat $name font $fontsize $stretchval $whichstretch \;] | ||
1245 | # puts stderr $cmd | ||
1246 | pd $cmd | ||
1247 | } | ||
1248 | |||
1249 | proc dofont_cancel {name} { | ||
1250 | set cmd [concat $name cancel \;] | ||
1251 | # puts stderr $cmd | ||
1252 | pd $cmd | ||
1253 | } | ||
1254 | |||
1255 | proc pdtk_canvas_dofont {name initsize} { | ||
1256 | |||
1257 | global fontsize | ||
1258 | set fontsize $initsize | ||
1259 | |||
1260 | global stretchval | ||
1261 | set stretchval 100 | ||
1262 | |||
1263 | global whichstretch | ||
1264 | set whichstretch 1 | ||
1265 | |||
1266 | toplevel $name | ||
1267 | wm title $name {FONT BOMB} | ||
1268 | wm protocol $name WM_DELETE_WINDOW [concat dofont_cancel $name] | ||
1269 | |||
1270 | frame $name.buttonframe | ||
1271 | pack $name.buttonframe -side bottom -fill x -pady 2m | ||
1272 | button $name.buttonframe.cancel -text {Cancel}\ | ||
1273 | -command "dofont_cancel $name" | ||
1274 | button $name.buttonframe.ok -text {Do it}\ | ||
1275 | -command "dofont_apply $name" | ||
1276 | pack $name.buttonframe.cancel -side left -expand 1 | ||
1277 | pack $name.buttonframe.ok -side left -expand 1 | ||
1278 | |||
1279 | frame $name.radiof | ||
1280 | pack $name.radiof -side left | ||
1281 | |||
1282 | label $name.radiof.label -text {Font Size:} | ||
1283 | pack $name.radiof.label -side top | ||
1284 | |||
1285 | radiobutton $name.radiof.radio8 -value 8 -variable fontsize -text "8" | ||
1286 | radiobutton $name.radiof.radio10 -value 10 -variable fontsize -text "10" | ||
1287 | radiobutton $name.radiof.radio12 -value 12 -variable fontsize -text "12" | ||
1288 | radiobutton $name.radiof.radio16 -value 16 -variable fontsize -text "16" | ||
1289 | radiobutton $name.radiof.radio24 -value 24 -variable fontsize -text "24" | ||
1290 | radiobutton $name.radiof.radio36 -value 36 -variable fontsize -text "36" | ||
1291 | pack $name.radiof.radio8 -side top -anchor w | ||
1292 | pack $name.radiof.radio10 -side top -anchor w | ||
1293 | pack $name.radiof.radio12 -side top -anchor w | ||
1294 | pack $name.radiof.radio16 -side top -anchor w | ||
1295 | pack $name.radiof.radio24 -side top -anchor w | ||
1296 | pack $name.radiof.radio36 -side top -anchor w | ||
1297 | |||
1298 | frame $name.stretchf | ||
1299 | pack $name.stretchf -side left | ||
1300 | |||
1301 | label $name.stretchf.label -text {Stretch:} | ||
1302 | pack $name.stretchf.label -side top | ||
1303 | |||
1304 | entry $name.stretchf.entry -textvariable stretchval -width 5 | ||
1305 | pack $name.stretchf.entry -side left | ||
1306 | |||
1307 | radiobutton $name.stretchf.radio1 \ | ||
1308 | -value 1 -variable whichstretch -text "X and Y" | ||
1309 | radiobutton $name.stretchf.radio2 \ | ||
1310 | -value 2 -variable whichstretch -text "X only" | ||
1311 | radiobutton $name.stretchf.radio3 \ | ||
1312 | -value 3 -variable whichstretch -text "Y only" | ||
1313 | |||
1314 | pack $name.stretchf.radio1 -side top -anchor w | ||
1315 | pack $name.stretchf.radio2 -side top -anchor w | ||
1316 | pack $name.stretchf.radio3 -side top -anchor w | ||
1317 | |||
1318 | } | ||
1319 | |||
1320 | ############ pdtk_gatom_dialog -- run a gatom dialog ######### | ||
1321 | |||
1322 | # see graph_apply, etc., for comments about handling variable names here... | ||
1323 | |||
1324 | proc gatom_escape {sym} { | ||
1325 | if {[string length $sym] == 0} { | ||
1326 | set ret "-" | ||
1327 | # puts stderr [concat escape1 $sym $ret] | ||
1328 | } else { | ||
1329 | if {[string equal -length 1 $sym "-"]} { | ||
1330 | set ret [string replace $sym 0 0 "--"] | ||
1331 | # puts stderr [concat escape $sym $ret] | ||
1332 | } else { | ||
1333 | if {[string equal -length 1 $sym "$"]} { | ||
1334 | set ret [string replace $sym 0 0 "#"] | ||
1335 | # puts stderr [concat unescape $sym $ret] | ||
1336 | } else { | ||
1337 | set ret $sym | ||
1338 | # puts stderr [concat escape $sym "no change"] | ||
1339 | } | ||
1340 | } | ||
1341 | } | ||
1342 | concat $ret | ||
1343 | } | ||
1344 | |||
1345 | proc gatom_unescape {sym} { | ||
1346 | if {[string equal -length 1 $sym "-"]} { | ||
1347 | set ret [string replace $sym 0 0 ""] | ||
1348 | # puts stderr [concat unescape $sym $ret] | ||
1349 | } else { | ||
1350 | if {[string equal -length 1 $sym "#"]} { | ||
1351 | set ret [string replace $sym 0 0 "$"] | ||
1352 | # puts stderr [concat unescape $sym $ret] | ||
1353 | } else { | ||
1354 | set ret $sym | ||
1355 | # puts stderr [concat unescape $sym "no change"] | ||
1356 | } | ||
1357 | } | ||
1358 | concat $ret | ||
1359 | } | ||
1360 | |||
1361 | proc dogatom_apply {id} { | ||
1362 | set vid [string trimleft $id .] | ||
1363 | |||
1364 | set var_gatomwidth [concat gatomwidth_$vid] | ||
1365 | global $var_gatomwidth | ||
1366 | set var_gatomlo [concat gatomlo_$vid] | ||
1367 | global $var_gatomlo | ||
1368 | set var_gatomhi [concat gatomhi_$vid] | ||
1369 | global $var_gatomhi | ||
1370 | set var_gatomwherelabel [concat gatomwherelabel_$vid] | ||
1371 | global $var_gatomwherelabel | ||
1372 | set var_gatomlabel [concat gatomlabel_$vid] | ||
1373 | global $var_gatomlabel | ||
1374 | set var_gatomsymfrom [concat gatomsymfrom_$vid] | ||
1375 | global $var_gatomsymfrom | ||
1376 | set var_gatomsymto [concat gatomsymto_$vid] | ||
1377 | global $var_gatomsymto | ||
1378 | |||
1379 | # set cmd [concat $id param $gatomwidth $gatomlo $gatomhi \;] | ||
1380 | |||
1381 | set cmd [concat $id param \ | ||
1382 | [eval concat $$var_gatomwidth] \ | ||
1383 | [eval concat $$var_gatomlo] \ | ||
1384 | [eval concat $$var_gatomhi] \ | ||
1385 | [eval gatom_escape $$var_gatomlabel] \ | ||
1386 | [eval concat $$var_gatomwherelabel] \ | ||
1387 | [eval gatom_escape $$var_gatomsymfrom] \ | ||
1388 | [eval gatom_escape $$var_gatomsymto] \ | ||
1389 | \;] | ||
1390 | |||
1391 | # puts stderr $cmd | ||
1392 | pd $cmd | ||
1393 | } | ||
1394 | |||
1395 | proc dogatom_cancel {name} { | ||
1396 | set cmd [concat $name cancel \;] | ||
1397 | # puts stderr $cmd | ||
1398 | pd $cmd | ||
1399 | } | ||
1400 | |||
1401 | proc dogatom_ok {name} { | ||
1402 | dogatom_apply $name | ||
1403 | dogatom_cancel $name | ||
1404 | } | ||
1405 | |||
1406 | proc pdtk_gatom_dialog {id initwidth initlo inithi \ | ||
1407 | wherelabel label symfrom symto} { | ||
1408 | |||
1409 | set vid [string trimleft $id .] | ||
1410 | |||
1411 | set var_gatomwidth [concat gatomwidth_$vid] | ||
1412 | global $var_gatomwidth | ||
1413 | set var_gatomlo [concat gatomlo_$vid] | ||
1414 | global $var_gatomlo | ||
1415 | set var_gatomhi [concat gatomhi_$vid] | ||
1416 | global $var_gatomhi | ||
1417 | set var_gatomwherelabel [concat gatomwherelabel_$vid] | ||
1418 | global $var_gatomwherelabel | ||
1419 | set var_gatomlabel [concat gatomlabel_$vid] | ||
1420 | global $var_gatomlabel | ||
1421 | set var_gatomsymfrom [concat gatomsymfrom_$vid] | ||
1422 | global $var_gatomsymfrom | ||
1423 | set var_gatomsymto [concat gatomsymto_$vid] | ||
1424 | global $var_gatomsymto | ||
1425 | |||
1426 | set $var_gatomwidth $initwidth | ||
1427 | set $var_gatomlo $initlo | ||
1428 | set $var_gatomhi $inithi | ||
1429 | set $var_gatomwherelabel $wherelabel | ||
1430 | set $var_gatomlabel [gatom_unescape $label] | ||
1431 | set $var_gatomsymfrom [gatom_unescape $symfrom] | ||
1432 | set $var_gatomsymto [gatom_unescape $symto] | ||
1433 | |||
1434 | toplevel $id | ||
1435 | wm title $id {Atom} | ||
1436 | wm protocol $id WM_DELETE_WINDOW [concat dogatom_cancel $id] | ||
1437 | |||
1438 | frame $id.buttonframe | ||
1439 | pack $id.buttonframe -side bottom -fill x -pady 2m | ||
1440 | button $id.buttonframe.cancel -text {Cancel}\ | ||
1441 | -command "dogatom_cancel $id" | ||
1442 | button $id.buttonframe.apply -text {Apply}\ | ||
1443 | -command "dogatom_apply $id" | ||
1444 | button $id.buttonframe.ok -text {OK}\ | ||
1445 | -command "dogatom_ok $id" | ||
1446 | pack $id.buttonframe.cancel -side left -expand 1 | ||
1447 | pack $id.buttonframe.apply -side left -expand 1 | ||
1448 | pack $id.buttonframe.ok -side left -expand 1 | ||
1449 | |||
1450 | frame $id.paramsymto | ||
1451 | pack $id.paramsymto -side bottom | ||
1452 | label $id.paramsymto.entryname -text {send symbol} | ||
1453 | entry $id.paramsymto.entry -textvariable $var_gatomsymto -width 20 | ||
1454 | pack $id.paramsymto.entryname $id.paramsymto.entry -side left | ||
1455 | |||
1456 | frame $id.paramsymfrom | ||
1457 | pack $id.paramsymfrom -side bottom | ||
1458 | label $id.paramsymfrom.entryname -text {receive symbol} | ||
1459 | entry $id.paramsymfrom.entry -textvariable $var_gatomsymfrom -width 20 | ||
1460 | pack $id.paramsymfrom.entryname $id.paramsymfrom.entry -side left | ||
1461 | |||
1462 | frame $id.radio | ||
1463 | pack $id.radio -side bottom | ||
1464 | label $id.radio.label -text {show label on:} | ||
1465 | frame $id.radio.l | ||
1466 | frame $id.radio.r | ||
1467 | pack $id.radio.label -side top | ||
1468 | pack $id.radio.l $id.radio.r -side left | ||
1469 | radiobutton $id.radio.l.radio0 -value 0 \ | ||
1470 | -variable $var_gatomwherelabel \ | ||
1471 | -text "left" | ||
1472 | radiobutton $id.radio.l.radio1 -value 1 \ | ||
1473 | -variable $var_gatomwherelabel \ | ||
1474 | -text "right" | ||
1475 | radiobutton $id.radio.r.radio2 -value 2 \ | ||
1476 | -variable $var_gatomwherelabel \ | ||
1477 | -text "top" | ||
1478 | radiobutton $id.radio.r.radio3 -value 3 \ | ||
1479 | -variable $var_gatomwherelabel \ | ||
1480 | -text "bottom" | ||
1481 | pack $id.radio.l.radio0 $id.radio.l.radio1 -side top -anchor w | ||
1482 | pack $id.radio.r.radio2 $id.radio.r.radio3 -side top -anchor w | ||
1483 | |||
1484 | |||
1485 | frame $id.paramlabel | ||
1486 | pack $id.paramlabel -side bottom | ||
1487 | label $id.paramlabel.entryname -text label | ||
1488 | entry $id.paramlabel.entry -textvariable $var_gatomlabel -width 20 | ||
1489 | pack $id.paramlabel.entryname $id.paramlabel.entry -side left | ||
1490 | |||
1491 | frame $id.paramhi | ||
1492 | pack $id.paramhi -side bottom | ||
1493 | label $id.paramhi.entryname -text "upper limit" | ||
1494 | entry $id.paramhi.entry -textvariable $var_gatomhi -width 8 | ||
1495 | pack $id.paramhi.entryname $id.paramhi.entry -side left | ||
1496 | |||
1497 | frame $id.paramlo | ||
1498 | pack $id.paramlo -side bottom | ||
1499 | label $id.paramlo.entryname -text "lower limit" | ||
1500 | entry $id.paramlo.entry -textvariable $var_gatomlo -width 8 | ||
1501 | pack $id.paramlo.entryname $id.paramlo.entry -side left | ||
1502 | |||
1503 | frame $id.params | ||
1504 | pack $id.params -side bottom | ||
1505 | label $id.params.entryname -text width | ||
1506 | entry $id.params.entry -textvariable $var_gatomwidth -width 4 | ||
1507 | pack $id.params.entryname $id.params.entry -side left | ||
1508 | |||
1509 | |||
1510 | |||
1511 | bind $id.paramhi.entry <KeyPress-Return> [concat dogatom_ok $id] | ||
1512 | bind $id.paramlo.entry <KeyPress-Return> [concat dogatom_ok $id] | ||
1513 | bind $id.params.entry <KeyPress-Return> [concat dogatom_ok $id] | ||
1514 | $id.params.entry select from 0 | ||
1515 | $id.params.entry select adjust end | ||
1516 | focus $id.params.entry | ||
1517 | } | ||
1518 | |||
1519 | ############ pdtk_canvas_popup -- popup menu for canvas ######### | ||
1520 | |||
1521 | set popup_xpix 0 | ||
1522 | set popup_ypix 0 | ||
1523 | |||
1524 | proc popup_action {name action} { | ||
1525 | global popup_xpix popup_ypix | ||
1526 | set cmd [concat $name done-popup $action $popup_xpix $popup_ypix \;] | ||
1527 | # puts stderr $cmd | ||
1528 | pd $cmd | ||
1529 | } | ||
1530 | |||
1531 | proc pdtk_canvas_popup {name xpix ypix canprop canopen} { | ||
1532 | global popup_xpix popup_ypix | ||
1533 | set popup_xpix $xpix | ||
1534 | set popup_ypix $ypix | ||
1535 | if {$canprop == 0} {$name.popup entryconfigure 0 -state disabled} | ||
1536 | if {$canprop == 1} {$name.popup entryconfigure 0 -state active} | ||
1537 | if {$canopen == 0} {$name.popup entryconfigure 1 -state disabled} | ||
1538 | if {$canopen == 1} {$name.popup entryconfigure 1 -state active} | ||
1539 | tk_popup $name.popup [expr $xpix + [winfo rootx $name.c]] \ | ||
1540 | [expr $ypix + [winfo rooty $name.c]] 0 | ||
1541 | } | ||
1542 | |||
1543 | ############ pdtk_graph_dialog -- dialog window for graphs ######### | ||
1544 | |||
1545 | # the graph and array dialogs can come up in many copies; but in TK the easiest | ||
1546 | # way to get data from an "entry", etc., is to set an associated variable | ||
1547 | # name. This is especially true for grouped "radio buttons". So we have | ||
1548 | # to synthesize variable names for each instance of the dialog. The dialog | ||
1549 | # gets a TK pathname $id, from which it strips the leading "." to make a | ||
1550 | # variable suffix $vid. Then you can get the actual value out by asking for | ||
1551 | # [eval concat $$variablename]. There should be an easier way but I don't see | ||
1552 | # it yet. | ||
1553 | |||
1554 | proc graph_apply {id} { | ||
1555 | # strip "." from the TK id to make a variable name suffix | ||
1556 | set vid [string trimleft $id .] | ||
1557 | # for each variable, make a local variable to hold its name... | ||
1558 | set var_graph_x1 [concat graph_x1_$vid] | ||
1559 | global $var_graph_x1 | ||
1560 | set var_graph_x2 [concat graph_x2_$vid] | ||
1561 | global $var_graph_x2 | ||
1562 | set var_graph_xpix [concat graph_xpix_$vid] | ||
1563 | global $var_graph_xpix | ||
1564 | set var_graph_y1 [concat graph_y1_$vid] | ||
1565 | global $var_graph_y1 | ||
1566 | set var_graph_y2 [concat graph_y2_$vid] | ||
1567 | global $var_graph_y2 | ||
1568 | set var_graph_ypix [concat graph_ypix_$vid] | ||
1569 | global $var_graph_ypix | ||
1570 | |||
1571 | pd [concat $id dialog \ | ||
1572 | [eval concat $$var_graph_x1] \ | ||
1573 | [eval concat $$var_graph_y1] \ | ||
1574 | [eval concat $$var_graph_x2] \ | ||
1575 | [eval concat $$var_graph_y2] \ | ||
1576 | [eval concat $$var_graph_xpix] \ | ||
1577 | [eval concat $$var_graph_ypix] \ | ||
1578 | \;] | ||
1579 | } | ||
1580 | |||
1581 | proc graph_cancel {id} { | ||
1582 | set cmd [concat $id cancel \;] | ||
1583 | # puts stderr $cmd | ||
1584 | pd $cmd | ||
1585 | } | ||
1586 | |||
1587 | proc graph_ok {id} { | ||
1588 | graph_apply $id | ||
1589 | graph_cancel $id | ||
1590 | } | ||
1591 | |||
1592 | proc pdtk_graph_dialog {id x1 y1 x2 y2 xpix ypix} { | ||
1593 | set vid [string trimleft $id .] | ||
1594 | set var_graph_x1 [concat graph_x1_$vid] | ||
1595 | global $var_graph_x1 | ||
1596 | set var_graph_x2 [concat graph_x2_$vid] | ||
1597 | global $var_graph_x2 | ||
1598 | set var_graph_xpix [concat graph_xpix_$vid] | ||
1599 | global $var_graph_xpix | ||
1600 | set var_graph_y1 [concat graph_y1_$vid] | ||
1601 | global $var_graph_y1 | ||
1602 | set var_graph_y2 [concat graph_y2_$vid] | ||
1603 | global $var_graph_y2 | ||
1604 | set var_graph_ypix [concat graph_ypix_$vid] | ||
1605 | global $var_graph_ypix | ||
1606 | |||
1607 | set $var_graph_x1 $x1 | ||
1608 | set $var_graph_x2 $x2 | ||
1609 | set $var_graph_xpix $xpix | ||
1610 | set $var_graph_y1 $y1 | ||
1611 | set $var_graph_y2 $y2 | ||
1612 | set $var_graph_ypix $ypix | ||
1613 | |||
1614 | toplevel $id | ||
1615 | wm title $id {graph} | ||
1616 | wm protocol $id WM_DELETE_WINDOW [concat graph_cancel $id] | ||
1617 | |||
1618 | label $id.label -text {GRAPH BOUNDS} | ||
1619 | pack $id.label -side top | ||
1620 | |||
1621 | frame $id.buttonframe | ||
1622 | pack $id.buttonframe -side bottom -fill x -pady 2m | ||
1623 | button $id.buttonframe.cancel -text {Cancel}\ | ||
1624 | -command "graph_cancel $id" | ||
1625 | button $id.buttonframe.apply -text {Apply}\ | ||
1626 | -command "graph_apply $id" | ||
1627 | button $id.buttonframe.ok -text {OK}\ | ||
1628 | -command "graph_ok $id" | ||
1629 | pack $id.buttonframe.cancel -side left -expand 1 | ||
1630 | pack $id.buttonframe.apply -side left -expand 1 | ||
1631 | pack $id.buttonframe.ok -side left -expand 1 | ||
1632 | |||
1633 | frame $id.xrangef | ||
1634 | pack $id.xrangef -side top | ||
1635 | |||
1636 | label $id.xrangef.l1 -text "X from:" | ||
1637 | entry $id.xrangef.x1 -textvariable $var_graph_x1 -width 7 | ||
1638 | label $id.xrangef.l2 -text "to:" | ||
1639 | entry $id.xrangef.x2 -textvariable $var_graph_x2 -width 7 | ||
1640 | label $id.xrangef.l3 -text "screen width:" | ||
1641 | entry $id.xrangef.xpix -textvariable $var_graph_xpix -width 7 | ||
1642 | pack $id.xrangef.l1 $id.xrangef.x1 \ | ||
1643 | $id.xrangef.l2 $id.xrangef.x2 \ | ||
1644 | $id.xrangef.l3 $id.xrangef.xpix -side left | ||
1645 | |||
1646 | frame $id.yrangef | ||
1647 | pack $id.yrangef -side top | ||
1648 | |||
1649 | # dig in the following that the upper bound is labeled y1 but the variable is | ||
1650 | # y2, etc. This is to deal with the inconsistent use of "upper and lower" | ||
1651 | # graph bounds... in the dialog the upper Y bound is the lower valued Y pixel. | ||
1652 | label $id.yrangef.l1 -text "Y from:" | ||
1653 | entry $id.yrangef.y1 -textvariable $var_graph_y2 -width 7 | ||
1654 | label $id.yrangef.l2 -text "to:" | ||
1655 | entry $id.yrangef.y2 -textvariable $var_graph_y1 -width 7 | ||
1656 | label $id.yrangef.l3 -text "screen height:" | ||
1657 | entry $id.yrangef.ypix -textvariable $var_graph_ypix -width 7 | ||
1658 | pack $id.yrangef.l1 $id.yrangef.y1 \ | ||
1659 | $id.yrangef.l2 $id.yrangef.y2 \ | ||
1660 | $id.yrangef.l3 $id.yrangef.ypix -side left | ||
1661 | |||
1662 | bind $id.xrangef.x1 <KeyPress-Return> [concat graph_ok $id] | ||
1663 | bind $id.xrangef.x2 <KeyPress-Return> [concat graph_ok $id] | ||
1664 | bind $id.xrangef.xpix <KeyPress-Return> [concat graph_ok $id] | ||
1665 | bind $id.yrangef.y1 <KeyPress-Return> [concat graph_ok $id] | ||
1666 | bind $id.yrangef.y2 <KeyPress-Return> [concat graph_ok $id] | ||
1667 | bind $id.yrangef.ypix <KeyPress-Return> [concat graph_ok $id] | ||
1668 | $id.xrangef.x2 select from 0 | ||
1669 | $id.xrangef.x2 select adjust end | ||
1670 | focus $id.xrangef.x2 | ||
1671 | } | ||
1672 | |||
1673 | # begin of change "iemlib" | ||
1674 | ############ pdtk_iemgui_dialog -- dialog window for iem guis ######### | ||
1675 | |||
1676 | set iemgui_define_min_flashhold 50 | ||
1677 | set iemgui_define_min_flashbreak 10 | ||
1678 | set iemgui_define_min_fontsize 4 | ||
1679 | |||
1680 | proc iemgui_clip_dim {id} { | ||
1681 | set vid [string trimleft $id .] | ||
1682 | |||
1683 | set var_iemgui_wdt [concat iemgui_wdt_$vid] | ||
1684 | global $var_iemgui_wdt | ||
1685 | set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid] | ||
1686 | global $var_iemgui_min_wdt | ||
1687 | set var_iemgui_hgt [concat iemgui_hgt_$vid] | ||
1688 | global $var_iemgui_hgt | ||
1689 | set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid] | ||
1690 | global $var_iemgui_min_hgt | ||
1691 | |||
1692 | if {[eval concat $$var_iemgui_wdt] < [eval concat $$var_iemgui_min_wdt]} { | ||
1693 | set $var_iemgui_wdt [eval concat $$var_iemgui_min_wdt] | ||
1694 | $id.dim.w_ent configure -textvariable $var_iemgui_wdt | ||
1695 | } | ||
1696 | if {[eval concat $$var_iemgui_hgt] < [eval concat $$var_iemgui_min_hgt]} { | ||
1697 | set $var_iemgui_hgt [eval concat $$var_iemgui_min_hgt] | ||
1698 | $id.dim.h_ent configure -textvariable $var_iemgui_hgt | ||
1699 | } | ||
1700 | } | ||
1701 | |||
1702 | proc iemgui_clip_num {id} { | ||
1703 | set vid [string trimleft $id .] | ||
1704 | |||
1705 | set var_iemgui_num [concat iemgui_num_$vid] | ||
1706 | global $var_iemgui_num | ||
1707 | |||
1708 | if {[eval concat $$var_iemgui_num] > 2000} { | ||
1709 | set $var_iemgui_num 2000 | ||
1710 | $id.para.num_ent configure -textvariable $var_iemgui_num | ||
1711 | } | ||
1712 | if {[eval concat $$var_iemgui_num] < 1} { | ||
1713 | set $var_iemgui_num 1 | ||
1714 | $id.para.num_ent configure -textvariable $var_iemgui_num | ||
1715 | } | ||
1716 | } | ||
1717 | |||
1718 | proc iemgui_sched_rng {id} { | ||
1719 | set vid [string trimleft $id .] | ||
1720 | |||
1721 | set var_iemgui_min_rng [concat iemgui_min_rng_$vid] | ||
1722 | global $var_iemgui_min_rng | ||
1723 | set var_iemgui_max_rng [concat iemgui_max_rng_$vid] | ||
1724 | global $var_iemgui_max_rng | ||
1725 | set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid] | ||
1726 | global $var_iemgui_rng_sch | ||
1727 | |||
1728 | global iemgui_define_min_flashhold | ||
1729 | global iemgui_define_min_flashbreak | ||
1730 | |||
1731 | if {[eval concat $$var_iemgui_rng_sch] == 2} { | ||
1732 | if {[eval concat $$var_iemgui_max_rng] < [eval concat $$var_iemgui_min_rng]} { | ||
1733 | set hhh [eval concat $$var_iemgui_min_rng] | ||
1734 | set $var_iemgui_min_rng [eval concat $$var_iemgui_max_rng] | ||
1735 | set $var_iemgui_max_rng $hhh | ||
1736 | $id.rng.max_ent configure -textvariable $var_iemgui_max_rng | ||
1737 | $id.rng.min_ent configure -textvariable $var_iemgui_min_rng } | ||
1738 | if {[eval concat $$var_iemgui_max_rng] < $iemgui_define_min_flashhold} { | ||
1739 | set $var_iemgui_max_rng $iemgui_define_min_flashhold | ||
1740 | $id.rng.max_ent configure -textvariable $var_iemgui_max_rng | ||
1741 | } | ||
1742 | if {[eval concat $$var_iemgui_min_rng] < $iemgui_define_min_flashbreak} { | ||
1743 | set $var_iemgui_min_rng $iemgui_define_min_flashbreak | ||
1744 | $id.rng.min_ent configure -textvariable $var_iemgui_min_rng | ||
1745 | } | ||
1746 | } | ||
1747 | if {[eval concat $$var_iemgui_rng_sch] == 1} { | ||
1748 | if {[eval concat $$var_iemgui_min_rng] == 0.0} { | ||
1749 | set $var_iemgui_min_rng 1.0 | ||
1750 | $id.rng.min_ent configure -textvariable $var_iemgui_min_rng | ||
1751 | } | ||
1752 | } | ||
1753 | } | ||
1754 | |||
1755 | proc iemgui_verify_rng {id} { | ||
1756 | set vid [string trimleft $id .] | ||
1757 | |||
1758 | set var_iemgui_min_rng [concat iemgui_min_rng_$vid] | ||
1759 | global $var_iemgui_min_rng | ||
1760 | set var_iemgui_max_rng [concat iemgui_max_rng_$vid] | ||
1761 | global $var_iemgui_max_rng | ||
1762 | set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] | ||
1763 | global $var_iemgui_lin0_log1 | ||
1764 | |||
1765 | if {[eval concat $$var_iemgui_lin0_log1] == 1} { | ||
1766 | if {[eval concat $$var_iemgui_max_rng] == 0.0 && [eval concat $$var_iemgui_min_rng] == 0.0} { | ||
1767 | set $var_iemgui_max_rng 1.0 | ||
1768 | $id.rng.max_ent configure -textvariable $var_iemgui_max_rng | ||
1769 | } | ||
1770 | if {[eval concat $$var_iemgui_max_rng] > 0} { | ||
1771 | if {[eval concat $$var_iemgui_min_rng] <= 0} { | ||
1772 | set $var_iemgui_min_rng [expr [eval concat $$var_iemgui_max_rng] * 0.01] | ||
1773 | $id.rng.min_ent configure -textvariable $var_iemgui_min_rng | ||
1774 | } | ||
1775 | } else { | ||
1776 | if {[eval concat $$var_iemgui_min_rng] > 0} { | ||
1777 | set $var_iemgui_max_rng [expr [eval concat $$var_iemgui_min_rng] * 0.01] | ||
1778 | $id.rng.max_ent configure -textvariable $var_iemgui_max_rng | ||
1779 | } | ||
1780 | } | ||
1781 | } | ||
1782 | } | ||
1783 | |||
1784 | proc iemgui_clip_fontsize {id} { | ||
1785 | set vid [string trimleft $id .] | ||
1786 | |||
1787 | set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid] | ||
1788 | global $var_iemgui_gn_fs | ||
1789 | |||
1790 | global iemgui_define_min_fontsize | ||
1791 | |||
1792 | if {[eval concat $$var_iemgui_gn_fs] < $iemgui_define_min_fontsize} { | ||
1793 | set $var_iemgui_gn_fs $iemgui_define_min_fontsize | ||
1794 | $id.gnfs.fs_ent configure -textvariable $var_iemgui_gn_fs | ||
1795 | } | ||
1796 | } | ||
1797 | |||
1798 | proc iemgui_set_col_example {id} { | ||
1799 | set vid [string trimleft $id .] | ||
1800 | |||
1801 | set var_iemgui_bcol [concat iemgui_bcol_$vid] | ||
1802 | global $var_iemgui_bcol | ||
1803 | set var_iemgui_fcol [concat iemgui_fcol_$vid] | ||
1804 | global $var_iemgui_fcol | ||
1805 | set var_iemgui_lcol [concat iemgui_lcol_$vid] | ||
1806 | global $var_iemgui_lcol | ||
1807 | |||
1808 | $id.col_example_choose.lb_bk configure \ | ||
1809 | -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
1810 | -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
1811 | -foreground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \ | ||
1812 | -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] | ||
1813 | |||
1814 | if { [eval concat $$var_iemgui_fcol] >= 0 } { | ||
1815 | $id.col_example_choose.fr_bk configure \ | ||
1816 | -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
1817 | -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
1818 | -foreground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \ | ||
1819 | -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] | ||
1820 | } else { | ||
1821 | $id.col_example_choose.fr_bk configure \ | ||
1822 | -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
1823 | -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
1824 | -foreground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
1825 | -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]]} | ||
1826 | } | ||
1827 | |||
1828 | proc iemgui_preset_col {id presetcol} { | ||
1829 | set vid [string trimleft $id .] | ||
1830 | |||
1831 | set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid] | ||
1832 | global $var_iemgui_l2_f1_b0 | ||
1833 | set var_iemgui_bcol [concat iemgui_bcol_$vid] | ||
1834 | global $var_iemgui_bcol | ||
1835 | set var_iemgui_fcol [concat iemgui_fcol_$vid] | ||
1836 | global $var_iemgui_fcol | ||
1837 | set var_iemgui_lcol [concat iemgui_lcol_$vid] | ||
1838 | global $var_iemgui_lcol | ||
1839 | |||
1840 | if { [eval concat $$var_iemgui_l2_f1_b0] == 0 } { set $var_iemgui_bcol $presetcol } | ||
1841 | if { [eval concat $$var_iemgui_l2_f1_b0] == 1 } { set $var_iemgui_fcol $presetcol } | ||
1842 | if { [eval concat $$var_iemgui_l2_f1_b0] == 2 } { set $var_iemgui_lcol $presetcol } | ||
1843 | iemgui_set_col_example $id | ||
1844 | } | ||
1845 | |||
1846 | proc iemgui_choose_col_bkfrlb {id} { | ||
1847 | set vid [string trimleft $id .] | ||
1848 | |||
1849 | set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid] | ||
1850 | global $var_iemgui_l2_f1_b0 | ||
1851 | set var_iemgui_bcol [concat iemgui_bcol_$vid] | ||
1852 | global $var_iemgui_bcol | ||
1853 | set var_iemgui_fcol [concat iemgui_fcol_$vid] | ||
1854 | global $var_iemgui_fcol | ||
1855 | set var_iemgui_lcol [concat iemgui_lcol_$vid] | ||
1856 | global $var_iemgui_lcol | ||
1857 | |||
1858 | if {[eval concat $$var_iemgui_l2_f1_b0] == 0} { | ||
1859 | set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC] | ||
1860 | set helpstring [tk_chooseColor -title "Background-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_bcol]]] | ||
1861 | if { $helpstring != "" } { | ||
1862 | set $var_iemgui_bcol [string replace $helpstring 0 0 "0x"] | ||
1863 | set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC] } | ||
1864 | } | ||
1865 | if {[eval concat $$var_iemgui_l2_f1_b0] == 1} { | ||
1866 | set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC] | ||
1867 | set helpstring [tk_chooseColor -title "Front-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_fcol]]] | ||
1868 | if { $helpstring != "" } { | ||
1869 | set $var_iemgui_fcol [string replace $helpstring 0 0 "0x"] | ||
1870 | set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC] } | ||
1871 | } | ||
1872 | if {[eval concat $$var_iemgui_l2_f1_b0] == 2} { | ||
1873 | set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC] | ||
1874 | set helpstring [tk_chooseColor -title "Label-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_lcol]]] | ||
1875 | if { $helpstring != "" } { | ||
1876 | set $var_iemgui_lcol [string replace $helpstring 0 0 "0x"] | ||
1877 | set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC] } | ||
1878 | } | ||
1879 | iemgui_set_col_example $id | ||
1880 | } | ||
1881 | |||
1882 | proc iemgui_lilo {id} { | ||
1883 | set vid [string trimleft $id .] | ||
1884 | |||
1885 | set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] | ||
1886 | global $var_iemgui_lin0_log1 | ||
1887 | set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] | ||
1888 | global $var_iemgui_lilo0 | ||
1889 | set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] | ||
1890 | global $var_iemgui_lilo1 | ||
1891 | |||
1892 | iemgui_sched_rng $id | ||
1893 | |||
1894 | if {[eval concat $$var_iemgui_lin0_log1] == 0} { | ||
1895 | set $var_iemgui_lin0_log1 1 | ||
1896 | $id.para.lilo configure -text [eval concat $$var_iemgui_lilo1] | ||
1897 | iemgui_verify_rng $id | ||
1898 | iemgui_sched_rng $id | ||
1899 | } else { | ||
1900 | set $var_iemgui_lin0_log1 0 | ||
1901 | $id.para.lilo configure -text [eval concat $$var_iemgui_lilo0] | ||
1902 | } | ||
1903 | } | ||
1904 | |||
1905 | proc iemgui_toggle_font {id} { | ||
1906 | set vid [string trimleft $id .] | ||
1907 | |||
1908 | set var_iemgui_gn_f [concat iemgui_gn_f_$vid] | ||
1909 | global $var_iemgui_gn_f | ||
1910 | |||
1911 | set $var_iemgui_gn_f [expr [eval concat $$var_iemgui_gn_f] + 1] | ||
1912 | if {[eval concat $$var_iemgui_gn_f] > 2} {set $var_iemgui_gn_f 0} | ||
1913 | if {[eval concat $$var_iemgui_gn_f] == 0} {$id.gnfs.fb configure -text "courier" -font {courier 10 bold}} | ||
1914 | if {[eval concat $$var_iemgui_gn_f] == 1} {$id.gnfs.fb configure -text "helvetica" -font {helvetica 10 bold}} | ||
1915 | if {[eval concat $$var_iemgui_gn_f] == 2} {$id.gnfs.fb configure -text "times" -font {times 10 bold}} | ||
1916 | } | ||
1917 | |||
1918 | proc iemgui_lb {id} { | ||
1919 | set vid [string trimleft $id .] | ||
1920 | |||
1921 | set var_iemgui_loadbang [concat iemgui_loadbang_$vid] | ||
1922 | global $var_iemgui_loadbang | ||
1923 | |||
1924 | if {[eval concat $$var_iemgui_loadbang] == 0} { | ||
1925 | set $var_iemgui_loadbang 1 | ||
1926 | $id.para.lb configure -text "init" | ||
1927 | } else { | ||
1928 | set $var_iemgui_loadbang 0 | ||
1929 | $id.para.lb configure -text "no init" | ||
1930 | } | ||
1931 | } | ||
1932 | |||
1933 | proc iemgui_stdy_jmp {id} { | ||
1934 | set vid [string trimleft $id .] | ||
1935 | |||
1936 | set var_iemgui_steady [concat iemgui_steady_$vid] | ||
1937 | global $var_iemgui_steady | ||
1938 | |||
1939 | if {[eval concat $$var_iemgui_steady]} { | ||
1940 | set $var_iemgui_steady 0 | ||
1941 | $id.para.stdy_jmp configure -text "jump on click" | ||
1942 | } else { | ||
1943 | set $var_iemgui_steady 1 | ||
1944 | $id.para.stdy_jmp configure -text "steady on click" | ||
1945 | } | ||
1946 | } | ||
1947 | |||
1948 | proc iemgui_apply {id} { | ||
1949 | set vid [string trimleft $id .] | ||
1950 | |||
1951 | set var_iemgui_wdt [concat iemgui_wdt_$vid] | ||
1952 | global $var_iemgui_wdt | ||
1953 | set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid] | ||
1954 | global $var_iemgui_min_wdt | ||
1955 | set var_iemgui_hgt [concat iemgui_hgt_$vid] | ||
1956 | global $var_iemgui_hgt | ||
1957 | set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid] | ||
1958 | global $var_iemgui_min_hgt | ||
1959 | set var_iemgui_min_rng [concat iemgui_min_rng_$vid] | ||
1960 | global $var_iemgui_min_rng | ||
1961 | set var_iemgui_max_rng [concat iemgui_max_rng_$vid] | ||
1962 | global $var_iemgui_max_rng | ||
1963 | set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] | ||
1964 | global $var_iemgui_lin0_log1 | ||
1965 | set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] | ||
1966 | global $var_iemgui_lilo0 | ||
1967 | set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] | ||
1968 | global $var_iemgui_lilo1 | ||
1969 | set var_iemgui_loadbang [concat iemgui_loadbang_$vid] | ||
1970 | global $var_iemgui_loadbang | ||
1971 | set var_iemgui_num [concat iemgui_num_$vid] | ||
1972 | global $var_iemgui_num | ||
1973 | set var_iemgui_steady [concat iemgui_steady_$vid] | ||
1974 | global $var_iemgui_steady | ||
1975 | set var_iemgui_snd [concat iemgui_snd_$vid] | ||
1976 | global $var_iemgui_snd | ||
1977 | set var_iemgui_rcv [concat iemgui_rcv_$vid] | ||
1978 | global $var_iemgui_rcv | ||
1979 | set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid] | ||
1980 | global $var_iemgui_gui_nam | ||
1981 | set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid] | ||
1982 | global $var_iemgui_gn_dx | ||
1983 | set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid] | ||
1984 | global $var_iemgui_gn_dy | ||
1985 | set var_iemgui_gn_f [concat iemgui_gn_f_$vid] | ||
1986 | global $var_iemgui_gn_f | ||
1987 | set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid] | ||
1988 | global $var_iemgui_gn_fs | ||
1989 | set var_iemgui_bcol [concat iemgui_bcol_$vid] | ||
1990 | global $var_iemgui_bcol | ||
1991 | set var_iemgui_fcol [concat iemgui_fcol_$vid] | ||
1992 | global $var_iemgui_fcol | ||
1993 | set var_iemgui_lcol [concat iemgui_lcol_$vid] | ||
1994 | global $var_iemgui_lcol | ||
1995 | |||
1996 | iemgui_clip_dim $id | ||
1997 | iemgui_clip_num $id | ||
1998 | iemgui_sched_rng $id | ||
1999 | iemgui_verify_rng $id | ||
2000 | iemgui_sched_rng $id | ||
2001 | iemgui_clip_fontsize $id | ||
2002 | |||
2003 | if {[eval concat $$var_iemgui_snd] == ""} {set hhhsnd "empty"} else {set hhhsnd [eval concat $$var_iemgui_snd]} | ||
2004 | if {[eval concat $$var_iemgui_rcv] == ""} {set hhhrcv "empty"} else {set hhhrcv [eval concat $$var_iemgui_rcv]} | ||
2005 | if {[eval concat $$var_iemgui_gui_nam] == ""} {set hhhgui_nam "empty" | ||
2006 | } else { | ||
2007 | set hhhgui_nam [eval concat $$var_iemgui_gui_nam]} | ||
2008 | |||
2009 | if {[string index $hhhsnd 0] == "$"} { | ||
2010 | set hhhsnd [string replace $hhhsnd 0 0 #] } | ||
2011 | if {[string index $hhhrcv 0] == "$"} { | ||
2012 | set hhhrcv [string replace $hhhrcv 0 0 #] } | ||
2013 | if {[string index $hhhgui_nam 0] == "$"} { | ||
2014 | set hhhgui_nam [string replace $hhhgui_nam 0 0 #] } | ||
2015 | |||
2016 | set hhhsnd [string map {" " _} $hhhsnd] | ||
2017 | set hhhrcv [string map {" " _} $hhhrcv] | ||
2018 | set hhhgui_nam [string map {" " _} $hhhgui_nam] | ||
2019 | |||
2020 | pd [concat $id dialog \ | ||
2021 | [eval concat $$var_iemgui_wdt] \ | ||
2022 | [eval concat $$var_iemgui_hgt] \ | ||
2023 | [eval concat $$var_iemgui_min_rng] \ | ||
2024 | [eval concat $$var_iemgui_max_rng] \ | ||
2025 | [eval concat $$var_iemgui_lin0_log1] \ | ||
2026 | [eval concat $$var_iemgui_loadbang] \ | ||
2027 | [eval concat $$var_iemgui_num] \ | ||
2028 | $hhhsnd \ | ||
2029 | $hhhrcv \ | ||
2030 | $hhhgui_nam \ | ||
2031 | [eval concat $$var_iemgui_gn_dx] \ | ||
2032 | [eval concat $$var_iemgui_gn_dy] \ | ||
2033 | [eval concat $$var_iemgui_gn_f] \ | ||
2034 | [eval concat $$var_iemgui_gn_fs] \ | ||
2035 | [eval concat $$var_iemgui_bcol] \ | ||
2036 | [eval concat $$var_iemgui_fcol] \ | ||
2037 | [eval concat $$var_iemgui_lcol] \ | ||
2038 | [eval concat $$var_iemgui_steady] \ | ||
2039 | \;] | ||
2040 | } | ||
2041 | |||
2042 | proc iemgui_cancel {id} {pd [concat $id cancel \;]} | ||
2043 | |||
2044 | proc iemgui_ok {id} { | ||
2045 | iemgui_apply $id | ||
2046 | iemgui_cancel $id | ||
2047 | } | ||
2048 | |||
2049 | proc pdtk_iemgui_dialog {id mainheader \ | ||
2050 | dim_header wdt min_wdt wdt_label hgt min_hgt hgt_label \ | ||
2051 | rng_header min_rng min_rng_label max_rng max_rng_label rng_sched \ | ||
2052 | lin0_log1 lilo0_label lilo1_label loadbang steady num_label num \ | ||
2053 | snd rcv \ | ||
2054 | gui_name \ | ||
2055 | gn_dx gn_dy \ | ||
2056 | gn_f gn_fs \ | ||
2057 | bcol fcol lcol} { | ||
2058 | |||
2059 | set vid [string trimleft $id .] | ||
2060 | |||
2061 | set var_iemgui_wdt [concat iemgui_wdt_$vid] | ||
2062 | global $var_iemgui_wdt | ||
2063 | set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid] | ||
2064 | global $var_iemgui_min_wdt | ||
2065 | set var_iemgui_hgt [concat iemgui_hgt_$vid] | ||
2066 | global $var_iemgui_hgt | ||
2067 | set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid] | ||
2068 | global $var_iemgui_min_hgt | ||
2069 | set var_iemgui_min_rng [concat iemgui_min_rng_$vid] | ||
2070 | global $var_iemgui_min_rng | ||
2071 | set var_iemgui_max_rng [concat iemgui_max_rng_$vid] | ||
2072 | global $var_iemgui_max_rng | ||
2073 | set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid] | ||
2074 | global $var_iemgui_rng_sch | ||
2075 | set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] | ||
2076 | global $var_iemgui_lin0_log1 | ||
2077 | set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] | ||
2078 | global $var_iemgui_lilo0 | ||
2079 | set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] | ||
2080 | global $var_iemgui_lilo1 | ||
2081 | set var_iemgui_loadbang [concat iemgui_loadbang_$vid] | ||
2082 | global $var_iemgui_loadbang | ||
2083 | set var_iemgui_num [concat iemgui_num_$vid] | ||
2084 | global $var_iemgui_num | ||
2085 | set var_iemgui_steady [concat iemgui_steady_$vid] | ||
2086 | global $var_iemgui_steady | ||
2087 | set var_iemgui_snd [concat iemgui_snd_$vid] | ||
2088 | global $var_iemgui_snd | ||
2089 | set var_iemgui_rcv [concat iemgui_rcv_$vid] | ||
2090 | global $var_iemgui_rcv | ||
2091 | set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid] | ||
2092 | global $var_iemgui_gui_nam | ||
2093 | set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid] | ||
2094 | global $var_iemgui_gn_dx | ||
2095 | set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid] | ||
2096 | global $var_iemgui_gn_dy | ||
2097 | set var_iemgui_gn_f [concat iemgui_gn_f_$vid] | ||
2098 | global $var_iemgui_gn_f | ||
2099 | set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid] | ||
2100 | global $var_iemgui_gn_fs | ||
2101 | set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid] | ||
2102 | global $var_iemgui_l2_f1_b0 | ||
2103 | set var_iemgui_bcol [concat iemgui_bcol_$vid] | ||
2104 | global $var_iemgui_bcol | ||
2105 | set var_iemgui_fcol [concat iemgui_fcol_$vid] | ||
2106 | global $var_iemgui_fcol | ||
2107 | set var_iemgui_lcol [concat iemgui_lcol_$vid] | ||
2108 | global $var_iemgui_lcol | ||
2109 | |||
2110 | set $var_iemgui_wdt $wdt | ||
2111 | set $var_iemgui_min_wdt $min_wdt | ||
2112 | set $var_iemgui_hgt $hgt | ||
2113 | set $var_iemgui_min_hgt $min_hgt | ||
2114 | set $var_iemgui_min_rng $min_rng | ||
2115 | set $var_iemgui_max_rng $max_rng | ||
2116 | set $var_iemgui_rng_sch $rng_sched | ||
2117 | set $var_iemgui_lin0_log1 $lin0_log1 | ||
2118 | set $var_iemgui_lilo0 $lilo0_label | ||
2119 | set $var_iemgui_lilo1 $lilo1_label | ||
2120 | set $var_iemgui_loadbang $loadbang | ||
2121 | set $var_iemgui_num $num | ||
2122 | set $var_iemgui_steady $steady | ||
2123 | if {$snd == "empty"} {set $var_iemgui_snd [format ""] | ||
2124 | } else {set $var_iemgui_snd [format "%s" $snd]} | ||
2125 | if {$rcv == "empty"} {set $var_iemgui_rcv [format ""] | ||
2126 | } else {set $var_iemgui_rcv [format "%s" $rcv]} | ||
2127 | if {$gui_name == "empty"} {set $var_iemgui_gui_nam [format ""] | ||
2128 | } else {set $var_iemgui_gui_nam [format "%s" $gui_name]} | ||
2129 | |||
2130 | if {[string index [eval concat $$var_iemgui_snd] 0] == "#"} { | ||
2131 | set $var_iemgui_snd [string replace [eval concat $$var_iemgui_snd] 0 0 $] } | ||
2132 | if {[string index [eval concat $$var_iemgui_rcv] 0] == "#"} { | ||
2133 | set $var_iemgui_rcv [string replace [eval concat $$var_iemgui_rcv] 0 0 $] } | ||
2134 | if {[string index [eval concat $$var_iemgui_gui_nam] 0] == "#"} { | ||
2135 | set $var_iemgui_gui_nam [string replace [eval concat $$var_iemgui_gui_nam] 0 0 $] } | ||
2136 | set $var_iemgui_gn_dx $gn_dx | ||
2137 | set $var_iemgui_gn_dy $gn_dy | ||
2138 | set $var_iemgui_gn_f $gn_f | ||
2139 | set $var_iemgui_gn_fs $gn_fs | ||
2140 | |||
2141 | set $var_iemgui_bcol $bcol | ||
2142 | set $var_iemgui_fcol $fcol | ||
2143 | set $var_iemgui_lcol $lcol | ||
2144 | |||
2145 | set $var_iemgui_l2_f1_b0 0 | ||
2146 | |||
2147 | toplevel $id | ||
2148 | wm title $id [format "%s-PROPERTIES" $mainheader] | ||
2149 | wm protocol $id WM_DELETE_WINDOW [concat iemgui_cancel $id] | ||
2150 | |||
2151 | frame $id.dim | ||
2152 | pack $id.dim -side top | ||
2153 | label $id.dim.head -text $dim_header | ||
2154 | label $id.dim.w_lab -text $wdt_label -width 6 | ||
2155 | entry $id.dim.w_ent -textvariable $var_iemgui_wdt -width 5 | ||
2156 | label $id.dim.dummy1 -text " " -width 10 | ||
2157 | label $id.dim.h_lab -text $hgt_label -width 6 | ||
2158 | entry $id.dim.h_ent -textvariable $var_iemgui_hgt -width 5 | ||
2159 | pack $id.dim.head -side top | ||
2160 | pack $id.dim.w_lab $id.dim.w_ent $id.dim.dummy1 -side left | ||
2161 | if { $hgt_label != "empty" } { | ||
2162 | pack $id.dim.h_lab $id.dim.h_ent -side left} | ||
2163 | |||
2164 | frame $id.rng | ||
2165 | pack $id.rng -side top | ||
2166 | label $id.rng.head -text $rng_header | ||
2167 | label $id.rng.min_lab -text $min_rng_label -width 6 | ||
2168 | entry $id.rng.min_ent -textvariable $var_iemgui_min_rng -width 9 | ||
2169 | label $id.rng.dummy1 -text " " -width 1 | ||
2170 | label $id.rng.max_lab -text $max_rng_label -width 8 | ||
2171 | entry $id.rng.max_ent -textvariable $var_iemgui_max_rng -width 9 | ||
2172 | if { $rng_header != "empty" } { | ||
2173 | pack $id.rng.head -side top | ||
2174 | if { $min_rng_label != "empty" } { | ||
2175 | pack $id.rng.min_lab $id.rng.min_ent -side left} | ||
2176 | if { $max_rng_label != "empty" } { | ||
2177 | pack $id.rng.dummy1 \ | ||
2178 | $id.rng.max_lab $id.rng.max_ent -side left} } | ||
2179 | |||
2180 | if { [eval concat $$var_iemgui_lin0_log1] >= 0 || [eval concat $$var_iemgui_loadbang] >= 0 || [eval concat $$var_iemgui_num] > 0 || [eval concat $$var_iemgui_steady] >= 0 } { | ||
2181 | label $id.space1 -text "---------------------------------" | ||
2182 | pack $id.space1 -side top } | ||
2183 | |||
2184 | frame $id.para | ||
2185 | pack $id.para -side top | ||
2186 | label $id.para.dummy2 -text "" -width 1 | ||
2187 | label $id.para.dummy3 -text "" -width 1 | ||
2188 | if {[eval concat $$var_iemgui_lin0_log1] == 0} { | ||
2189 | button $id.para.lilo -text [eval concat $$var_iemgui_lilo0] -width 5 -command "iemgui_lilo $id" } | ||
2190 | if {[eval concat $$var_iemgui_lin0_log1] == 1} { | ||
2191 | button $id.para.lilo -text [eval concat $$var_iemgui_lilo1] -width 5 -command "iemgui_lilo $id" } | ||
2192 | if {[eval concat $$var_iemgui_loadbang] == 0} { | ||
2193 | button $id.para.lb -text "no init" -width 5 -command "iemgui_lb $id" } | ||
2194 | if {[eval concat $$var_iemgui_loadbang] == 1} { | ||
2195 | button $id.para.lb -text "init" -width 5 -command "iemgui_lb $id" } | ||
2196 | label $id.para.num_lab -text $num_label -width 9 | ||
2197 | entry $id.para.num_ent -textvariable $var_iemgui_num -width 4 | ||
2198 | if {[eval concat $$var_iemgui_steady] == 0} { | ||
2199 | button $id.para.stdy_jmp -text "jump on click" -width 11 -command "iemgui_stdy_jmp $id" } | ||
2200 | if {[eval concat $$var_iemgui_steady] == 1} { | ||
2201 | button $id.para.stdy_jmp -text "steady on click" -width 11 -command "iemgui_stdy_jmp $id" } | ||
2202 | if {[eval concat $$var_iemgui_lin0_log1] >= 0} { | ||
2203 | pack $id.para.lilo -side left -expand 1} | ||
2204 | if {[eval concat $$var_iemgui_loadbang] >= 0} { | ||
2205 | pack $id.para.dummy2 $id.para.lb -side left -expand 1} | ||
2206 | if {[eval concat $$var_iemgui_num] > 0} { | ||
2207 | pack $id.para.dummy3 $id.para.num_lab $id.para.num_ent -side left -expand 1} | ||
2208 | if {[eval concat $$var_iemgui_steady] >= 0} { | ||
2209 | pack $id.para.dummy3 $id.para.stdy_jmp -side left -expand 1} | ||
2210 | if { $snd != "nosndno" || $rcv != "norcvno" } { | ||
2211 | label $id.space2 -text "---------------------------------" | ||
2212 | pack $id.space2 -side top } | ||
2213 | |||
2214 | frame $id.snd | ||
2215 | pack $id.snd -side top | ||
2216 | label $id.snd.dummy1 -text "" -width 2 | ||
2217 | label $id.snd.lab -text "send-symbol:" -width 12 | ||
2218 | entry $id.snd.ent -textvariable $var_iemgui_snd -width 20 | ||
2219 | if { $snd != "nosndno" } { | ||
2220 | pack $id.snd.dummy1 $id.snd.lab $id.snd.ent -side left} | ||
2221 | |||
2222 | frame $id.rcv | ||
2223 | pack $id.rcv -side top | ||
2224 | label $id.rcv.lab -text "receive-symbol:" -width 15 | ||
2225 | entry $id.rcv.ent -textvariable $var_iemgui_rcv -width 20 | ||
2226 | if { $rcv != "norcvno" } { | ||
2227 | pack $id.rcv.lab $id.rcv.ent -side left} | ||
2228 | |||
2229 | frame $id.gnam | ||
2230 | pack $id.gnam -side top | ||
2231 | label $id.gnam.head -text "--------------label:---------------" | ||
2232 | label $id.gnam.dummy1 -text "" -width 1 | ||
2233 | label $id.gnam.lab -text "name:" -width 6 | ||
2234 | entry $id.gnam.ent -textvariable $var_iemgui_gui_nam -width 29 | ||
2235 | label $id.gnam.dummy2 -text "" -width 1 | ||
2236 | pack $id.gnam.head -side top | ||
2237 | pack $id.gnam.dummy1 $id.gnam.lab $id.gnam.ent $id.gnam.dummy2 -side left | ||
2238 | |||
2239 | frame $id.gnxy | ||
2240 | pack $id.gnxy -side top | ||
2241 | label $id.gnxy.x_lab -text "x_off:" -width 6 | ||
2242 | entry $id.gnxy.x_ent -textvariable $var_iemgui_gn_dx -width 5 | ||
2243 | label $id.gnxy.dummy1 -text " " -width 10 | ||
2244 | label $id.gnxy.y_lab -text "y_off:" -width 6 | ||
2245 | entry $id.gnxy.y_ent -textvariable $var_iemgui_gn_dy -width 5 | ||
2246 | pack $id.gnxy.x_lab $id.gnxy.x_ent $id.gnxy.dummy1 \ | ||
2247 | $id.gnxy.y_lab $id.gnxy.y_ent -side left | ||
2248 | |||
2249 | frame $id.gnfs | ||
2250 | pack $id.gnfs -side top | ||
2251 | label $id.gnfs.f_lab -text "font:" -width 6 | ||
2252 | if {[eval concat $$var_iemgui_gn_f] == 0} { | ||
2253 | button $id.gnfs.fb -text "courier" -font {courier 10 bold} -width 7 -command "iemgui_toggle_font $id" } | ||
2254 | if {[eval concat $$var_iemgui_gn_f] == 1} { | ||
2255 | button $id.gnfs.fb -text "helvetica" -font {helvetica 10 bold} -width 7 -command "iemgui_toggle_font $id" } | ||
2256 | if {[eval concat $$var_iemgui_gn_f] == 2} { | ||
2257 | button $id.gnfs.fb -text "times" -font {times 10 bold} -width 7 -command "iemgui_toggle_font $id" } | ||
2258 | label $id.gnfs.dummy1 -text "" -width 1 | ||
2259 | label $id.gnfs.fs_lab -text "fontsize:" -width 8 | ||
2260 | entry $id.gnfs.fs_ent -textvariable $var_iemgui_gn_fs -width 5 | ||
2261 | pack $id.gnfs.f_lab $id.gnfs.fb $id.gnfs.dummy1 \ | ||
2262 | $id.gnfs.fs_lab $id.gnfs.fs_ent -side left | ||
2263 | |||
2264 | label $id.col_head -text "--------------colors:--------------" | ||
2265 | pack $id.col_head -side top | ||
2266 | |||
2267 | frame $id.col_select | ||
2268 | pack $id.col_select -side top | ||
2269 | radiobutton $id.col_select.radio0 -value 0 -variable $var_iemgui_l2_f1_b0 \ | ||
2270 | -text "backgd" -width 5 | ||
2271 | radiobutton $id.col_select.radio1 -value 1 -variable $var_iemgui_l2_f1_b0 \ | ||
2272 | -text "front" -width 5 | ||
2273 | radiobutton $id.col_select.radio2 -value 2 -variable $var_iemgui_l2_f1_b0 \ | ||
2274 | -text "label" -width 5 | ||
2275 | if { [eval concat $$var_iemgui_fcol] >= 0 } { | ||
2276 | pack $id.col_select.radio0 $id.col_select.radio1 $id.col_select.radio2 -side left | ||
2277 | } else {pack $id.col_select.radio0 $id.col_select.radio2 -side left} | ||
2278 | |||
2279 | frame $id.col_example_choose | ||
2280 | pack $id.col_example_choose -side top | ||
2281 | button $id.col_example_choose.but -text "compose color" -width 10 \ | ||
2282 | -command "iemgui_choose_col_bkfrlb $id" | ||
2283 | label $id.col_example_choose.dummy1 -text "" -width 1 | ||
2284 | if { [eval concat $$var_iemgui_fcol] >= 0 } { | ||
2285 | button $id.col_example_choose.fr_bk -text "o=||=o" -width 5 \ | ||
2286 | -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
2287 | -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
2288 | -foreground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \ | ||
2289 | -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] -pady 2 | ||
2290 | } else { | ||
2291 | button $id.col_example_choose.fr_bk -text "o=||=o" -width 5 \ | ||
2292 | -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
2293 | -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
2294 | -foreground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
2295 | -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] -pady 2} | ||
2296 | button $id.col_example_choose.lb_bk -text "testlabel" -width 7 \ | ||
2297 | -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
2298 | -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
2299 | -foreground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \ | ||
2300 | -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] -pady 2 | ||
2301 | |||
2302 | pack $id.col_example_choose.but $id.col_example_choose.dummy1 \ | ||
2303 | $id.col_example_choose.fr_bk $id.col_example_choose.lb_bk -side left | ||
2304 | |||
2305 | label $id.space3 -text "------or click color preset:-------" | ||
2306 | pack $id.space3 -side top | ||
2307 | |||
2308 | frame $id.bcol | ||
2309 | pack $id.bcol -side top | ||
2310 | foreach i { 0 1 2 3 4 5 6 7 8 9 } hexcol { 16579836 14737632 12369084 \ | ||
2311 | 16572640 16572608 16579784 14220504 14220540 14476540 16308476 } { | ||
2312 | button $id.bcol.c$i -background [format "#%6.6x" $hexcol] \ | ||
2313 | -activebackground [format "#%6.6x" $hexcol] \ | ||
2314 | -font {courier 2 normal} -padx 7 -pady 6 \ | ||
2315 | -command [format "iemgui_preset_col %s %d" $id $hexcol] } | ||
2316 | pack $id.bcol.c0 $id.bcol.c1 $id.bcol.c2 $id.bcol.c3 $id.bcol.c4 \ | ||
2317 | $id.bcol.c5 $id.bcol.c6 $id.bcol.c7 $id.bcol.c8 $id.bcol.c9 -side left | ||
2318 | |||
2319 | frame $id.fcol | ||
2320 | pack $id.fcol -side top | ||
2321 | foreach i { 0 1 2 3 4 5 6 7 8 9 } hexcol { 10526880 8158332 6316128 \ | ||
2322 | 16525352 16559172 15263784 1370132 2684148 3952892 16003312 } { | ||
2323 | button $id.fcol.c$i -background [format "#%6.6x" $hexcol] \ | ||
2324 | -activebackground [format "#%6.6x" $hexcol] \ | ||
2325 | -font {courier 2 normal} -padx 7 -pady 6 \ | ||
2326 | -command [format "iemgui_preset_col %s %d" $id $hexcol] } | ||
2327 | pack $id.fcol.c0 $id.fcol.c1 $id.fcol.c2 $id.fcol.c3 $id.fcol.c4 \ | ||
2328 | $id.fcol.c5 $id.fcol.c6 $id.fcol.c7 $id.fcol.c8 $id.fcol.c9 -side left | ||
2329 | |||
2330 | frame $id.lcol | ||
2331 | pack $id.lcol -side top | ||
2332 | foreach i { 0 1 2 3 4 5 6 7 8 9 } hexcol { 4210752 2105376 0 \ | ||
2333 | 9177096 5779456 7874580 2641940 17488 5256 5767248 } { | ||
2334 | button $id.lcol.c$i -background [format "#%6.6x" $hexcol] \ | ||
2335 | -activebackground [format "#%6.6x" $hexcol] \ | ||
2336 | -font {courier 2 normal} -padx 7 -pady 6 \ | ||
2337 | -command [format "iemgui_preset_col %s %d" $id $hexcol] } | ||
2338 | pack $id.lcol.c0 $id.lcol.c1 $id.lcol.c2 $id.lcol.c3 $id.lcol.c4 \ | ||
2339 | $id.lcol.c5 $id.lcol.c6 $id.lcol.c7 $id.lcol.c8 $id.lcol.c9 -side left | ||
2340 | |||
2341 | |||
2342 | label $id.space4 -text "---------------------------------" | ||
2343 | pack $id.space4 -side top | ||
2344 | |||
2345 | frame $id.cao | ||
2346 | pack $id.cao -side top | ||
2347 | button $id.cao.cancel -text {Cancel} -width 6 \ | ||
2348 | -command "iemgui_cancel $id" | ||
2349 | label $id.cao.dummy1 -text "" -width 3 | ||
2350 | button $id.cao.apply -text {Apply} -width 6 \ | ||
2351 | -command "iemgui_apply $id" | ||
2352 | label $id.cao.dummy2 -text "" -width 3 | ||
2353 | button $id.cao.ok -text {OK} -width 6 \ | ||
2354 | -command "iemgui_ok $id" | ||
2355 | pack $id.cao.cancel $id.cao.dummy1 \ | ||
2356 | $id.cao.apply $id.cao.dummy2 \ | ||
2357 | $id.cao.ok -side left | ||
2358 | |||
2359 | label $id.space5 -text "" | ||
2360 | pack $id.space5 -side top | ||
2361 | |||
2362 | if {[info tclversion] < 8.4} { | ||
2363 | bind $id <Key-Tab> {tkTabToWindow [tk_focusNext %W]} | ||
2364 | bind $id <<PrevWindow>> {tkTabToWindow [tk_focusPrev %W]} | ||
2365 | } else { | ||
2366 | bind $id <Key-Tab> {tk::TabToWindow [tk_focusNext %W]} | ||
2367 | bind $id <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]} | ||
2368 | } | ||
2369 | |||
2370 | bind $id.dim.w_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
2371 | bind $id.dim.h_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
2372 | bind $id.rng.min_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
2373 | bind $id.rng.max_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
2374 | bind $id.para.num_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
2375 | bind $id.snd.ent <KeyPress-Return> [concat iemgui_ok $id] | ||
2376 | bind $id.rcv.ent <KeyPress-Return> [concat iemgui_ok $id] | ||
2377 | bind $id.gnam.ent <KeyPress-Return> [concat iemgui_ok $id] | ||
2378 | bind $id.gnxy.x_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
2379 | bind $id.gnxy.y_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
2380 | bind $id.gnfs.fs_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
2381 | bind $id.cao.ok <KeyPress-Return> [concat iemgui_ok $id] | ||
2382 | |||
2383 | $id.dim.w_ent select from 0 | ||
2384 | $id.dim.w_ent select adjust end | ||
2385 | focus $id.dim.w_ent | ||
2386 | } | ||
2387 | # end of change "iemlib" | ||
2388 | |||
2389 | ############ pdtk_array_dialog -- dialog window for arrays ######### | ||
2390 | proc array_apply {id} { | ||
2391 | # strip "." from the TK id to make a variable name suffix | ||
2392 | set vid [string trimleft $id .] | ||
2393 | # for each variable, make a local variable to hold its name... | ||
2394 | set var_array_name [concat array_name_$vid] | ||
2395 | global $var_array_name | ||
2396 | set var_array_n [concat array_n_$vid] | ||
2397 | global $var_array_n | ||
2398 | set var_array_saveit [concat array_saveit_$vid] | ||
2399 | global $var_array_saveit | ||
2400 | set var_array_otherflag [concat array_otherflag_$vid] | ||
2401 | global $var_array_otherflag | ||
2402 | set mofo [eval concat $$var_array_name] | ||
2403 | if {[string index $mofo 0] == "$"} { | ||
2404 | set mofo [string replace $mofo 0 0 #] } | ||
2405 | |||
2406 | pd [concat $id arraydialog $mofo \ | ||
2407 | [eval concat $$var_array_n] \ | ||
2408 | [eval concat $$var_array_saveit] \ | ||
2409 | [eval concat $$var_array_otherflag] \ | ||
2410 | \;] | ||
2411 | } | ||
2412 | |||
2413 | proc array_cancel {id} { | ||
2414 | set cmd [concat $id cancel \;] | ||
2415 | pd $cmd | ||
2416 | } | ||
2417 | |||
2418 | proc array_ok {id} { | ||
2419 | array_apply $id | ||
2420 | array_cancel $id | ||
2421 | } | ||
2422 | |||
2423 | proc pdtk_array_dialog {id name n saveit newone} { | ||
2424 | set vid [string trimleft $id .] | ||
2425 | |||
2426 | set var_array_name [concat array_name_$vid] | ||
2427 | global $var_array_name | ||
2428 | set var_array_n [concat array_n_$vid] | ||
2429 | global $var_array_n | ||
2430 | set var_array_saveit [concat array_saveit_$vid] | ||
2431 | global $var_array_saveit | ||
2432 | set var_array_otherflag [concat array_otherflag_$vid] | ||
2433 | global $var_array_otherflag | ||
2434 | |||
2435 | set $var_array_name $name | ||
2436 | set $var_array_n $n | ||
2437 | set $var_array_saveit $saveit | ||
2438 | set $var_array_otherflag 0 | ||
2439 | |||
2440 | toplevel $id | ||
2441 | wm title $id {array} | ||
2442 | wm protocol $id WM_DELETE_WINDOW [concat array_cancel $id] | ||
2443 | |||
2444 | frame $id.name | ||
2445 | pack $id.name -side top | ||
2446 | label $id.name.label -text "name" | ||
2447 | entry $id.name.entry -textvariable $var_array_name | ||
2448 | pack $id.name.label $id.name.entry -side left | ||
2449 | |||
2450 | frame $id.n | ||
2451 | pack $id.n -side top | ||
2452 | label $id.n.label -text "size" | ||
2453 | entry $id.n.entry -textvariable $var_array_n | ||
2454 | pack $id.n.label $id.n.entry -side left | ||
2455 | |||
2456 | checkbutton $id.saveme -text {save contents} -variable $var_array_saveit \ | ||
2457 | -anchor w | ||
2458 | pack $id.saveme -side top | ||
2459 | |||
2460 | if {$newone != 0} { | ||
2461 | frame $id.radio | ||
2462 | pack $id.radio -side top | ||
2463 | radiobutton $id.radio.radio0 -value 0 \ | ||
2464 | -variable $var_array_otherflag \ | ||
2465 | -text "in new graph" | ||
2466 | radiobutton $id.radio.radio1 -value 1 \ | ||
2467 | -variable $var_array_otherflag \ | ||
2468 | -text "in last graph" | ||
2469 | pack $id.radio.radio0 -side top -anchor w | ||
2470 | pack $id.radio.radio1 -side top -anchor w | ||
2471 | } else { | ||
2472 | checkbutton $id.deleteme -text {delete me} \ | ||
2473 | -variable $var_array_otherflag -anchor w | ||
2474 | pack $id.deleteme -side top | ||
2475 | } | ||
2476 | frame $id.buttonframe | ||
2477 | pack $id.buttonframe -side bottom -fill x -pady 2m | ||
2478 | button $id.buttonframe.cancel -text {Cancel}\ | ||
2479 | -command "array_cancel $id" | ||
2480 | if {$newone == 0} {button $id.buttonframe.apply -text {Apply}\ | ||
2481 | -command "array_apply $id"} | ||
2482 | button $id.buttonframe.ok -text {OK}\ | ||
2483 | -command "array_ok $id" | ||
2484 | pack $id.buttonframe.cancel -side left -expand 1 | ||
2485 | if {$newone == 0} {pack $id.buttonframe.apply -side left -expand 1} | ||
2486 | pack $id.buttonframe.ok -side left -expand 1 | ||
2487 | |||
2488 | bind $id.name.entry <KeyPress-Return> [concat array_ok $id] | ||
2489 | bind $id.n.entry <KeyPress-Return> [concat array_ok $id] | ||
2490 | $id.name.entry select from 0 | ||
2491 | $id.name.entry select adjust end | ||
2492 | focus $id.name.entry | ||
2493 | } | ||
2494 | |||
2495 | ############ pdtk_canvas_dialog -- dialog window for canvass ######### | ||
2496 | proc canvas_apply {id} { | ||
2497 | # strip "." from the TK id to make a variable name suffix | ||
2498 | set vid [string trimleft $id .] | ||
2499 | # for each variable, make a local variable to hold its name... | ||
2500 | set var_canvas_xscale [concat canvas_xscale_$vid] | ||
2501 | global $var_canvas_xscale | ||
2502 | set var_canvas_yscale [concat canvas_yscale_$vid] | ||
2503 | global $var_canvas_yscale | ||
2504 | set var_canvas_graphme [concat canvas_graphme_$vid] | ||
2505 | global $var_canvas_graphme | ||
2506 | # set var_canvas_stretch [concat canvas_stretch_$vid] | ||
2507 | # global $var_canvas_stretch | ||
2508 | pd [concat $id donecanvasdialog \ | ||
2509 | [eval concat $$var_canvas_xscale] \ | ||
2510 | [eval concat $$var_canvas_yscale] \ | ||
2511 | [eval concat $$var_canvas_graphme] \ | ||
2512 | \;] | ||
2513 | } | ||
2514 | |||
2515 | proc canvas_cancel {id} { | ||
2516 | set cmd [concat $id cancel \;] | ||
2517 | pd $cmd | ||
2518 | } | ||
2519 | |||
2520 | proc canvas_ok {id} { | ||
2521 | canvas_apply $id | ||
2522 | canvas_cancel $id | ||
2523 | } | ||
2524 | |||
2525 | proc pdtk_canvas_dialog {id xscale yscale graphme stretch} { | ||
2526 | set vid [string trimleft $id .] | ||
2527 | |||
2528 | set var_canvas_xscale [concat canvas_xscale_$vid] | ||
2529 | global $var_canvas_xscale | ||
2530 | set var_canvas_yscale [concat canvas_yscale_$vid] | ||
2531 | global $var_canvas_yscale | ||
2532 | set var_canvas_graphme [concat canvas_graphme_$vid] | ||
2533 | global $var_canvas_graphme | ||
2534 | # set var_canvas_stretch [concat canvas_stretch_$vid] | ||
2535 | # global $var_canvas_stretch | ||
2536 | |||
2537 | set $var_canvas_xscale $xscale | ||
2538 | set $var_canvas_yscale $yscale | ||
2539 | set $var_canvas_graphme $graphme | ||
2540 | # set $var_canvas_stretch $stretch | ||
2541 | |||
2542 | toplevel $id | ||
2543 | wm title $id {canvas} | ||
2544 | wm protocol $id WM_DELETE_WINDOW [concat canvas_cancel $id] | ||
2545 | |||
2546 | frame $id.xscale | ||
2547 | pack $id.xscale -side top | ||
2548 | label $id.xscale.label -text "X units per pixel" | ||
2549 | entry $id.xscale.entry -textvariable $var_canvas_xscale -width 10 | ||
2550 | pack $id.xscale.label $id.xscale.entry -side left | ||
2551 | |||
2552 | frame $id.yscale | ||
2553 | pack $id.yscale -side top | ||
2554 | label $id.yscale.label -text "Y units per pixel" | ||
2555 | entry $id.yscale.entry -textvariable $var_canvas_yscale -width 10 | ||
2556 | pack $id.yscale.label $id.yscale.entry -side left | ||
2557 | |||
2558 | checkbutton $id.graphme -text {graph on parent} \ | ||
2559 | -variable $var_canvas_graphme -anchor w | ||
2560 | pack $id.graphme -side top | ||
2561 | |||
2562 | # checkbutton $id.stretch -text {stretch on resize} \ | ||
2563 | # -variable $var_canvas_stretch -anchor w | ||
2564 | # pack $id.stretch -side top | ||
2565 | |||
2566 | |||
2567 | frame $id.buttonframe | ||
2568 | pack $id.buttonframe -side bottom -fill x -pady 2m | ||
2569 | button $id.buttonframe.cancel -text {Cancel}\ | ||
2570 | -command "canvas_cancel $id" | ||
2571 | button $id.buttonframe.apply -text {Apply}\ | ||
2572 | -command "canvas_apply $id" | ||
2573 | button $id.buttonframe.ok -text {OK}\ | ||
2574 | -command "canvas_ok $id" | ||
2575 | pack $id.buttonframe.cancel -side left -expand 1 | ||
2576 | pack $id.buttonframe.apply -side left -expand 1 | ||
2577 | pack $id.buttonframe.ok -side left -expand 1 | ||
2578 | |||
2579 | bind $id.xscale.entry <KeyPress-Return> [concat canvas_ok $id] | ||
2580 | bind $id.yscale.entry <KeyPress-Return> [concat canvas_ok $id] | ||
2581 | $id.xscale.entry select from 0 | ||
2582 | $id.xscale.entry select adjust end | ||
2583 | focus $id.xscale.entry | ||
2584 | } | ||
2585 | |||
2586 | ############ pdtk_data_dialog -- run a data dialog ######### | ||
2587 | proc dodata_send {name} { | ||
2588 | # puts stderr [$name.text get 0.0 end] | ||
2589 | |||
2590 | for {set i 1} {[$name.text compare [concat $i.0 + 3 chars] < end]} \ | ||
2591 | {incr i 1} { | ||
2592 | # puts stderr [concat it's [$name.text get $i.0 [expr $i + 1].0]] | ||
2593 | set cmd [concat $name data [$name.text get $i.0 [expr $i + 1].0] \;] | ||
2594 | # puts stderr $cmd | ||
2595 | pd $cmd | ||
2596 | } | ||
2597 | set cmd [concat $name end \;] | ||
2598 | # puts stderr $cmd | ||
2599 | pd $cmd | ||
2600 | } | ||
2601 | |||
2602 | proc dodata_cancel {name} { | ||
2603 | set cmd [concat $name cancel \;] | ||
2604 | # puts stderr $cmd | ||
2605 | pd $cmd | ||
2606 | } | ||
2607 | |||
2608 | proc dodata_ok {name} { | ||
2609 | dodata_send $name | ||
2610 | dodata_cancel $name | ||
2611 | } | ||
2612 | |||
2613 | proc pdtk_data_dialog {name stuff} { | ||
2614 | |||
2615 | toplevel $name | ||
2616 | wm title $name {Atom} | ||
2617 | wm protocol $name WM_DELETE_WINDOW [concat dodata_cancel $name] | ||
2618 | |||
2619 | frame $name.buttonframe | ||
2620 | pack $name.buttonframe -side bottom -fill x -pady 2m | ||
2621 | button $name.buttonframe.send -text {Send (Ctrl s)}\ | ||
2622 | -command [concat dodata_send $name] | ||
2623 | button $name.buttonframe.ok -text {OK (Ctrl t)}\ | ||
2624 | -command [concat dodata_ok $name] | ||
2625 | pack $name.buttonframe.send -side left -expand 1 | ||
2626 | pack $name.buttonframe.ok -side left -expand 1 | ||
2627 | |||
2628 | text $name.text -relief raised -bd 2 -height 40 -width 60 \ | ||
2629 | -yscrollcommand "$name.scroll set" -font -*-courier-bold--normal--12-* | ||
2630 | scrollbar $name.scroll -command "$name.text yview" | ||
2631 | pack $name.scroll -side right -fill y | ||
2632 | pack $name.text -side left -fill both -expand 1 | ||
2633 | $name.text insert end $stuff | ||
2634 | focus $name.text | ||
2635 | bind $name.text <Control-t> [concat dodata_ok $name] | ||
2636 | bind $name.text <Control-s> [concat dodata_send $name] | ||
2637 | } | ||
2638 | |||
2639 | ############ check or uncheck the "edit" menu item ############## | ||
2640 | #####################iemlib####################### | ||
2641 | proc pdtk_canvas_editval {name value} { | ||
2642 | if { $value } { | ||
2643 | $name.m.edit entryconfigure "Edit mode" -indicatoron true | ||
2644 | } else { | ||
2645 | $name.m.edit entryconfigure "Edit mode" -indicatoron false | ||
2646 | } | ||
2647 | } | ||
2648 | #####################iemlib####################### | ||
2649 | |||
2650 | ############ pdtk_text_new -- create a new text object #2########### | ||
2651 | proc pdtk_text_new {canvasname myname x y text font color} { | ||
2652 | # if {$font < 13} {set fontname [format -*-courier-bold----%d-* $font]} | ||
2653 | # if {$font >= 13} {set fontname [format -*-courier-----%d-* $font]} | ||
2654 | $canvasname create text $x $y \ | ||
2655 | -font [format -*-courier-bold--normal--%d-* $font] \ | ||
2656 | -tags $myname -text $text -fill $color -anchor nw | ||
2657 | # pd [concat $myname size [$canvasname bbox $myname] \;] | ||
2658 | } | ||
2659 | |||
2660 | ################ pdtk_text_set -- change the text ################## | ||
2661 | proc pdtk_text_set {canvasname myname text} { | ||
2662 | $canvasname itemconfig $myname -text $text | ||
2663 | # pd [concat $myname size [$canvasname bbox $myname] \;] | ||
2664 | } | ||
2665 | |||
2666 | ############### event binding procedures for Pd window ################ | ||
2667 | |||
2668 | proc pdtk_pd_ctrlkey {name key shift} { | ||
2669 | # puts stderr [concat key $key shift $shift] | ||
2670 | # .dummy itemconfig goo -text [concat ---> control-key event $key]; | ||
2671 | if {$key == "n" || $key == "N"} {menu_new} | ||
2672 | if {$key == "o" || $key == "O"} {menu_open} | ||
2673 | if {$key == "m" || $key == "M"} {menu_send} | ||
2674 | if {$key == "q" || $key == "Q"} { | ||
2675 | if {$shift == 1} {menu_really_quit} else {menu_quit} | ||
2676 | } | ||
2677 | if {$key == "slash"} {menu_audio 1} | ||
2678 | if {$key == "period"} {menu_audio 0} | ||
2679 | } | ||
2680 | |||
2681 | ######### startup function. ############## | ||
2682 | # Tell pd the current directory; this is used in case the command line | ||
2683 | # asked pd to open something. Also, get character width and height for | ||
2684 | # font sizes 8, 10, 12, 14, 16, and 24. | ||
2685 | |||
2686 | proc pdtk_pd_startup {version apilist} { | ||
2687 | global pd_myversion pd_apilist | ||
2688 | set pd_myversion $version | ||
2689 | set pd_apilist $apilist | ||
2690 | |||
2691 | set width1 [font measure -*-courier-bold--normal--8-* x] | ||
2692 | set height1 [lindex [font metrics -*-courier-bold--normal--8-*] 5] | ||
2693 | |||
2694 | set width2 [font measure -*-courier-bold--normal--10-* x] | ||
2695 | set height2 [lindex [font metrics -*-courier-bold--normal--10-*] 5] | ||
2696 | |||
2697 | set width3 [font measure -*-courier-bold--normal--12-* x] | ||
2698 | set height3 [lindex [font metrics -*-courier-bold--normal--12-*] 5] | ||
2699 | |||
2700 | set width4 [font measure -*-courier-bold--normal--14-* x] | ||
2701 | set height4 [lindex [font metrics -*-courier-bold--normal--14-*] 5] | ||
2702 | |||
2703 | set width5 [font measure -*-courier-bold--normal--16-* x] | ||
2704 | set height5 [lindex [font metrics -*-courier-bold--normal--16-*] 5] | ||
2705 | |||
2706 | set width6 [font measure -*-courier-bold--normal--24-* x] | ||
2707 | set height6 [lindex [font metrics -*-courier-bold--normal--24-*] 5] | ||
2708 | |||
2709 | set width7 [font measure -*-courier-bold--normal--36-* x] | ||
2710 | set height7 [lindex [font metrics -*-courier-bold--normal--36-*] 5] | ||
2711 | |||
2712 | set tclpatch [info patchlevel] | ||
2713 | if {$tclpatch == "8.3.0" || \ | ||
2714 | $tclpatch == "8.3.1" || \ | ||
2715 | $tclpatch == "8.3.2" || \ | ||
2716 | $tclpatch == "8.3.3" } { | ||
2717 | set oldtclversion 1 | ||
2718 | } else { | ||
2719 | set oldtclversion 0 | ||
2720 | } | ||
2721 | pd [concat pd init [pdtk_enquote [pwd]] \ | ||
2722 | 8 $width1 $height1 \ | ||
2723 | 10 $width2 $height2 \ | ||
2724 | 12 $width3 $height3 \ | ||
2725 | 14 $width4 $height4 \ | ||
2726 | 16 $width5 $height5 \ | ||
2727 | 24 $width6 $height6 \ | ||
2728 | 36 $width7 $height7 \ | ||
2729 | $oldtclversion \;]; | ||
2730 | |||
2731 | # add the audio and help menus to the Pd window. We delayed this | ||
2732 | # so that we'd know the value of "apilist". | ||
2733 | menu_addstd .mbar | ||
2734 | |||
2735 | } | ||
2736 | |||
2737 | ##################### DSP ON/OFF, METERS, DIO ERROR ################### | ||
2738 | proc pdtk_pd_dsp {value} { | ||
2739 | global ctrls_audio_on | ||
2740 | if {$value == "ON"} {set ctrls_audio_on 1} else {set ctrls_audio_on 0} | ||
2741 | # puts stderr [concat its $ctrls_audio_on] | ||
2742 | } | ||
2743 | |||
2744 | proc pdtk_pd_meters {indb outdb inclip outclip} { | ||
2745 | # puts stderr [concat meters $indb $outdb $inclip $outclip] | ||
2746 | global ctrls_inlevel ctrls_outlevel | ||
2747 | set ctrls_inlevel $indb | ||
2748 | if {$inclip == 1} { | ||
2749 | .controls.inout.in.clip configure -background red | ||
2750 | } else { | ||
2751 | .controls.inout.in.clip configure -background grey | ||
2752 | } | ||
2753 | set ctrls_outlevel $outdb | ||
2754 | if {$outclip == 1} { | ||
2755 | .controls.inout.out.clip configure -background red | ||
2756 | } else { | ||
2757 | .controls.inout.out.clip configure -background grey | ||
2758 | } | ||
2759 | |||
2760 | } | ||
2761 | |||
2762 | proc pdtk_pd_dio {red} { | ||
2763 | # puts stderr [concat dio $red] | ||
2764 | if {$red == 1} { | ||
2765 | .controls.dio configure -background red -activebackground red | ||
2766 | } else { | ||
2767 | .controls.dio configure -background grey -activebackground lightgrey | ||
2768 | } | ||
2769 | |||
2770 | } | ||
2771 | |||
2772 | ############# text editing from the "edit" menu ################### | ||
2773 | set edit_number 1 | ||
2774 | |||
2775 | proc texteditor_send {name} { | ||
2776 | set topname [string trimright $name .text] | ||
2777 | for {set i 0} \ | ||
2778 | {[$name compare [concat 0.0 + [expr $i + 1] chars] < end]} \ | ||
2779 | {incr i 1} { | ||
2780 | set cha [$name get [concat 0.0 + $i chars]] | ||
2781 | scan $cha %c keynum | ||
2782 | pd [concat pd key 1 $keynum 0 \;] | ||
2783 | } | ||
2784 | } | ||
2785 | |||
2786 | proc texteditor_ok {name} { | ||
2787 | set topname [string trimright $name .text] | ||
2788 | texteditor_send $name | ||
2789 | destroy $topname | ||
2790 | } | ||
2791 | |||
2792 | |||
2793 | proc pdtk_pd_texteditor {stuff} { | ||
2794 | global edit_number | ||
2795 | set name [format ".text%d" $edit_number] | ||
2796 | set edit_number [expr $edit_number + 1] | ||
2797 | |||
2798 | toplevel $name | ||
2799 | wm title $name {TEXT} | ||
2800 | |||
2801 | frame $name.buttons | ||
2802 | pack $name.buttons -side bottom -fill x -pady 2m | ||
2803 | button $name.buttons.send -text {Send (Ctrl s)}\ | ||
2804 | -command "texteditor_send $name.text" | ||
2805 | button $name.buttons.ok -text {OK (Ctrl t)}\ | ||
2806 | -command "texteditor_ok $name.text" | ||
2807 | pack $name.buttons.send -side left -expand 1 | ||
2808 | pack $name.buttons.ok -side left -expand 1 | ||
2809 | |||
2810 | text $name.text -relief raised -bd 2 -height 12 -width 60 \ | ||
2811 | -yscrollcommand "$name.scroll set" -font -*-courier-bold--normal--12-* | ||
2812 | scrollbar $name.scroll -command "$name.text yview" | ||
2813 | pack $name.scroll -side right -fill y | ||
2814 | pack $name.text -side left -fill both -expand 1 | ||
2815 | $name.text insert end $stuff | ||
2816 | focus $name.text | ||
2817 | bind $name.text <Control-t> {texteditor_ok %W} | ||
2818 | bind $name.text <Control-s> {texteditor_send %W} | ||
2819 | } | ||
2820 | |||
2821 | ############# open and save dialogs for objects in Pd ########## | ||
2822 | |||
2823 | proc pdtk_openpanel {target} { | ||
2824 | global pd_opendir | ||
2825 | set filename [tk_getOpenFile \ | ||
2826 | -initialdir $pd_opendir] | ||
2827 | if {$filename != ""} { | ||
2828 | set directory [string range $filename 0 \ | ||
2829 | [expr [string last / $filename ] - 1]] | ||
2830 | set pd_opendir $directory | ||
2831 | |||
2832 | pd [concat $target symbol [pdtk_enquote $filename] \;] | ||
2833 | } | ||
2834 | } | ||
2835 | |||
2836 | proc pdtk_savepanel {target} { | ||
2837 | set filename [tk_getSaveFile] | ||
2838 | if {$filename != ""} { | ||
2839 | pd [concat $target symbol [pdtk_enquote $filename] \;] | ||
2840 | } | ||
2841 | } | ||
2842 | |||
2843 | ########################### comport hack ######################## | ||
2844 | |||
2845 | set com1 0 | ||
2846 | set com2 0 | ||
2847 | set com3 0 | ||
2848 | set com4 0 | ||
2849 | |||
2850 | proc com1_open {} { | ||
2851 | global com1 | ||
2852 | set com1 [open com1 w] | ||
2853 | .dummy itemconfig goo -text $com1 | ||
2854 | fconfigure $com1 -buffering none | ||
2855 | fconfigure $com1 -mode 19200,e,8,2 | ||
2856 | } | ||
2857 | |||
2858 | proc com1_send {str} { | ||
2859 | global com1 | ||
2860 | puts -nonewline $com1 $str | ||
2861 | } | ||
2862 | |||
2863 | |||
2864 | ############# start a polling process to watch the socket ############## | ||
2865 | # this is needed for nt, and presumably for Mac as well. | ||
2866 | # in UNIX this is handled by a tcl callback (set up in t_tkcmd.c) | ||
2867 | |||
2868 | if {$pd_nt == 1} { | ||
2869 | proc polleofloop {} { | ||
2870 | pd_pollsocket | ||
2871 | after 20 polleofloop | ||
2872 | } | ||
2873 | |||
2874 | polleofloop | ||
2875 | } | ||
2876 | |||
2877 | ####################### audio dialog ##################3 | ||
2878 | |||
2879 | proc audio_apply {id} { | ||
2880 | global audio_indev1 audio_indev2 audio_indev3 audio_indev4 | ||
2881 | global audio_inchan1 audio_inchan2 audio_inchan3 audio_inchan4 | ||
2882 | global audio_outdev1 audio_outdev2 audio_outdev3 audio_outdev4 | ||
2883 | global audio_outchan1 audio_outchan2 audio_outchan3 audio_outchan4 | ||
2884 | global audio_sr audio_advance | ||
2885 | |||
2886 | pd [concat pd audio-dialog \ | ||
2887 | $audio_indev1 \ | ||
2888 | $audio_indev2 \ | ||
2889 | $audio_indev3 \ | ||
2890 | $audio_indev4 \ | ||
2891 | $audio_inchan1 \ | ||
2892 | $audio_inchan2 \ | ||
2893 | $audio_inchan3 \ | ||
2894 | $audio_inchan4 \ | ||
2895 | $audio_outdev1 \ | ||
2896 | $audio_outdev2 \ | ||
2897 | $audio_outdev3 \ | ||
2898 | $audio_outdev4 \ | ||
2899 | $audio_outchan1 \ | ||
2900 | $audio_outchan2 \ | ||
2901 | $audio_outchan3 \ | ||
2902 | $audio_outchan4 \ | ||
2903 | $audio_sr \ | ||
2904 | $audio_advance \ | ||
2905 | \;] | ||
2906 | } | ||
2907 | |||
2908 | proc audio_cancel {id} { | ||
2909 | pd [concat $id cancel \;] | ||
2910 | } | ||
2911 | |||
2912 | proc audio_ok {id} { | ||
2913 | audio_apply $id | ||
2914 | audio_cancel $id | ||
2915 | } | ||
2916 | |||
2917 | # callback from popup menu | ||
2918 | proc audio_popup_action {buttonname varname devlist index} { | ||
2919 | global audio_indevlist audio_outdevlist $varname | ||
2920 | $buttonname configure -text [lindex $devlist $index] | ||
2921 | # puts stderr [concat popup_action $buttonname $varname $index] | ||
2922 | set $varname $index | ||
2923 | } | ||
2924 | |||
2925 | # create a popup menu | ||
2926 | proc audio_popup {name buttonname varname devlist} { | ||
2927 | if [winfo exists $name.popup] {destroy $name.popup} | ||
2928 | menu $name.popup -tearoff false | ||
2929 | # puts stderr [concat $devlist ] | ||
2930 | for {set x 0} {$x<[llength $devlist]} {incr x} { | ||
2931 | $name.popup add command -label [lindex $devlist $x] \ | ||
2932 | -command [list audio_popup_action \ | ||
2933 | $buttonname $varname $devlist $x] | ||
2934 | } | ||
2935 | tk_popup $name.popup [winfo pointerx $name] [winfo pointery $name] 0 | ||
2936 | } | ||
2937 | |||
2938 | # start a dialog window to select audio devices and settings. "multi" | ||
2939 | # is 0 if only one device is allowed; 1 if one apiece may be specified for | ||
2940 | # input and output; and 2 if we can select multiple devices. "longform" | ||
2941 | # (which only makes sense if "multi" is 2) asks us to make controls for | ||
2942 | # opening several devices; if not, we get an extra button to turn longform | ||
2943 | # on and restart the dialog. | ||
2944 | |||
2945 | proc pdtk_audio_dialog {id indevlist indev1 indev2 indev3 indev4 \ | ||
2946 | inchan1 inchan2 inchan3 inchan4 \ | ||
2947 | outdevlist outdev1 outdev2 outdev3 outdev4 \ | ||
2948 | outchan1 outchan2 outchan3 outchan4 sr advance multi longform} { | ||
2949 | global audio_indev1 audio_indev2 audio_indev3 audio_indev4 | ||
2950 | global audio_inchan1 audio_inchan2 audio_inchan3 audio_inchan4 | ||
2951 | global audio_outdev1 audio_outdev2 audio_outdev3 audio_outdev4 | ||
2952 | global audio_outchan1 audio_outchan2 audio_outchan3 audio_outchan4 | ||
2953 | global audio_sr audio_advance | ||
2954 | global audio_indevlist audio_outdevlist | ||
2955 | |||
2956 | set audio_indev1 $indev1 | ||
2957 | set audio_indev2 $indev2 | ||
2958 | set audio_indev3 $indev3 | ||
2959 | set audio_indev4 $indev4 | ||
2960 | set audio_inchan1 $inchan1 | ||
2961 | set audio_inchan2 $inchan2 | ||
2962 | set audio_inchan3 $inchan3 | ||
2963 | set audio_inchan4 $inchan4 | ||
2964 | set audio_outdev1 $outdev1 | ||
2965 | set audio_outdev2 $outdev2 | ||
2966 | set audio_outdev3 $outdev3 | ||
2967 | set audio_outdev4 $outdev4 | ||
2968 | set audio_outchan1 $outchan1 | ||
2969 | set audio_outchan2 $outchan2 | ||
2970 | set audio_outchan3 $outchan3 | ||
2971 | set audio_outchan4 $outchan4 | ||
2972 | set audio_sr $sr | ||
2973 | set audio_advance $advance | ||
2974 | set audio_indevlist $indevlist | ||
2975 | set audio_outdevlist $outdevlist | ||
2976 | |||
2977 | toplevel $id | ||
2978 | wm title $id {audio} | ||
2979 | wm protocol $id WM_DELETE_WINDOW [concat audio_cancel $id] | ||
2980 | |||
2981 | frame $id.buttonframe | ||
2982 | pack $id.buttonframe -side bottom -fill x -pady 2m | ||
2983 | button $id.buttonframe.cancel -text {Cancel}\ | ||
2984 | -command "audio_cancel $id" | ||
2985 | button $id.buttonframe.apply -text {Apply}\ | ||
2986 | -command "audio_apply $id" | ||
2987 | button $id.buttonframe.ok -text {OK}\ | ||
2988 | -command "audio_ok $id" | ||
2989 | pack $id.buttonframe.cancel -side left -expand 1 | ||
2990 | pack $id.buttonframe.apply -side left -expand 1 | ||
2991 | pack $id.buttonframe.ok -side left -expand 1 | ||
2992 | |||
2993 | # sample rate and advance | ||
2994 | frame $id.srf | ||
2995 | pack $id.srf -side top | ||
2996 | |||
2997 | label $id.srf.l1 -text "sample rate:" | ||
2998 | entry $id.srf.x1 -textvariable audio_sr -width 7 | ||
2999 | label $id.srf.l2 -text "delay (msec):" | ||
3000 | entry $id.srf.x2 -textvariable audio_advance -width 4 | ||
3001 | pack $id.srf.l1 $id.srf.x1 $id.srf.l2 $id.srf.x2 -side left | ||
3002 | |||
3003 | # input device 1 | ||
3004 | frame $id.in1f | ||
3005 | pack $id.in1f -side top | ||
3006 | |||
3007 | label $id.in1f.l1 -text "input device 1:" | ||
3008 | button $id.in1f.x1 -text [lindex $indevlist $audio_indev1] \ | ||
3009 | -command [list audio_popup $id $id.in1f.x1 audio_indev1 $indevlist] | ||
3010 | label $id.in1f.l2 -text "channels:" | ||
3011 | entry $id.in1f.x2 -textvariable audio_inchan1 -width 3 | ||
3012 | pack $id.in1f.l1 $id.in1f.x1 $id.in1f.l2 $id.in1f.x2 -side left | ||
3013 | |||
3014 | # input device 2 | ||
3015 | if {$longform && $multi > 1 && [llength $indevlist] > 1} { | ||
3016 | frame $id.in2f | ||
3017 | pack $id.in2f -side top | ||
3018 | |||
3019 | label $id.in2f.l1 -text "input device 2:" | ||
3020 | button $id.in2f.x1 -text [lindex $indevlist $audio_indev2] \ | ||
3021 | -command [list audio_popup $id $id.in2f.x1 audio_indev2 $indevlist] | ||
3022 | label $id.in2f.l2 -text "channels:" | ||
3023 | entry $id.in2f.x2 -textvariable audio_inchan2 -width 3 | ||
3024 | pack $id.in2f.l1 $id.in2f.x1 $id.in2f.l2 $id.in2f.x2 -side left | ||
3025 | } | ||
3026 | |||
3027 | # input device 3 | ||
3028 | if {$longform && $multi > 1 && [llength $indevlist] > 2} { | ||
3029 | frame $id.in3f | ||
3030 | pack $id.in3f -side top | ||
3031 | |||
3032 | label $id.in3f.l1 -text "input device 3:" | ||
3033 | button $id.in3f.x1 -text [lindex $indevlist $audio_indev3] \ | ||
3034 | -command [list audio_popup $id $id.in3f.x1 audio_indev3 $indevlist] | ||
3035 | label $id.in3f.l2 -text "channels:" | ||
3036 | entry $id.in3f.x2 -textvariable audio_inchan3 -width 3 | ||
3037 | pack $id.in3f.l1 $id.in3f.x1 $id.in3f.l2 $id.in3f.x2 -side left | ||
3038 | } | ||
3039 | |||
3040 | # input device 4 | ||
3041 | if {$longform && $multi > 1 && [llength $indevlist] > 3} { | ||
3042 | frame $id.in4f | ||
3043 | pack $id.in4f -side top | ||
3044 | |||
3045 | label $id.in4f.l1 -text "input device 4:" | ||
3046 | button $id.in4f.x1 -text [lindex $indevlist $audio_indev4] \ | ||
3047 | -command [list audio_popup $id $id.in4f.x1 audio_indev4 $indevlist] | ||
3048 | label $id.in4f.l2 -text "channels:" | ||
3049 | entry $id.in4f.x2 -textvariable audio_inchan4 -width 3 | ||
3050 | pack $id.in4f.l1 $id.in4f.x1 $id.in4f.l2 $id.in4f.x2 -side left | ||
3051 | } | ||
3052 | |||
3053 | # output device 1 | ||
3054 | frame $id.out1f | ||
3055 | pack $id.out1f -side top | ||
3056 | |||
3057 | if {$multi == 0} { | ||
3058 | label $id.out1f.l1 \ | ||
3059 | -text "(output device same as input device) .............. " | ||
3060 | } else { | ||
3061 | label $id.out1f.l1 -text "output device 1:" | ||
3062 | button $id.out1f.x1 -text [lindex $outdevlist $audio_outdev1] \ | ||
3063 | -command \ | ||
3064 | [list audio_popup $id $id.out1f.x1 audio_outdev1 $outdevlist] | ||
3065 | } | ||
3066 | label $id.out1f.l2 -text "channels:" | ||
3067 | entry $id.out1f.x2 -textvariable audio_outchan1 -width 3 | ||
3068 | if {$multi == 0} { | ||
3069 | pack $id.out1f.l1 $id.out1f.l2 $id.out1f.x2 -side left | ||
3070 | } else { | ||
3071 | pack $id.out1f.l1 $id.out1f.x1 $id.out1f.l2 $id.out1f.x2 -side left | ||
3072 | } | ||
3073 | |||
3074 | # output device 2 | ||
3075 | if {$longform && $multi > 1 && [llength $indevlist] > 1} { | ||
3076 | frame $id.out2f | ||
3077 | pack $id.out2f -side top | ||
3078 | label $id.out2f.l1 -text "output device 2:" | ||
3079 | button $id.out2f.x1 -text [lindex $outdevlist $audio_outdev2] \ | ||
3080 | -command \ | ||
3081 | [list audio_popup $id $id.out2f.x1 audio_outdev2 $outdevlist] | ||
3082 | label $id.out2f.l2 -text "channels:" | ||
3083 | entry $id.out2f.x2 -textvariable audio_outchan2 -width 3 | ||
3084 | pack $id.out2f.l1 $id.out2f.x1 $id.out2f.l2 $id.out2f.x2 -side left | ||
3085 | } | ||
3086 | |||
3087 | # output device 3 | ||
3088 | if {$longform && $multi > 1 && [llength $indevlist] > 2} { | ||
3089 | frame $id.out3f | ||
3090 | pack $id.out3f -side top | ||
3091 | label $id.out3f.l1 -text "output device 3:" | ||
3092 | button $id.out3f.x1 -text [lindex $outdevlist $audio_outdev3] \ | ||
3093 | -command \ | ||
3094 | [list audio_popup $id $id.out3f.x1 audio_outdev3 $outdevlist] | ||
3095 | label $id.out3f.l2 -text "channels:" | ||
3096 | entry $id.out3f.x2 -textvariable audio_outchan3 -width 3 | ||
3097 | pack $id.out3f.l1 $id.out3f.x1 $id.out3f.l2 $id.out3f.x2 -side left | ||
3098 | } | ||
3099 | |||
3100 | # output device 4 | ||
3101 | if {$longform && $multi > 1 && [llength $indevlist] > 3} { | ||
3102 | frame $id.out4f | ||
3103 | pack $id.out4f -side top | ||
3104 | label $id.out4f.l1 -text "output device 4:" | ||
3105 | button $id.out4f.x1 -text [lindex $outdevlist $audio_outdev4] \ | ||
3106 | -command \ | ||
3107 | [list audio_popup $id $id.out4f.x1 audio_outdev4 $outdevlist] | ||
3108 | label $id.out4f.l2 -text "channels:" | ||
3109 | entry $id.out4f.x2 -textvariable audio_outchan4 -width 3 | ||
3110 | pack $id.out4f.l1 $id.out4f.x1 $id.out4f.l2 $id.out4f.x2 -side left | ||
3111 | } | ||
3112 | |||
3113 | # if not the "long form" but if "multi" is 2, make a button to | ||
3114 | # restart with longform set. | ||
3115 | |||
3116 | if {$longform == 0 && $multi > 1} { | ||
3117 | frame $id.longbutton | ||
3118 | pack $id.longbutton -side top | ||
3119 | button $id.longbutton.b -text {use multiple devices} \ | ||
3120 | -command {pd pd audio-properties 1 \;} | ||
3121 | pack $id.longbutton.b | ||
3122 | } | ||
3123 | bind $id.srf.x1 <KeyPress-Return> [concat audio_ok $id] | ||
3124 | bind $id.srf.x2 <KeyPress-Return> [concat audio_ok $id] | ||
3125 | bind $id.in1f.x2 <KeyPress-Return> [concat audio_ok $id] | ||
3126 | $id.srf.x1 select from 0 | ||
3127 | $id.srf.x1 select adjust end | ||
3128 | focus $id.srf.x1 | ||
3129 | } | ||
3130 | |||
3131 | ####################### midi dialog ##################3 | ||
3132 | |||
3133 | proc midi_apply {id} { | ||
3134 | global midi_indev1 midi_indev2 midi_indev3 midi_indev4 | ||
3135 | global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4 | ||
3136 | |||
3137 | pd [concat pd midi-dialog \ | ||
3138 | $midi_indev1 \ | ||
3139 | $midi_indev2 \ | ||
3140 | $midi_indev3 \ | ||
3141 | $midi_indev4 \ | ||
3142 | $midi_outdev1 \ | ||
3143 | $midi_outdev2 \ | ||
3144 | $midi_outdev3 \ | ||
3145 | $midi_outdev4 \ | ||
3146 | \;] | ||
3147 | } | ||
3148 | |||
3149 | proc midi_cancel {id} { | ||
3150 | pd [concat $id cancel \;] | ||
3151 | } | ||
3152 | |||
3153 | proc midi_ok {id} { | ||
3154 | midi_apply $id | ||
3155 | midi_cancel $id | ||
3156 | } | ||
3157 | |||
3158 | # callback from popup menu | ||
3159 | proc midi_popup_action {buttonname varname devlist index} { | ||
3160 | global midi_indevlist midi_outdevlist $varname | ||
3161 | $buttonname configure -text [lindex $devlist $index] | ||
3162 | # puts stderr [concat popup_action $buttonname $varname $index] | ||
3163 | set $varname $index | ||
3164 | } | ||
3165 | |||
3166 | # create a popup menu | ||
3167 | proc midi_popup {name buttonname varname devlist} { | ||
3168 | if [winfo exists $name.popup] {destroy $name.popup} | ||
3169 | menu $name.popup -tearoff false | ||
3170 | # puts stderr [concat $devlist ] | ||
3171 | for {set x 0} {$x<[llength $devlist]} {incr x} { | ||
3172 | $name.popup add command -label [lindex $devlist $x] \ | ||
3173 | -command [list midi_popup_action \ | ||
3174 | $buttonname $varname $devlist $x] | ||
3175 | } | ||
3176 | tk_popup $name.popup [winfo pointerx $name] [winfo pointery $name] 0 | ||
3177 | } | ||
3178 | |||
3179 | # start a dialog window to select midi devices. "longform" asks us to make | ||
3180 | # controls for opening several devices; if not, we get an extra button to | ||
3181 | # turn longform on and restart the dialog. | ||
3182 | |||
3183 | proc pdtk_midi_dialog {id indevlist indev1 indev2 indev3 indev4 \ | ||
3184 | outdevlist outdev1 outdev2 outdev3 outdev4 longform} { | ||
3185 | global midi_indev1 midi_indev2 midi_indev3 midi_indev4 | ||
3186 | global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4 | ||
3187 | global midi_indevlist midi_outdevlist | ||
3188 | |||
3189 | set midi_indev1 $indev1 | ||
3190 | set midi_indev2 $indev2 | ||
3191 | set midi_indev3 $indev3 | ||
3192 | set midi_indev4 $indev4 | ||
3193 | set midi_outdev1 $outdev1 | ||
3194 | set midi_outdev2 $outdev2 | ||
3195 | set midi_outdev3 $outdev3 | ||
3196 | set midi_outdev4 $outdev4 | ||
3197 | set midi_indevlist $indevlist | ||
3198 | set midi_outdevlist $outdevlist | ||
3199 | |||
3200 | toplevel $id | ||
3201 | wm title $id {midi} | ||
3202 | wm protocol $id WM_DELETE_WINDOW [concat midi_cancel $id] | ||
3203 | |||
3204 | frame $id.buttonframe | ||
3205 | pack $id.buttonframe -side bottom -fill x -pady 2m | ||
3206 | button $id.buttonframe.cancel -text {Cancel}\ | ||
3207 | -command "midi_cancel $id" | ||
3208 | button $id.buttonframe.apply -text {Apply}\ | ||
3209 | -command "midi_apply $id" | ||
3210 | button $id.buttonframe.ok -text {OK}\ | ||
3211 | -command "midi_ok $id" | ||
3212 | pack $id.buttonframe.cancel -side left -expand 1 | ||
3213 | pack $id.buttonframe.apply -side left -expand 1 | ||
3214 | pack $id.buttonframe.ok -side left -expand 1 | ||
3215 | |||
3216 | # input device 1 | ||
3217 | frame $id.in1f | ||
3218 | pack $id.in1f -side top | ||
3219 | |||
3220 | label $id.in1f.l1 -text "input device 1:" | ||
3221 | button $id.in1f.x1 -text [lindex $indevlist $midi_indev1] \ | ||
3222 | -command [list midi_popup $id $id.in1f.x1 midi_indev1 $indevlist] | ||
3223 | pack $id.in1f.l1 $id.in1f.x1 -side left | ||
3224 | |||
3225 | # input device 2 | ||
3226 | if {$longform && [llength $indevlist] > 2} { | ||
3227 | frame $id.in2f | ||
3228 | pack $id.in2f -side top | ||
3229 | |||
3230 | label $id.in2f.l1 -text "input device 2:" | ||
3231 | button $id.in2f.x1 -text [lindex $indevlist $midi_indev2] \ | ||
3232 | -command [list midi_popup $id $id.in2f.x1 midi_indev2 $indevlist] | ||
3233 | pack $id.in2f.l1 $id.in2f.x1 -side left | ||
3234 | } | ||
3235 | |||
3236 | # input device 3 | ||
3237 | if {$longform && [llength $indevlist] > 3} { | ||
3238 | frame $id.in3f | ||
3239 | pack $id.in3f -side top | ||
3240 | |||
3241 | label $id.in3f.l1 -text "input device 3:" | ||
3242 | button $id.in3f.x1 -text [lindex $indevlist $midi_indev3] \ | ||
3243 | -command [list midi_popup $id $id.in3f.x1 midi_indev3 $indevlist] | ||
3244 | pack $id.in3f.l1 $id.in3f.x1 -side left | ||
3245 | } | ||
3246 | |||
3247 | # input device 4 | ||
3248 | if {$longform && [llength $indevlist] > 4} { | ||
3249 | frame $id.in4f | ||
3250 | pack $id.in4f -side top | ||
3251 | |||
3252 | label $id.in4f.l1 -text "input device 4:" | ||
3253 | button $id.in4f.x1 -text [lindex $indevlist $midi_indev4] \ | ||
3254 | -command [list midi_popup $id $id.in4f.x1 midi_indev4 $indevlist] | ||
3255 | pack $id.in4f.l1 $id.in4f.x1 -side left | ||
3256 | } | ||
3257 | |||
3258 | # output device 1 | ||
3259 | |||
3260 | frame $id.out1f | ||
3261 | pack $id.out1f -side top | ||
3262 | label $id.out1f.l1 -text "output device 1:" | ||
3263 | button $id.out1f.x1 -text [lindex $outdevlist $midi_outdev1] \ | ||
3264 | -command [list midi_popup $id $id.out1f.x1 midi_outdev1 $outdevlist] | ||
3265 | pack $id.out1f.l1 $id.out1f.x1 -side left | ||
3266 | |||
3267 | # output device 2 | ||
3268 | if {$longform && [llength $indevlist] > 2} { | ||
3269 | frame $id.out2f | ||
3270 | pack $id.out2f -side top | ||
3271 | label $id.out2f.l1 -text "output device 2:" | ||
3272 | button $id.out2f.x1 -text [lindex $outdevlist $midi_outdev2] \ | ||
3273 | -command \ | ||
3274 | [list midi_popup $id $id.out2f.x1 midi_outdev2 $outdevlist] | ||
3275 | pack $id.out2f.l1 $id.out2f.x1 -side left | ||
3276 | } | ||
3277 | |||
3278 | # output device 3 | ||
3279 | if {$longform && [llength $indevlist] > 3} { | ||
3280 | frame $id.out3f | ||
3281 | pack $id.out3f -side top | ||
3282 | label $id.out3f.l1 -text "output device 3:" | ||
3283 | button $id.out3f.x1 -text [lindex $outdevlist $midi_outdev3] \ | ||
3284 | -command \ | ||
3285 | [list midi_popup $id $id.out3f.x1 midi_outdev3 $outdevlist] | ||
3286 | pack $id.out3f.l1 $id.out3f.x1 -side left | ||
3287 | } | ||
3288 | |||
3289 | # output device 4 | ||
3290 | if {$longform && [llength $indevlist] > 4} { | ||
3291 | frame $id.out4f | ||
3292 | pack $id.out4f -side top | ||
3293 | label $id.out4f.l1 -text "output device 4:" | ||
3294 | button $id.out4f.x1 -text [lindex $outdevlist $midi_outdev4] \ | ||
3295 | -command \ | ||
3296 | [list midi_popup $id $id.out4f.x1 midi_outdev4 $outdevlist] | ||
3297 | pack $id.out4f.l1 $id.out4f.x1 -side left | ||
3298 | } | ||
3299 | |||
3300 | # if not the "long form" make a button to | ||
3301 | # restart with longform set. | ||
3302 | |||
3303 | if {$longform == 0} { | ||
3304 | frame $id.longbutton | ||
3305 | pack $id.longbutton -side top | ||
3306 | button $id.longbutton.b -text {use multiple devices} \ | ||
3307 | -command {pd pd midi-properties 1 \;} | ||
3308 | pack $id.longbutton.b | ||
3309 | } | ||
3310 | } | ||
3311 | |||
3312 | ############ pdtk_path_dialog -- dialog window for search path ######### | ||
3313 | |||
3314 | proc path_apply {id} { | ||
3315 | global pd_path0 pd_path1 pd_path2 pd_path3 pd_path4 | ||
3316 | global pd_path5 pd_path6 pd_path7 pd_path8 pd_path9 | ||
3317 | |||
3318 | pd [concat pd path-dialog \ | ||
3319 | $pd_path0 $pd_path1 $pd_path2 $pd_path3 $pd_path4 \ | ||
3320 | $pd_path5 $pd_path6 $pd_path7 $pd_path8 $pd_path9 \ | ||
3321 | \;] | ||
3322 | } | ||
3323 | |||
3324 | proc path_cancel {id} { | ||
3325 | pd [concat $id cancel \;] | ||
3326 | } | ||
3327 | |||
3328 | proc path_ok {id} { | ||
3329 | path_apply $id | ||
3330 | path_cancel $id | ||
3331 | } | ||
3332 | set pd_path0 sdfgh | ||
3333 | |||
3334 | proc pdtk_path_dialog {id} { | ||
3335 | global pd_path0 pd_path1 pd_path2 pd_path3 pd_path4 | ||
3336 | global pd_path5 pd_path6 pd_path7 pd_path8 pd_path9 | ||
3337 | |||
3338 | toplevel $id | ||
3339 | wm title $id {PD search path for patches and other files} | ||
3340 | wm protocol $id WM_DELETE_WINDOW [concat path_cancel $id] | ||
3341 | |||
3342 | frame $id.buttonframe | ||
3343 | pack $id.buttonframe -side bottom -fill x -pady 2m | ||
3344 | button $id.buttonframe.cancel -text {Cancel}\ | ||
3345 | -command "path_cancel $id" | ||
3346 | button $id.buttonframe.apply -text {Apply}\ | ||
3347 | -command "path_apply $id" | ||
3348 | button $id.buttonframe.ok -text {OK}\ | ||
3349 | -command "path_ok $id" | ||
3350 | pack $id.buttonframe.cancel -side left -expand 1 | ||
3351 | pack $id.buttonframe.apply -side left -expand 1 | ||
3352 | pack $id.buttonframe.ok -side left -expand 1 | ||
3353 | |||
3354 | for {set x 0} {$x < 10} {incr x} { | ||
3355 | # input device 1 | ||
3356 | entry $id.f$x -textvariable pd_path$x -width 80 | ||
3357 | bind $id.f$x <KeyPress-Return> [concat path_ok $id] | ||
3358 | pack $id.f$x -side top | ||
3359 | } | ||
3360 | |||
3361 | focus $id.f0 | ||
3362 | } | ||
3363 | |||
3364 | proc pd_set {var value} { | ||
3365 | global $var | ||
3366 | set $var $value | ||
3367 | } | ||
3368 | |||