diff options
Diffstat (limited to 'apps/plugins/pdbox/PDa/src/u_main.tk')
-rw-r--r-- | apps/plugins/pdbox/PDa/src/u_main.tk | 6734 |
1 files changed, 6734 insertions, 0 deletions
diff --git a/apps/plugins/pdbox/PDa/src/u_main.tk b/apps/plugins/pdbox/PDa/src/u_main.tk new file mode 100644 index 0000000000..00cb25c4a2 --- /dev/null +++ b/apps/plugins/pdbox/PDa/src/u_main.tk | |||
@@ -0,0 +1,6734 @@ | |||
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 | set pd_nt 1 | ||
3369 | # (The above is 0 for unix, 1 for microsoft, and 2 for Mac OSX. The first | ||
3370 | # line is automatically munged by the relevant makefiles.) | ||
3371 | |||
3372 | # Copyright (c) 1997-1999 Miller Puckette. | ||
3373 | # For information on usage and redistribution, and for a DISCLAIMER OF ALL | ||
3374 | # WARRANTIES, see the file, "LICENSE.txt," in this distribution. | ||
3375 | |||
3376 | # changed by Thomas Musil 09.2001 | ||
3377 | # between "pdtk_graph_dialog -- dialog window for graphs" | ||
3378 | # and "pdtk_array_dialog -- dialog window for arrays" | ||
3379 | # a new dialogbox was inserted, named: | ||
3380 | # "pdtk_iemgui_dialog -- dialog window for iem guis" | ||
3381 | # | ||
3382 | # all this changes are labeled with #######iemlib########## | ||
3383 | |||
3384 | # Tearoff is set to true by default: | ||
3385 | set pd_tearoff 0 | ||
3386 | set menubar 1 | ||
3387 | |||
3388 | set File "F" | ||
3389 | set Windows "W" | ||
3390 | set Edit "E" | ||
3391 | set Find "F" | ||
3392 | set Put "P" | ||
3393 | set Media "M" | ||
3394 | set Help "H" | ||
3395 | |||
3396 | set color grey16 | ||
3397 | set lightcolor grey24 | ||
3398 | |||
3399 | option add *font -*-helvetica-*--bold--9-* | ||
3400 | |||
3401 | # los colores de la muerte | ||
3402 | |||
3403 | option add *background $color | ||
3404 | option add *activeBackground $lightcolor | ||
3405 | |||
3406 | option add *foreground white | ||
3407 | option add *activeForeground white | ||
3408 | |||
3409 | option add *troughColor $lightcolor | ||
3410 | |||
3411 | option add *highlightThickness 0 | ||
3412 | option add *relief solid startupFile | ||
3413 | |||
3414 | if {$pd_nt == 1} { | ||
3415 | global pd_guidir | ||
3416 | global pd_tearoff | ||
3417 | set pd_gui2 [string range $argv0 0 [expr [string last \\ $argv0 ] - 1]] | ||
3418 | regsub -all \\\\ $pd_gui2 / pd_gui3 | ||
3419 | set pd_guidir $pd_gui3/.. | ||
3420 | load $pd_guidir/bin/pdtcl | ||
3421 | set pd_tearoff 1 | ||
3422 | } | ||
3423 | |||
3424 | if {$pd_nt == 2} { | ||
3425 | global pd_guidir | ||
3426 | global pd_tearoff | ||
3427 | set pd_gui2 [string range $argv0 0 [expr [string last / $argv0 ] - 1]] | ||
3428 | set pd_guidir $pd_gui2/.. | ||
3429 | load $pd_guidir/bin/pdtcl | ||
3430 | set pd_tearoff 0 | ||
3431 | } | ||
3432 | |||
3433 | # hack so you can easily test-run this script in linux... define pd_guidir | ||
3434 | # (which is normally defined at startup in pd under linux...) | ||
3435 | |||
3436 | if {$pd_nt == 0} { | ||
3437 | if {! [info exists pd_guidir]} { | ||
3438 | global pd_guidir | ||
3439 | puts stderr {setting pd_guidir to '.'} | ||
3440 | set pd_guidir . | ||
3441 | } | ||
3442 | } | ||
3443 | |||
3444 | # it's unfortunate but we seem to have to turn off global bindings | ||
3445 | # for Text objects to get control-s and control-t to do what we want for | ||
3446 | # "text" dialogs below. Also we have to get rid of tab's changing the focus. | ||
3447 | |||
3448 | bind all <Key-Tab> "" | ||
3449 | bind all <<PrevWindow>> "" | ||
3450 | bind Text <Control-t> {} | ||
3451 | bind Text <Control-s> {} | ||
3452 | # puts stderr [bind all] | ||
3453 | |||
3454 | ################## set up main window ######################### | ||
3455 | menu .mbar | ||
3456 | canvas .dummy -height 2p -width 6c | ||
3457 | |||
3458 | frame .controls | ||
3459 | pack .controls .dummy -side top -fill x | ||
3460 | menu .mbar.file -tearoff $pd_tearoff | ||
3461 | .mbar add cascade -label "$File" -menu .mbar.file | ||
3462 | menu .mbar.find -tearoff $pd_tearoff | ||
3463 | .mbar add cascade -label "$Find" -menu .mbar.find | ||
3464 | menu .mbar.windows -postcommand [concat pdtk_fixwindowmenu] -tearoff $pd_tearoff | ||
3465 | menu .mbar.audio -tearoff $pd_tearoff | ||
3466 | if {$pd_nt != 2} { | ||
3467 | .mbar add cascade -label "$Windows" -menu .mbar.windows | ||
3468 | .mbar add cascade -label "$Media" -menu .mbar.audio | ||
3469 | } else { | ||
3470 | # Perhaps this is silly, but Mac HIG want "Window Help" as the last menus | ||
3471 | .mbar add cascade -label "$Media" -menu .mbar.audio | ||
3472 | .mbar add cascade -label "$Windows" -menu .mbar.windows | ||
3473 | } | ||
3474 | menu .mbar.help -tearoff $pd_tearoff | ||
3475 | .mbar add cascade -label "$Help" -menu .mbar.help | ||
3476 | |||
3477 | set ctrls_audio_on 0 | ||
3478 | set ctrls_meter_on 0 | ||
3479 | set ctrls_inlevel 0 | ||
3480 | set ctrls_outlevel 0 | ||
3481 | |||
3482 | frame .controls.switches | ||
3483 | checkbutton .controls.switches.audiobutton -text {compute audio} \ | ||
3484 | -variable ctrls_audio_on \ | ||
3485 | -anchor w \ | ||
3486 | -command {pd [concat pd dsp $ctrls_audio_on \;]} | ||
3487 | |||
3488 | checkbutton .controls.switches.meterbutton -text {peak meters} \ | ||
3489 | -variable ctrls_meter_on \ | ||
3490 | -anchor w \ | ||
3491 | -command {pd [concat pd meters $ctrls_meter_on \;]} | ||
3492 | |||
3493 | pack .controls.switches.meterbutton .controls.switches.audiobutton -side left | ||
3494 | |||
3495 | frame .controls.inout | ||
3496 | frame .controls.inout.in | ||
3497 | label .controls.inout.in.label -text IN | ||
3498 | entry .controls.inout.in.level -textvariable ctrls_inlevel -width 3 | ||
3499 | button .controls.inout.in.clip -text {CLIP} -state disabled | ||
3500 | pack .controls.inout.in.label .controls.inout.in.level \ | ||
3501 | .controls.inout.in.clip -side top -pady 2 | ||
3502 | |||
3503 | frame .controls.inout.out | ||
3504 | label .controls.inout.out.label -text OUT | ||
3505 | entry .controls.inout.out.level -textvariable ctrls_outlevel -width 3 | ||
3506 | button .controls.inout.out.clip -text {CLIP} -state disabled | ||
3507 | pack .controls.inout.out.label .controls.inout.out.level \ | ||
3508 | .controls.inout.out.clip -side top -pady 2 | ||
3509 | |||
3510 | button .controls.dio -text "DIO\nerrors" \ | ||
3511 | -command {pd [concat pd audiostatus \;]} | ||
3512 | |||
3513 | pack .controls.switches -side bottom -pady 12 | ||
3514 | pack .controls.inout.in .controls.inout.out -side left -padx 6 | ||
3515 | pack .controls.inout -side left -padx 14 | ||
3516 | pack .controls.dio -side right -padx 20 | ||
3517 | |||
3518 | bind . <Control-Key> {pdtk_pd_ctrlkey %W %K 0} | ||
3519 | bind . <Control-Shift-Key> {pdtk_pd_ctrlkey %W %K 1} | ||
3520 | if {$pd_nt == 2} { | ||
3521 | bind . <Mod1-Key> {pdtk_canvas_ctrlkey %W %K 0} | ||
3522 | bind . <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1} | ||
3523 | } | ||
3524 | |||
3525 | |||
3526 | wm title . "PDa" | ||
3527 | . configure -menu .mbar -width 200 -height 150 | ||
3528 | |||
3529 | ############### set up global variables ################################ | ||
3530 | |||
3531 | set untitled_number 1 | ||
3532 | set untitled_directory [pwd] | ||
3533 | set saveas_client doggy | ||
3534 | set pd_opendir $untitled_directory | ||
3535 | set pd_undoaction no | ||
3536 | set pd_redoaction no | ||
3537 | set pd_undocanvas no | ||
3538 | |||
3539 | ################ utility functions ######################### | ||
3540 | |||
3541 | proc pdtk_enquote {x} { | ||
3542 | set foo [string map {"," "" ";" "" \" ""} $x] | ||
3543 | set foo2 [string map {" " "\\ "} $foo] | ||
3544 | concat $foo2 | ||
3545 | } | ||
3546 | |||
3547 | proc pdtk_debug {x} { | ||
3548 | tk_messageBox -message $x -type ok | ||
3549 | } | ||
3550 | |||
3551 | proc pdtk_watchdog {} { | ||
3552 | pd [concat pd ping \;] | ||
3553 | after 2000 {pdtk_watchdog} | ||
3554 | } | ||
3555 | |||
3556 | proc pdtk_check {x message} { | ||
3557 | set answer [tk_messageBox \-message $x \-type yesno \-icon question] | ||
3558 | switch $answer { | ||
3559 | yes {pd $message} } | ||
3560 | # no {tk_messageBox \-message "cancelled" \-type ok} | ||
3561 | } | ||
3562 | |||
3563 | set menu_windowlist {} | ||
3564 | |||
3565 | proc pdtk_fixwindowmenu {} { | ||
3566 | global menu_windowlist | ||
3567 | .mbar.windows delete 0 end | ||
3568 | foreach i $menu_windowlist { | ||
3569 | .mbar.windows add command -label [lindex $i 0] \ | ||
3570 | -command [concat menu_domenuwindow [lindex $i 1]] | ||
3571 | menu_fixwindowmenu [lindex $i 1] | ||
3572 | } | ||
3573 | } | ||
3574 | |||
3575 | ####### Odd little function to make better Mac accelerators ##### | ||
3576 | |||
3577 | proc accel_munge {acc} { | ||
3578 | global pd_nt | ||
3579 | |||
3580 | if {$pd_nt == 2} { | ||
3581 | if [string is upper [string index $acc end]] { | ||
3582 | return [format "%s%s" "Shift+" \ | ||
3583 | [string toupper [string map {Ctrl Meta} $acc] end]] | ||
3584 | } else { | ||
3585 | return [string toupper [string map {Ctrl Meta} $acc] end] | ||
3586 | } | ||
3587 | } else { | ||
3588 | return $acc | ||
3589 | } | ||
3590 | } | ||
3591 | |||
3592 | |||
3593 | |||
3594 | ############### the "New" menu command ######################## | ||
3595 | proc menu_new {} { | ||
3596 | global untitled_number | ||
3597 | global untitled_directory | ||
3598 | pd [concat pd filename Untitled-$untitled_number $untitled_directory \;] | ||
3599 | pd { | ||
3600 | #N canvas; | ||
3601 | #X pop 1; | ||
3602 | } | ||
3603 | set untitled_number [expr $untitled_number + 1] | ||
3604 | } | ||
3605 | |||
3606 | ################## the "Open" menu command ######################### | ||
3607 | |||
3608 | proc menu_open {} { | ||
3609 | global pd_opendir | ||
3610 | |||
3611 | set filename [tk_getOpenFile -defaultextension .pd \ | ||
3612 | -filetypes { {{pd files} {.pd}} {{max files} {.pat}}} \ | ||
3613 | -initialdir $pd_opendir] | ||
3614 | |||
3615 | if {$filename != ""} { | ||
3616 | set directory [string range $filename 0 \ | ||
3617 | [expr [string last / $filename ] - 1]] | ||
3618 | set pd_opendir $directory | ||
3619 | set basename [string range $filename \ | ||
3620 | [expr [string last / $filename ] + 1] end] | ||
3621 | |||
3622 | # pd_debug [concat file $filename base $basename dir $directory] | ||
3623 | |||
3624 | pd [concat pd open [pdtk_enquote $basename] \ | ||
3625 | [pdtk_enquote $directory]\;] | ||
3626 | } | ||
3627 | } | ||
3628 | |||
3629 | ################## the "Message" menu command ######################### | ||
3630 | proc menu_send {} { | ||
3631 | toplevel .sendpanel | ||
3632 | entry .sendpanel.entry -textvariable send_textvariable | ||
3633 | pack .sendpanel.entry -side bottom -fill both -ipadx 100 | ||
3634 | .sendpanel.entry select from 0 | ||
3635 | .sendpanel.entry select adjust end | ||
3636 | bind .sendpanel.entry <KeyPress-Return> { | ||
3637 | pd [concat $send_textvariable \;] | ||
3638 | after 50 {destroy .sendpanel} | ||
3639 | } | ||
3640 | focus .sendpanel.entry | ||
3641 | } | ||
3642 | |||
3643 | ################## the "Quit" menu command ######################### | ||
3644 | proc menu_really_quit {} {pd {pd quit;}} | ||
3645 | |||
3646 | proc menu_quit {} {pd {pd quit;}} | ||
3647 | |||
3648 | ######### the "Pd" menu command, which puts the Pd window on top ######## | ||
3649 | proc menu_pop_pd {} {raise .} | ||
3650 | |||
3651 | ######### the "audio" menu command ############### | ||
3652 | proc menu_audio {flag} {pd [concat pd dsp $flag \;]} | ||
3653 | |||
3654 | ######### the "documentation" menu command ############### | ||
3655 | |||
3656 | set doc_number 1 | ||
3657 | |||
3658 | proc menu_opentext {filename} { | ||
3659 | global doc_number | ||
3660 | global pd_guidir | ||
3661 | global pd_myversion | ||
3662 | set name [format ".help%d" $doc_number] | ||
3663 | toplevel $name | ||
3664 | text $name.text -fg black -relief raised -bd 2 -font -*-courier-bold--normal--12-* \ | ||
3665 | -yscrollcommand "$name.scroll set" -background white | ||
3666 | scrollbar $name.scroll -command "$name.text yview" | ||
3667 | pack $name.scroll -side right -fill y | ||
3668 | pack $name.text -side left -fill both -expand 1 | ||
3669 | |||
3670 | set f [open $filename] | ||
3671 | while {![eof $f]} { | ||
3672 | set bigstring [read $f 1000] | ||
3673 | regsub -all PD_BASEDIR $bigstring $pd_guidir bigstring2 | ||
3674 | regsub -all PD_VERSION $bigstring2 $pd_myversion bigstring3 | ||
3675 | $name.text insert end $bigstring3 | ||
3676 | } | ||
3677 | close $f | ||
3678 | set doc_number [expr $doc_number + 1] | ||
3679 | } | ||
3680 | |||
3681 | set help_directory $pd_guidir/doc | ||
3682 | |||
3683 | proc menu_documentation {} { | ||
3684 | global help_directory | ||
3685 | global pd_nt | ||
3686 | |||
3687 | set filename [tk_getOpenFile -defaultextension .pd \ | ||
3688 | -filetypes { {{documentation} {.pd .txt .htm}} } \ | ||
3689 | -initialdir $help_directory] | ||
3690 | |||
3691 | if {$filename != ""} { | ||
3692 | if {[string first .txt $filename] >= 0} { | ||
3693 | menu_opentext $filename | ||
3694 | } elseif {[string first .htm $filename] >= 0} { | ||
3695 | if {$pd_nt == 0} { | ||
3696 | exec sh -c \ | ||
3697 | [format "mozilla file:%s || netscape file:%s &\n" \ | ||
3698 | $filename $filename] | ||
3699 | } elseif {$pd_nt == 2} { | ||
3700 | puts stderr [format "open %s" $filename] | ||
3701 | exec sh -c \ | ||
3702 | [format "open %s" $filename] | ||
3703 | } else { | ||
3704 | exec rundll32 url.dll,FileProtocolHandler \ | ||
3705 | [format "file:%s" $filename] & | ||
3706 | } | ||
3707 | } else { | ||
3708 | set help_directory [string range $filename 0 \ | ||
3709 | [expr [string last / $filename ] - 1]] | ||
3710 | set basename [string range $filename \ | ||
3711 | [expr [string last / $filename ] + 1] end] | ||
3712 | pd [concat pd open [pdtk_enquote $basename] \ | ||
3713 | [pdtk_enquote $help_directory] \;] | ||
3714 | } | ||
3715 | } | ||
3716 | } | ||
3717 | |||
3718 | proc menu_doc_open {subdir basename} { | ||
3719 | global pd_guidir | ||
3720 | |||
3721 | set dirname $pd_guidir/$subdir | ||
3722 | |||
3723 | if {[string first .txt $basename] >= 0} { | ||
3724 | menu_opentext $dirname/$basename | ||
3725 | } else { | ||
3726 | pd [concat pd open [pdtk_enquote $basename] \ | ||
3727 | [pdtk_enquote $dirname] \;] | ||
3728 | } | ||
3729 | } | ||
3730 | |||
3731 | ############# routine to add audio and help menus ############### | ||
3732 | |||
3733 | proc menu_addstd {mbar} { | ||
3734 | global pd_apilist | ||
3735 | # the "Audio" menu | ||
3736 | $mbar.audio add command -label {audio ON} -accelerator [accel_munge "Ctrl+/"] \ | ||
3737 | -command {menu_audio 1} | ||
3738 | $mbar.audio add command -label {audio OFF} -accelerator [accel_munge "Ctrl+."] \ | ||
3739 | -command {menu_audio 0} | ||
3740 | for {set x 0} {$x<[llength $pd_apilist]} {incr x} { | ||
3741 | $mbar.audio add radiobutton -label [lindex [lindex $pd_apilist $x] 0] \ | ||
3742 | -command {menu_audio 0} -variable pd_whichapi \ | ||
3743 | -value [lindex [lindex $pd_apilist $x] 1]\ | ||
3744 | -command {pd [concat pd audio-setapi $pd_whichapi \;]} | ||
3745 | } | ||
3746 | $mbar.audio add command -label {Audio settings...} \ | ||
3747 | -command {pd pd audio-properties \;} | ||
3748 | |||
3749 | $mbar.audio add command -label {MIDI settings...} \ | ||
3750 | -command {pd pd midi-properties \;} | ||
3751 | $mbar.audio add command -label {Test Audio and MIDI} \ | ||
3752 | -command {menu_doc_open doc/7.stuff/tools testtone.pd} | ||
3753 | $mbar.audio add command -label {Load Meter} \ | ||
3754 | -command {menu_doc_open doc/7.stuff/tools load-meter.pd} | ||
3755 | |||
3756 | |||
3757 | $mbar.audio add checkbutton -label "Show Menubar" \ | ||
3758 | -indicatoron true -selectcolor grey85 \ | ||
3759 | -variable menubar | ||
3760 | |||
3761 | # the "Help" menu | ||
3762 | $mbar.help add command -label {About Pd} \ | ||
3763 | -command {menu_doc_open doc/1.manual 1.introduction.txt} | ||
3764 | $mbar.help add command -label {Pure Documentation...} \ | ||
3765 | -command {menu_documentation} | ||
3766 | } | ||
3767 | |||
3768 | #################### the "File" menu for the Pd window ############## | ||
3769 | |||
3770 | .mbar.file add command -label New -command {menu_new} \ | ||
3771 | -accelerator [accel_munge "Ctrl+n"] | ||
3772 | .mbar.file add command -label Open -command {menu_open} \ | ||
3773 | -accelerator [accel_munge "Ctrl+o"] | ||
3774 | .mbar.file add separator | ||
3775 | .mbar.file add command -label Message -command {menu_send} \ | ||
3776 | -accelerator [accel_munge "Ctrl+m"] | ||
3777 | .mbar.file add command -label Path... \ | ||
3778 | -command {pd pd start-path-dialog \;} | ||
3779 | .mbar.file add separator | ||
3780 | .mbar.file add command -label Quit -command {menu_quit} \ | ||
3781 | -accelerator [accel_munge "Ctrl+q"] | ||
3782 | |||
3783 | #################### the "Find" menu for the Pd window ############## | ||
3784 | .mbar.find add command -label {last error?} -command {menu_finderror} | ||
3785 | |||
3786 | ########### functions for menu functions on document windows ######## | ||
3787 | |||
3788 | proc menu_save {name} { | ||
3789 | pdtk_canvas_checkgeometry $name | ||
3790 | pd [concat $name menusave \;] | ||
3791 | } | ||
3792 | |||
3793 | proc menu_saveas {name} { | ||
3794 | pdtk_canvas_checkgeometry $name | ||
3795 | pd [concat $name menusaveas \;] | ||
3796 | } | ||
3797 | |||
3798 | proc menu_print {name} { | ||
3799 | set filename [tk_getSaveFile -initialfile pd.ps \ | ||
3800 | -defaultextension .ps \ | ||
3801 | -filetypes { {{postscript} {.ps}} }] | ||
3802 | |||
3803 | if {$filename != ""} { | ||
3804 | $name.c postscript -file $filename | ||
3805 | } | ||
3806 | } | ||
3807 | |||
3808 | proc menu_close {name} { | ||
3809 | pd [concat $name menuclose \;] | ||
3810 | } | ||
3811 | |||
3812 | proc menu_undo {name} { | ||
3813 | global pd_undoaction | ||
3814 | global pd_redoaction | ||
3815 | global pd_undocanvas | ||
3816 | if {$name == $pd_undocanvas && $pd_undoaction != "no"} { | ||
3817 | pd [concat $name undo \;] | ||
3818 | } | ||
3819 | } | ||
3820 | |||
3821 | proc menu_redo {name} { | ||
3822 | global pd_undoaction | ||
3823 | global pd_redoaction | ||
3824 | global pd_undocanvas | ||
3825 | if {$name == $pd_undocanvas && $pd_redoaction != "no"} { | ||
3826 | pd [concat $name redo \;] | ||
3827 | } | ||
3828 | } | ||
3829 | |||
3830 | proc menu_cut {name} { | ||
3831 | pd [concat $name cut \;] | ||
3832 | } | ||
3833 | |||
3834 | proc menu_copy {name} { | ||
3835 | pd [concat $name copy \;] | ||
3836 | } | ||
3837 | |||
3838 | proc menu_paste {name} { | ||
3839 | pd [concat $name paste \;] | ||
3840 | } | ||
3841 | |||
3842 | proc menu_duplicate {name} { | ||
3843 | pd [concat $name duplicate \;] | ||
3844 | } | ||
3845 | |||
3846 | proc menu_selectall {name} { | ||
3847 | pd [concat $name selectall \;] | ||
3848 | } | ||
3849 | |||
3850 | proc menu_texteditor {name} { | ||
3851 | pd [concat $name texteditor \;] | ||
3852 | } | ||
3853 | |||
3854 | proc menu_font {name} { | ||
3855 | pd [concat $name menufont \;] | ||
3856 | } | ||
3857 | |||
3858 | proc menu_tidyup {name} { | ||
3859 | pd [concat $name tidy \;] | ||
3860 | } | ||
3861 | |||
3862 | proc menu_editmode {name} { | ||
3863 | pd [concat $name editmode 0 \;] | ||
3864 | } | ||
3865 | |||
3866 | proc menu_object {name accel} { | ||
3867 | pd [concat $name obj $accel \;] | ||
3868 | } | ||
3869 | |||
3870 | proc menu_message {name accel} { | ||
3871 | pd [concat $name msg $accel \;] | ||
3872 | } | ||
3873 | |||
3874 | proc menu_floatatom {name accel} { | ||
3875 | pd [concat $name floatatom $accel \;] | ||
3876 | } | ||
3877 | |||
3878 | proc menu_symbolatom {name accel} { | ||
3879 | pd [concat $name symbolatom $accel \;] | ||
3880 | } | ||
3881 | |||
3882 | proc menu_comment {name accel} { | ||
3883 | pd [concat $name text $accel \;] | ||
3884 | } | ||
3885 | |||
3886 | proc menu_graph {name} { | ||
3887 | pd [concat $name graph \;] | ||
3888 | } | ||
3889 | |||
3890 | proc menu_array {name} { | ||
3891 | pd [concat $name menuarray \;] | ||
3892 | } | ||
3893 | |||
3894 | ############iemlib################## | ||
3895 | proc menu_bng {name accel} { | ||
3896 | pd [concat $name bng $accel \;] | ||
3897 | } | ||
3898 | |||
3899 | proc menu_toggle {name accel} { | ||
3900 | pd [concat $name toggle $accel \;] | ||
3901 | } | ||
3902 | |||
3903 | proc menu_numbox {name accel} { | ||
3904 | pd [concat $name numbox $accel \;] | ||
3905 | } | ||
3906 | |||
3907 | proc menu_vslider {name accel} { | ||
3908 | pd [concat $name vslider $accel \;] | ||
3909 | } | ||
3910 | |||
3911 | proc menu_hslider {name accel} { | ||
3912 | pd [concat $name hslider $accel \;] | ||
3913 | } | ||
3914 | |||
3915 | proc menu_hradio {name accel} { | ||
3916 | pd [concat $name hradio $accel \;] | ||
3917 | } | ||
3918 | |||
3919 | proc menu_vradio {name accel} { | ||
3920 | pd [concat $name vradio $accel \;] | ||
3921 | } | ||
3922 | |||
3923 | proc menu_vumeter {name accel} { | ||
3924 | pd [concat $name vumeter $accel \;] | ||
3925 | } | ||
3926 | |||
3927 | proc menu_mycnv {name accel} { | ||
3928 | pd [concat $name mycnv $accel \;] | ||
3929 | } | ||
3930 | |||
3931 | ############iemlib################## | ||
3932 | |||
3933 | # correct edit menu, enabling or disabling undo/redo | ||
3934 | # LATER also cut/copy/paste | ||
3935 | proc menu_fixeditmenu {name} { | ||
3936 | global pd_undoaction | ||
3937 | global pd_redoaction | ||
3938 | global pd_undocanvas | ||
3939 | # puts stderr [concat menu_fixeditmenu $name $pd_undocanvas $pd_undoaction] | ||
3940 | if {$name == $pd_undocanvas && $pd_undoaction != "no"} { | ||
3941 | $name.m.edit entryconfigure "Undo*" -state normal \ | ||
3942 | -label [concat "Undo " $pd_undoaction] | ||
3943 | } else { | ||
3944 | $name.m.edit entryconfigure "Undo*" -state disabled -label "Undo" | ||
3945 | } | ||
3946 | if {$name == $pd_undocanvas && $pd_redoaction != "no"} { | ||
3947 | $name.m.edit entryconfigure "Redo*" -state normal\ | ||
3948 | -label [concat "Redo " $pd_redoaction] | ||
3949 | } else { | ||
3950 | $name.m.edit entryconfigure "Redo*" -state disabled | ||
3951 | } | ||
3952 | } | ||
3953 | |||
3954 | # message from Pd to update the currently available undo/redo action | ||
3955 | proc pdtk_undomenu {name undoaction redoaction} { | ||
3956 | global pd_undoaction | ||
3957 | global pd_redoaction | ||
3958 | global pd_undocanvas | ||
3959 | # puts stderr [concat pdtk_undomenu $name $undoaction $redoaction] | ||
3960 | set pd_undocanvas $name | ||
3961 | set pd_undoaction $undoaction | ||
3962 | set pd_redoaction $redoaction | ||
3963 | if {$name != "nobody"} { | ||
3964 | # unpleasant way of avoiding a more unpleasant bug situation --atl 2002.11.25 | ||
3965 | menu_fixeditmenu $name | ||
3966 | } | ||
3967 | } | ||
3968 | |||
3969 | proc menu_windowparent {name} { | ||
3970 | pd [concat $name findparent \;] | ||
3971 | } | ||
3972 | |||
3973 | proc menu_findagain {name} { | ||
3974 | pd [concat $name findagain \;] | ||
3975 | } | ||
3976 | |||
3977 | proc menu_finderror {} { | ||
3978 | pd [concat pd finderror \;] | ||
3979 | } | ||
3980 | |||
3981 | proc menu_domenuwindow {i} { | ||
3982 | raise $i | ||
3983 | } | ||
3984 | |||
3985 | proc menu_fixwindowmenu {name} { | ||
3986 | global menu_windowlist | ||
3987 | global pd_tearoff | ||
3988 | global menubar | ||
3989 | |||
3990 | if { $menubar == 1 } { | ||
3991 | $name.m.windows add command | ||
3992 | if $pd_tearoff { | ||
3993 | $name.m.windows delete 4 end | ||
3994 | } else { | ||
3995 | $name.m.windows delete 3 end | ||
3996 | } | ||
3997 | foreach i $menu_windowlist { | ||
3998 | $name.m.windows add command -label [lindex $i 0] \ | ||
3999 | -command [concat menu_domenuwindow [lindex $i 1]] | ||
4000 | } | ||
4001 | } | ||
4002 | } | ||
4003 | |||
4004 | ################## the "find" menu item ################### | ||
4005 | |||
4006 | set find_canvas nobody | ||
4007 | set find_string "" | ||
4008 | set find_count 1 | ||
4009 | |||
4010 | proc find_apply {name} { | ||
4011 | global find_string | ||
4012 | global find_canvas | ||
4013 | regsub -all \; $find_string " _semi_ " find_string2 | ||
4014 | regsub -all \, $find_string2 " _comma_ " find_string3 | ||
4015 | # puts stderr [concat $find_canvas find $find_string3 \ | ||
4016 | # \;] | ||
4017 | pd [concat $find_canvas find $find_string3 \ | ||
4018 | \;] | ||
4019 | after 50 destroy $name | ||
4020 | } | ||
4021 | |||
4022 | proc find_cancel {name} { | ||
4023 | after 50 destroy $name | ||
4024 | } | ||
4025 | |||
4026 | proc menu_findobject {canvas} { | ||
4027 | global find_string | ||
4028 | global find_canvas | ||
4029 | global find_count | ||
4030 | |||
4031 | set name [format ".find%d" $find_count] | ||
4032 | set find_count [expr $find_count + 1] | ||
4033 | |||
4034 | set find_canvas $canvas | ||
4035 | |||
4036 | toplevel $name | ||
4037 | |||
4038 | label $name.label -text {find...} | ||
4039 | pack $name.label -side top | ||
4040 | |||
4041 | entry $name.entry -textvariable find_string | ||
4042 | pack $name.entry -side top | ||
4043 | |||
4044 | frame $name.buttonframe | ||
4045 | pack $name.buttonframe -side bottom -fill x -pady 2m | ||
4046 | button $name.buttonframe.cancel -text {Cancel}\ | ||
4047 | -command "find_cancel $name" | ||
4048 | button $name.buttonframe.ok -text {OK}\ | ||
4049 | -command "find_apply $name" | ||
4050 | pack $name.buttonframe.cancel -side left -expand 1 | ||
4051 | pack $name.buttonframe.ok -side left -expand 1 | ||
4052 | |||
4053 | $name.entry select from 0 | ||
4054 | $name.entry select adjust end | ||
4055 | bind $name.entry <KeyPress-Return> [ concat find_apply $name] | ||
4056 | focus $name.entry | ||
4057 | } | ||
4058 | |||
4059 | |||
4060 | |||
4061 | proc pdtk_canvas_menubar {name width height geometry editable} { | ||
4062 | global pd_opendir | ||
4063 | global pd_tearoff | ||
4064 | global pd_nt | ||
4065 | |||
4066 | global File Edit Find Put Windows Media Help | ||
4067 | |||
4068 | |||
4069 | menu $name.m.file -tearoff $pd_tearoff | ||
4070 | $name.m add cascade -label "$File" -menu $name.m.file | ||
4071 | |||
4072 | $name.m.file add command -label New -command {menu_new} \ | ||
4073 | -accelerator [accel_munge "Ctrl+n"] | ||
4074 | |||
4075 | $name.m.file add command -label Open -command {menu_open} \ | ||
4076 | -accelerator [accel_munge "Ctrl+o"] | ||
4077 | |||
4078 | $name.m.file add separator | ||
4079 | $name.m.file add command -label Message -command {menu_send} \ | ||
4080 | -accelerator [accel_munge "Ctrl+m"] | ||
4081 | |||
4082 | $name.m.file add command -label Path... \ | ||
4083 | -command {pd pd start-path-dialog \;} | ||
4084 | |||
4085 | $name.m.file add separator | ||
4086 | $name.m.file add command -label Close \ | ||
4087 | -command [concat menu_close $name] \ | ||
4088 | -accelerator [accel_munge "Ctrl+w"] | ||
4089 | |||
4090 | $name.m.file add command -label Save -command [concat menu_save $name] \ | ||
4091 | -accelerator [accel_munge "Ctrl+s"] | ||
4092 | |||
4093 | $name.m.file add command -label "Save as..." \ | ||
4094 | -command [concat menu_saveas $name] \ | ||
4095 | -accelerator [accel_munge "Ctrl+S"] | ||
4096 | |||
4097 | $name.m.file add command -label Print -command [concat menu_print $name] \ | ||
4098 | -accelerator [accel_munge "Ctrl+p"] | ||
4099 | |||
4100 | $name.m.file add separator | ||
4101 | |||
4102 | $name.m.file add command -label Quit -command {menu_quit} \ | ||
4103 | -accelerator [accel_munge "Ctrl+q"] | ||
4104 | |||
4105 | # the edit menu | ||
4106 | menu $name.m.edit -postcommand [concat menu_fixeditmenu $name] -tearoff $pd_tearoff | ||
4107 | $name.m add cascade -label $Edit -menu $name.m.edit | ||
4108 | |||
4109 | $name.m.edit add command -label Undo -command [concat menu_undo $name] \ | ||
4110 | -accelerator [accel_munge "Ctrl+z"] | ||
4111 | |||
4112 | $name.m.edit add command -label Redo -command [concat menu_redo $name] \ | ||
4113 | -accelerator [accel_munge "Ctrl+Z"] | ||
4114 | |||
4115 | $name.m.edit add separator | ||
4116 | |||
4117 | $name.m.edit add command -label Cut -command [concat menu_cut $name] \ | ||
4118 | -accelerator [accel_munge "Ctrl+x"] | ||
4119 | |||
4120 | $name.m.edit add command -label Copy -command [concat menu_copy $name] \ | ||
4121 | -accelerator [accel_munge "Ctrl+c"] | ||
4122 | |||
4123 | $name.m.edit add command -label Paste \ | ||
4124 | -command [concat menu_paste $name] \ | ||
4125 | -accelerator [accel_munge "Ctrl+v"] | ||
4126 | |||
4127 | $name.m.edit add command -label Duplicate \ | ||
4128 | -command [concat menu_duplicate $name] \ | ||
4129 | -accelerator [accel_munge "Ctrl+d"] | ||
4130 | |||
4131 | $name.m.edit add command -label {Select all} \ | ||
4132 | -command [concat menu_selectall $name] \ | ||
4133 | -accelerator [accel_munge "Ctrl+a"] | ||
4134 | |||
4135 | $name.m.edit add separator | ||
4136 | |||
4137 | $name.m.edit add command -label {Text Editor} \ | ||
4138 | -command [concat menu_texteditor $name] \ | ||
4139 | -accelerator [accel_munge "Ctrl+t"] | ||
4140 | |||
4141 | $name.m.edit add command -label Font \ | ||
4142 | -command [concat menu_font $name] | ||
4143 | |||
4144 | $name.m.edit add command -label {Tidy Up} \ | ||
4145 | -command [concat menu_tidyup $name] | ||
4146 | |||
4147 | $name.m.edit add separator | ||
4148 | |||
4149 | ############iemlib################## | ||
4150 | # instead of "red = #BC3C60" we take "grey85", so there is no difference, | ||
4151 | # if widget is selected or not. | ||
4152 | |||
4153 | $name.m.edit add checkbutton -label "Edit mode" \ | ||
4154 | -indicatoron true -selectcolor grey85 \ | ||
4155 | -command [concat menu_editmode $name] \ | ||
4156 | -accelerator [accel_munge "Ctrl+e"] | ||
4157 | |||
4158 | if { $editable == 0 } { | ||
4159 | $name.m.edit entryconfigure "Edit mode" -indicatoron false } | ||
4160 | |||
4161 | ############iemlib################## | ||
4162 | |||
4163 | # the put menu | ||
4164 | menu $name.m.put -tearoff $pd_tearoff | ||
4165 | $name.m add cascade -label $Put -menu $name.m.put | ||
4166 | |||
4167 | $name.m.put add command -label Object \ | ||
4168 | -command [concat menu_object $name 0] \ | ||
4169 | -accelerator [accel_munge "Ctrl+1"] | ||
4170 | |||
4171 | $name.m.put add command -label Message \ | ||
4172 | -command [concat menu_message $name 0] \ | ||
4173 | -accelerator [accel_munge "Ctrl+2"] | ||
4174 | |||
4175 | $name.m.put add command -label Number \ | ||
4176 | -command [concat menu_floatatom $name 0] \ | ||
4177 | -accelerator [accel_munge "Ctrl+3"] | ||
4178 | |||
4179 | $name.m.put add command -label Symbol \ | ||
4180 | -command [concat menu_symbolatom $name 0] \ | ||
4181 | -accelerator [accel_munge "Ctrl+4"] | ||
4182 | |||
4183 | $name.m.put add command -label Comment \ | ||
4184 | -command [concat menu_comment $name 0] \ | ||
4185 | -accelerator [accel_munge "Ctrl+5"] | ||
4186 | |||
4187 | $name.m.put add separator | ||
4188 | |||
4189 | ############iemlib################## | ||
4190 | |||
4191 | $name.m.put add command -label Bang \ | ||
4192 | -command [concat menu_bng $name 0] \ | ||
4193 | -accelerator [accel_munge "Alt+b"] | ||
4194 | |||
4195 | $name.m.put add command -label Toggle \ | ||
4196 | -command [concat menu_toggle $name 0] \ | ||
4197 | -accelerator [accel_munge "Alt+t"] | ||
4198 | |||
4199 | $name.m.put add command -label Number2 \ | ||
4200 | -command [concat menu_numbox $name 0] \ | ||
4201 | -accelerator [accel_munge "Alt+n"] | ||
4202 | |||
4203 | $name.m.put add command -label Vslider \ | ||
4204 | -command [concat menu_vslider $name 0] \ | ||
4205 | -accelerator [accel_munge "Alt+v"] | ||
4206 | |||
4207 | $name.m.put add command -label Hslider \ | ||
4208 | -command [concat menu_hslider $name 0] \ | ||
4209 | -accelerator [accel_munge "Alt+h"] | ||
4210 | |||
4211 | $name.m.put add command -label Vradio \ | ||
4212 | -command [concat menu_vradio $name 0] \ | ||
4213 | -accelerator [accel_munge "Alt+d"] | ||
4214 | |||
4215 | $name.m.put add command -label Hradio \ | ||
4216 | -command [concat menu_hradio $name 0] \ | ||
4217 | -accelerator [accel_munge "Alt+i"] | ||
4218 | |||
4219 | $name.m.put add command -label VU \ | ||
4220 | -command [concat menu_vumeter $name 0] \ | ||
4221 | -accelerator [accel_munge "Alt+u"] | ||
4222 | |||
4223 | $name.m.put add command -label Canvas \ | ||
4224 | -command [concat menu_mycnv $name 0] \ | ||
4225 | -accelerator [accel_munge "Alt+c"] | ||
4226 | |||
4227 | ############iemlib################## | ||
4228 | |||
4229 | $name.m.put add separator | ||
4230 | |||
4231 | $name.m.put add command -label Graph \ | ||
4232 | -command [concat menu_graph $name] | ||
4233 | |||
4234 | $name.m.put add command -label Array \ | ||
4235 | -command [concat menu_array $name] | ||
4236 | |||
4237 | # the find menu | ||
4238 | menu $name.m.find -tearoff $pd_tearoff | ||
4239 | $name.m add cascade -label "$Find" -menu $name.m.find | ||
4240 | |||
4241 | $name.m.find add command -label {Find...} \ | ||
4242 | -accelerator [accel_munge "Ctrl+f"] \ | ||
4243 | -command [concat menu_findobject $name] | ||
4244 | $name.m.find add command -label {Find Again} \ | ||
4245 | -accelerator [accel_munge "Ctrl+g"] \ | ||
4246 | -command [concat menu_findagain $name] | ||
4247 | $name.m.find add command -label {Find last error} \ | ||
4248 | -command [concat menu_finderror] | ||
4249 | |||
4250 | # the window menu | ||
4251 | menu $name.m.windows -postcommand [concat menu_fixwindowmenu $name] \ | ||
4252 | -tearoff $pd_tearoff | ||
4253 | |||
4254 | $name.m.windows add command -label {parent window}\ | ||
4255 | -command [concat menu_windowparent $name] | ||
4256 | $name.m.windows add command -label {Pd window} -command menu_pop_pd | ||
4257 | $name.m.windows add separator | ||
4258 | |||
4259 | # the audio menu | ||
4260 | menu $name.m.audio -tearoff $pd_tearoff | ||
4261 | |||
4262 | if {$pd_nt != 2} { | ||
4263 | $name.m add cascade -label $Windows -menu $name.m.windows | ||
4264 | $name.m add cascade -label $Media -menu $name.m.audio | ||
4265 | } else { | ||
4266 | $name.m add cascade -label $Media -menu $name.m.audio | ||
4267 | $name.m add cascade -label $Windows -menu $name.m.windows | ||
4268 | } | ||
4269 | |||
4270 | # the help menu | ||
4271 | menu $name.m.help -tearoff $pd_tearoff | ||
4272 | $name.m add cascade -label $Help -menu $name.m.help | ||
4273 | |||
4274 | menu_addstd $name.m | ||
4275 | } | ||
4276 | |||
4277 | |||
4278 | ############# pdtk_canvas_new -- create a new canvas ############### | ||
4279 | proc pdtk_canvas_new {name width height geometry editable} { | ||
4280 | global pd_opendir | ||
4281 | global pd_tearoff | ||
4282 | global pd_nt | ||
4283 | global menubar | ||
4284 | |||
4285 | toplevel $name -menu $name.m | ||
4286 | # puts stderr [concat geometry: $geometry] | ||
4287 | wm geometry $name $geometry | ||
4288 | wm minsize $name 1 1 | ||
4289 | |||
4290 | canvas $name.c -width $width -height $height -background white \ | ||
4291 | -yscrollcommand "$name.scrollvert set" \ | ||
4292 | -xscrollcommand "$name.scrollhort set" \ | ||
4293 | -scrollregion [concat 0 0 $width $height] | ||
4294 | |||
4295 | |||
4296 | scrollbar $name.scrollvert -command "$name.c yview" -width 7 | ||
4297 | scrollbar $name.scrollhort -command "$name.c xview" \ | ||
4298 | -orient horizontal -width 7 | ||
4299 | |||
4300 | pack $name.scrollhort -side bottom -fill x | ||
4301 | pack $name.scrollvert -side right -fill y | ||
4302 | pack $name.c -side left -expand 1 -fill both | ||
4303 | |||
4304 | # the menubar | ||
4305 | |||
4306 | menu $name.m | ||
4307 | |||
4308 | if { $menubar == 1 } { | ||
4309 | pdtk_canvas_menubar $name $width $height $geometry $editable | ||
4310 | } | ||
4311 | |||
4312 | # the popup menu | ||
4313 | menu $name.popup -tearoff false | ||
4314 | $name.popup add command -label {Properties} \ | ||
4315 | -command [concat popup_action $name 0] | ||
4316 | $name.popup add command -label {Open} \ | ||
4317 | -command [concat popup_action $name 1] | ||
4318 | $name.popup add command -label {Help} \ | ||
4319 | -command [concat popup_action $name 2] | ||
4320 | |||
4321 | # WM protocol | ||
4322 | wm protocol $name WM_DELETE_WINDOW [concat menu_close $name] | ||
4323 | |||
4324 | # bindings. | ||
4325 | # this is idiotic -- how do you just sense what mod keys are down and | ||
4326 | # pass them on? I can't find it anywhere. | ||
4327 | # Here we encode shift as 1, control 2, alt 4, in agreement | ||
4328 | # with definitions in g_canvas.c. The third button gets "8" but we don't | ||
4329 | # bother with modifiers there. | ||
4330 | # We don't handle multiple clicks yet. | ||
4331 | |||
4332 | bind $name.c <Button> {pdtk_canvas_click %W %x %y %b 0} | ||
4333 | bind $name.c <Shift-Button> {pdtk_canvas_click %W %x %y %b 1} | ||
4334 | bind $name.c <Control-Shift-Button> {pdtk_canvas_click %W %x %y %b 3} | ||
4335 | bind $name.c <Alt-Button> {pdtk_canvas_click %W %x %y %b 4} | ||
4336 | bind $name.c <Alt-Shift-Button> {pdtk_canvas_click %W %x %y %b 5} | ||
4337 | bind $name.c <Alt-Control-Button> {pdtk_canvas_click %W %x %y %b 6} | ||
4338 | bind $name.c <Alt-Control-Shift-Button> {pdtk_canvas_click %W %x %y %b 7} | ||
4339 | global pd_nt | ||
4340 | if {$pd_nt == 2} { | ||
4341 | bind $name.c <Button-2> {pdtk_canvas_click %W %x %y %b 8} | ||
4342 | bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 8} | ||
4343 | } else { | ||
4344 | bind $name.c <Button-3> {pdtk_canvas_click %W %x %y %b 8} | ||
4345 | bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 2} | ||
4346 | } | ||
4347 | # change mac to right-click, not middle click -atl 2002.09.02 | ||
4348 | |||
4349 | bind $name.c <ButtonRelease> {pdtk_canvas_mouseup %W %x %y %b} | ||
4350 | bind $name.c <Control-Key> {pdtk_canvas_ctrlkey %W %K 0} | ||
4351 | bind $name.c <Control-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1} | ||
4352 | bind $name.c <Alt-Key> {pdtk_canvas_altkey %W %K %A} | ||
4353 | # bind $name.c <Mod1-Key> {puts stderr [concat mod1 %W %K %A]} | ||
4354 | if {$pd_nt == 2} { | ||
4355 | bind $name.c <Mod1-Key> {pdtk_canvas_ctrlkey %W %K 0} | ||
4356 | bind $name.c <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1} | ||
4357 | } | ||
4358 | bind $name.c <Key> {pdtk_canvas_key %W %K %A 0} | ||
4359 | bind $name.c <Shift-Key> {pdtk_canvas_key %W %K %A 1} | ||
4360 | bind $name.c <KeyRelease> {pdtk_canvas_keyup %W %K %A} | ||
4361 | bind $name.c <Motion> {pdtk_canvas_motion %W %x %y 0} | ||
4362 | bind $name.c <Alt-Motion> {pdtk_canvas_motion %W %x %y 4} | ||
4363 | bind $name.c <Map> {pdtk_canvas_map %W} | ||
4364 | bind $name.c <Unmap> {pdtk_canvas_unmap %W} | ||
4365 | focus $name.c | ||
4366 | # puts stderr "all done" | ||
4367 | # after 1 [concat raise $name] | ||
4368 | } | ||
4369 | |||
4370 | #################### event binding procedures ################ | ||
4371 | |||
4372 | #get the name of the toplevel window for a canvas; this is also | ||
4373 | #the name of the canvas object in Pd. | ||
4374 | |||
4375 | proc canvastosym {name} { | ||
4376 | string range $name 0 [expr [string length $name] - 3] | ||
4377 | } | ||
4378 | |||
4379 | set pdtk_lastcanvasconfigured "" | ||
4380 | set pdtk_lastcanvasconfiguration "" | ||
4381 | |||
4382 | proc pdtk_canvas_checkgeometry {topname} { | ||
4383 | set boo [winfo geometry $topname.c] | ||
4384 | set boo2 [wm geometry $topname] | ||
4385 | global pdtk_lastcanvasconfigured | ||
4386 | global pdtk_lastcanvasconfiguration | ||
4387 | if {$topname != $pdtk_lastcanvasconfigured || \ | ||
4388 | $boo != $pdtk_lastcanvasconfiguration} { | ||
4389 | set pdtk_lastcanvasconfigured $topname | ||
4390 | set pdtk_lastcanvasconfiguration $boo | ||
4391 | pd $topname relocate $boo $boo2 \; | ||
4392 | } | ||
4393 | } | ||
4394 | |||
4395 | proc pdtk_canvas_click {name x y b f} { | ||
4396 | # puts stderr [concat got $f] | ||
4397 | pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b $f \; | ||
4398 | } | ||
4399 | |||
4400 | proc pdtk_canvas_shiftclick {name x y b} { | ||
4401 | pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 1 \; | ||
4402 | } | ||
4403 | |||
4404 | proc pdtk_canvas_ctrlclick {name x y b} { | ||
4405 | pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 2 \; | ||
4406 | } | ||
4407 | |||
4408 | proc pdtk_canvas_altclick {name x y b} { | ||
4409 | pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 3 \; | ||
4410 | } | ||
4411 | |||
4412 | proc pdtk_canvas_dblclick {name x y b} { | ||
4413 | pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 4 \; | ||
4414 | } | ||
4415 | |||
4416 | set pdtk_canvas_mouseup_name 0 | ||
4417 | set pdtk_canvas_mouseup_xminval 0 | ||
4418 | set pdtk_canvas_mouseup_xmaxval 0 | ||
4419 | set pdtk_canvas_mouseup_yminval 0 | ||
4420 | set pdtk_canvas_mouseup_ymaxval 0 | ||
4421 | |||
4422 | proc pdtk_canvas_mouseup {name x y b} { | ||
4423 | pd [concat [canvastosym $name] mouseup [$name canvasx $x] \ | ||
4424 | [$name canvasy $y] $b \;] | ||
4425 | |||
4426 | # we use the mouseup event to update scrollbar ranges and recheck the | ||
4427 | # geometry of the window since I haven't taken the time to figure out | ||
4428 | # how to do it right. | ||
4429 | |||
4430 | global pdtk_canvas_mouseup_name | ||
4431 | global pdtk_canvas_mouseup_xminval | ||
4432 | global pdtk_canvas_mouseup_xmaxval | ||
4433 | global pdtk_canvas_mouseup_yminval | ||
4434 | global pdtk_canvas_mouseup_ymaxval | ||
4435 | |||
4436 | set size [$name bbox all] | ||
4437 | if {$size != ""} { | ||
4438 | set xminval 0 | ||
4439 | set yminval 0 | ||
4440 | set xmaxval 100 | ||
4441 | set ymaxval 100 | ||
4442 | set x1 [lindex $size 0] | ||
4443 | set x2 [lindex $size 2] | ||
4444 | set y1 [lindex $size 1] | ||
4445 | set y2 [lindex $size 3] | ||
4446 | |||
4447 | if {$x1 < 0} {set xminval $x1} | ||
4448 | if {$y1 < 0} {set yminval $y1} | ||
4449 | |||
4450 | if {$x2 > 100} {set xmaxval $x2} | ||
4451 | if {$y2 > 100} {set ymaxval $y2} | ||
4452 | |||
4453 | if {$pdtk_canvas_mouseup_name != $name || \ | ||
4454 | $pdtk_canvas_mouseup_xminval != $xminval || \ | ||
4455 | $pdtk_canvas_mouseup_xmaxval != $xmaxval || \ | ||
4456 | $pdtk_canvas_mouseup_yminval != $yminval || \ | ||
4457 | $pdtk_canvas_mouseup_ymaxval != $ymaxval } { | ||
4458 | |||
4459 | set newsize "$xminval $yminval $xmaxval $ymaxval" | ||
4460 | $name configure -scrollregion $newsize | ||
4461 | set pdtk_canvas_mouseup_name $name | ||
4462 | set pdtk_canvas_mouseup_xminval $xminval | ||
4463 | set pdtk_canvas_mouseup_xmaxval $xmaxval | ||
4464 | set pdtk_canvas_mouseup_yminval $yminval | ||
4465 | set pdtk_canvas_mouseup_ymaxval $ymaxval | ||
4466 | } | ||
4467 | |||
4468 | } | ||
4469 | pdtk_canvas_checkgeometry [canvastosym $name] | ||
4470 | } | ||
4471 | |||
4472 | proc pdtk_canvas_key {name key iso shift} { | ||
4473 | # puts stderr [concat down key= $key iso= $iso] | ||
4474 | # .controls.switches.meterbutton configure -text $key | ||
4475 | # HACK for MAC OSX -- backspace seems different; I don't understand why. | ||
4476 | # invesigate this LATER... | ||
4477 | global pd_nt | ||
4478 | if {$pd_nt == 2} { | ||
4479 | if {$key == "BackSpace"} { | ||
4480 | set key 8 | ||
4481 | set keynum 8 | ||
4482 | } | ||
4483 | if {$key == "Delete"} { | ||
4484 | set key 8 | ||
4485 | set keynum 8 | ||
4486 | } | ||
4487 | } | ||
4488 | if {$key == "KP_Delete"} { | ||
4489 | set key 127 | ||
4490 | set keynum 127 | ||
4491 | } | ||
4492 | if {$iso != ""} { | ||
4493 | scan $iso %c keynum | ||
4494 | pd [canvastosym $name] key 1 $keynum $shift\; | ||
4495 | } else { | ||
4496 | pd [canvastosym $name] key 1 $key $shift\; | ||
4497 | } | ||
4498 | } | ||
4499 | |||
4500 | proc pdtk_canvas_keyup {name key iso} { | ||
4501 | # puts stderr [concat up key= $key iso= $iso] | ||
4502 | if {$iso != ""} { | ||
4503 | scan $iso %c keynum | ||
4504 | pd [canvastosym $name] key 0 $keynum 0 \; | ||
4505 | } else { | ||
4506 | pd [canvastosym $name] key 0 $key 0 \; | ||
4507 | } | ||
4508 | } | ||
4509 | |||
4510 | proc pdtk_canvas_altkey {name key iso} { | ||
4511 | # puts stderr [concat alt-key $iso] | ||
4512 | ############iemlib################## | ||
4513 | set topname [string trimright $name .c] | ||
4514 | if {$key == "b" || $key == "B"} {menu_bng $topname 1} | ||
4515 | if {$key == "t" || $key == "T"} {menu_toggle $topname 1} | ||
4516 | if {$key == "n" || $key == "N"} {menu_numbox $topname 1} | ||
4517 | if {$key == "v" || $key == "V"} {menu_vslider $topname 1} | ||
4518 | if {$key == "h" || $key == "H"} {menu_hslider $topname 1} | ||
4519 | if {$key == "i" || $key == "I"} {menu_hradio $topname 1} | ||
4520 | if {$key == "d" || $key == "D"} {menu_vradio $topname 1} | ||
4521 | if {$key == "u" || $key == "U"} {menu_vumeter $topname 1} | ||
4522 | if {$key == "c" || $key == "C"} {menu_mycnv $topname 1} | ||
4523 | ############iemlib################## | ||
4524 | } | ||
4525 | |||
4526 | proc pdtk_canvas_ctrlkey {name key shift} { | ||
4527 | # first get rid of ".c" suffix; we'll refer to the toplevel instead | ||
4528 | set topname [string trimright $name .c] | ||
4529 | # puts stderr [concat ctrl-key $key $topname] | ||
4530 | |||
4531 | if {$key == "n" || $key == "N"} {menu_new} | ||
4532 | if {$key == "o" || $key == "O"} {menu_open} | ||
4533 | if {$key == "m" || $key == "M"} {menu_send} | ||
4534 | if {$key == "q" || $key == "Q"} { | ||
4535 | if {$shift == 1} {menu_really_quit} else {menu_quit} | ||
4536 | } | ||
4537 | if {$key == "s" || $key == "S"} { | ||
4538 | if {$shift == 1} {menu_saveas $topname} else {menu_save $topname} | ||
4539 | } | ||
4540 | if {$key == "z" || $key == "Z"} { | ||
4541 | if {$shift == 1} {menu_redo $topname} else {menu_undo $topname} | ||
4542 | } | ||
4543 | if {$key == "w" || $key == "W"} {menu_close $topname} | ||
4544 | if {$key == "p" || $key == "P"} {menu_print $topname} | ||
4545 | if {$key == "x" || $key == "X"} {menu_cut $topname} | ||
4546 | if {$key == "c" || $key == "C"} {menu_copy $topname} | ||
4547 | if {$key == "v" || $key == "V"} {menu_paste $topname} | ||
4548 | if {$key == "d" || $key == "D"} {menu_duplicate $topname} | ||
4549 | if {$key == "a" || $key == "A"} {menu_selectall $topname} | ||
4550 | if {$key == "t" || $key == "T"} {menu_texteditor $topname} | ||
4551 | if {$key == "f" || $key == "F"} {menu_findobject $topname} | ||
4552 | if {$key == "g" || $key == "G"} {menu_findagain $topname} | ||
4553 | if {$key == "1"} {menu_object $topname 1} | ||
4554 | if {$key == "2"} {menu_message $topname 1} | ||
4555 | if {$key == "3"} {menu_floatatom $topname 1} | ||
4556 | if {$key == "4"} {menu_symbolatom $topname 1} | ||
4557 | if {$key == "5"} {menu_comment $topname 1} | ||
4558 | if {$key == "slash"} {menu_audio 1} | ||
4559 | if {$key == "period"} {menu_audio 0} | ||
4560 | if {$key == "e" || $key == "E"} {menu_editmode $topname} | ||
4561 | } | ||
4562 | |||
4563 | proc pdtk_canvas_motion {name x y mods} { | ||
4564 | # puts stderr [concat [canvastosym $name] $name $x $y] | ||
4565 | pd [canvastosym $name] motion [$name canvasx $x] [$name canvasy $y] $mods \; | ||
4566 | } | ||
4567 | |||
4568 | # "map" event tells us when the canvas becomes visible (arg is "0") or | ||
4569 | # invisible (arg is ""). Invisibility means the Window Manager has minimized | ||
4570 | # us. We don't get a final "unmap" event when we destroy the window. | ||
4571 | proc pdtk_canvas_map {name} { | ||
4572 | # puts stderr [concat map $name] | ||
4573 | pd [canvastosym $name] map 1 \; | ||
4574 | } | ||
4575 | |||
4576 | proc pdtk_canvas_unmap {name} { | ||
4577 | # puts stderr [concat unmap $name] | ||
4578 | pd [canvastosym $name] map 0 \; | ||
4579 | } | ||
4580 | |||
4581 | set saveas_dir nowhere | ||
4582 | |||
4583 | ############ pdtk_canvas_saveas -- run a saveas dialog ############## | ||
4584 | |||
4585 | proc pdtk_canvas_saveas {name initfile initdir} { | ||
4586 | set filename [tk_getSaveFile -initialfile $initfile \ | ||
4587 | -initialdir $initdir -defaultextension .pd \ | ||
4588 | -filetypes { {{pd files} {.pd}} {{max files} {.pat}} }] | ||
4589 | |||
4590 | if {$filename != ""} { | ||
4591 | set directory [string range $filename 0 \ | ||
4592 | [expr [string last / $filename ] - 1]] | ||
4593 | set basename [string range $filename \ | ||
4594 | [expr [string last / $filename ] + 1] end] | ||
4595 | pd [concat $name savetofile [pdtk_enquote $basename] \ | ||
4596 | [pdtk_enquote $directory] \;] | ||
4597 | # pd [concat $name savetofile $basename $directory \;] | ||
4598 | } | ||
4599 | } | ||
4600 | |||
4601 | ############ pdtk_canvas_dofont -- run a font and resize dialog ######### | ||
4602 | |||
4603 | set fontsize 0 | ||
4604 | set stretchval 0 | ||
4605 | set whichstretch 0 | ||
4606 | |||
4607 | proc dofont_apply {name} { | ||
4608 | global fontsize | ||
4609 | global stretchval | ||
4610 | global whichstretch | ||
4611 | set cmd [concat $name font $fontsize $stretchval $whichstretch \;] | ||
4612 | # puts stderr $cmd | ||
4613 | pd $cmd | ||
4614 | } | ||
4615 | |||
4616 | proc dofont_cancel {name} { | ||
4617 | set cmd [concat $name cancel \;] | ||
4618 | # puts stderr $cmd | ||
4619 | pd $cmd | ||
4620 | } | ||
4621 | |||
4622 | proc pdtk_canvas_dofont {name initsize} { | ||
4623 | |||
4624 | global fontsize | ||
4625 | set fontsize $initsize | ||
4626 | |||
4627 | global stretchval | ||
4628 | set stretchval 100 | ||
4629 | |||
4630 | global whichstretch | ||
4631 | set whichstretch 1 | ||
4632 | |||
4633 | toplevel $name | ||
4634 | wm title $name {FONT BOMB} | ||
4635 | wm protocol $name WM_DELETE_WINDOW [concat dofont_cancel $name] | ||
4636 | |||
4637 | frame $name.buttonframe | ||
4638 | pack $name.buttonframe -side bottom -fill x -pady 2m | ||
4639 | button $name.buttonframe.cancel -text {Cancel}\ | ||
4640 | -command "dofont_cancel $name" | ||
4641 | button $name.buttonframe.ok -text {Do it}\ | ||
4642 | -command "dofont_apply $name" | ||
4643 | pack $name.buttonframe.cancel -side left -expand 1 | ||
4644 | pack $name.buttonframe.ok -side left -expand 1 | ||
4645 | |||
4646 | frame $name.radiof | ||
4647 | pack $name.radiof -side left | ||
4648 | |||
4649 | label $name.radiof.label -text {Font Size:} | ||
4650 | pack $name.radiof.label -side top | ||
4651 | |||
4652 | radiobutton $name.radiof.radio8 -value 8 -variable fontsize -text "8" | ||
4653 | radiobutton $name.radiof.radio10 -value 10 -variable fontsize -text "10" | ||
4654 | radiobutton $name.radiof.radio12 -value 12 -variable fontsize -text "12" | ||
4655 | radiobutton $name.radiof.radio16 -value 16 -variable fontsize -text "16" | ||
4656 | radiobutton $name.radiof.radio24 -value 24 -variable fontsize -text "24" | ||
4657 | radiobutton $name.radiof.radio36 -value 36 -variable fontsize -text "36" | ||
4658 | pack $name.radiof.radio8 -side top -anchor w | ||
4659 | pack $name.radiof.radio10 -side top -anchor w | ||
4660 | pack $name.radiof.radio12 -side top -anchor w | ||
4661 | pack $name.radiof.radio16 -side top -anchor w | ||
4662 | pack $name.radiof.radio24 -side top -anchor w | ||
4663 | pack $name.radiof.radio36 -side top -anchor w | ||
4664 | |||
4665 | frame $name.stretchf | ||
4666 | pack $name.stretchf -side left | ||
4667 | |||
4668 | label $name.stretchf.label -text {Stretch:} | ||
4669 | pack $name.stretchf.label -side top | ||
4670 | |||
4671 | entry $name.stretchf.entry -textvariable stretchval -width 5 | ||
4672 | pack $name.stretchf.entry -side left | ||
4673 | |||
4674 | radiobutton $name.stretchf.radio1 \ | ||
4675 | -value 1 -variable whichstretch -text "X and Y" | ||
4676 | radiobutton $name.stretchf.radio2 \ | ||
4677 | -value 2 -variable whichstretch -text "X only" | ||
4678 | radiobutton $name.stretchf.radio3 \ | ||
4679 | -value 3 -variable whichstretch -text "Y only" | ||
4680 | |||
4681 | pack $name.stretchf.radio1 -side top -anchor w | ||
4682 | pack $name.stretchf.radio2 -side top -anchor w | ||
4683 | pack $name.stretchf.radio3 -side top -anchor w | ||
4684 | |||
4685 | } | ||
4686 | |||
4687 | ############ pdtk_gatom_dialog -- run a gatom dialog ######### | ||
4688 | |||
4689 | # see graph_apply, etc., for comments about handling variable names here... | ||
4690 | |||
4691 | proc gatom_escape {sym} { | ||
4692 | if {[string length $sym] == 0} { | ||
4693 | set ret "-" | ||
4694 | # puts stderr [concat escape1 $sym $ret] | ||
4695 | } else { | ||
4696 | if {[string equal -length 1 $sym "-"]} { | ||
4697 | set ret [string replace $sym 0 0 "--"] | ||
4698 | # puts stderr [concat escape $sym $ret] | ||
4699 | } else { | ||
4700 | if {[string equal -length 1 $sym "$"]} { | ||
4701 | set ret [string replace $sym 0 0 "#"] | ||
4702 | # puts stderr [concat unescape $sym $ret] | ||
4703 | } else { | ||
4704 | set ret $sym | ||
4705 | # puts stderr [concat escape $sym "no change"] | ||
4706 | } | ||
4707 | } | ||
4708 | } | ||
4709 | concat $ret | ||
4710 | } | ||
4711 | |||
4712 | proc gatom_unescape {sym} { | ||
4713 | if {[string equal -length 1 $sym "-"]} { | ||
4714 | set ret [string replace $sym 0 0 ""] | ||
4715 | # puts stderr [concat unescape $sym $ret] | ||
4716 | } else { | ||
4717 | if {[string equal -length 1 $sym "#"]} { | ||
4718 | set ret [string replace $sym 0 0 "$"] | ||
4719 | # puts stderr [concat unescape $sym $ret] | ||
4720 | } else { | ||
4721 | set ret $sym | ||
4722 | # puts stderr [concat unescape $sym "no change"] | ||
4723 | } | ||
4724 | } | ||
4725 | concat $ret | ||
4726 | } | ||
4727 | |||
4728 | proc dogatom_apply {id} { | ||
4729 | set vid [string trimleft $id .] | ||
4730 | |||
4731 | set var_gatomwidth [concat gatomwidth_$vid] | ||
4732 | global $var_gatomwidth | ||
4733 | set var_gatomlo [concat gatomlo_$vid] | ||
4734 | global $var_gatomlo | ||
4735 | set var_gatomhi [concat gatomhi_$vid] | ||
4736 | global $var_gatomhi | ||
4737 | set var_gatomwherelabel [concat gatomwherelabel_$vid] | ||
4738 | global $var_gatomwherelabel | ||
4739 | set var_gatomlabel [concat gatomlabel_$vid] | ||
4740 | global $var_gatomlabel | ||
4741 | set var_gatomsymfrom [concat gatomsymfrom_$vid] | ||
4742 | global $var_gatomsymfrom | ||
4743 | set var_gatomsymto [concat gatomsymto_$vid] | ||
4744 | global $var_gatomsymto | ||
4745 | |||
4746 | # set cmd [concat $id param $gatomwidth $gatomlo $gatomhi \;] | ||
4747 | |||
4748 | set cmd [concat $id param \ | ||
4749 | [eval concat $$var_gatomwidth] \ | ||
4750 | [eval concat $$var_gatomlo] \ | ||
4751 | [eval concat $$var_gatomhi] \ | ||
4752 | [eval gatom_escape $$var_gatomlabel] \ | ||
4753 | [eval concat $$var_gatomwherelabel] \ | ||
4754 | [eval gatom_escape $$var_gatomsymfrom] \ | ||
4755 | [eval gatom_escape $$var_gatomsymto] \ | ||
4756 | \;] | ||
4757 | |||
4758 | # puts stderr $cmd | ||
4759 | pd $cmd | ||
4760 | } | ||
4761 | |||
4762 | proc dogatom_cancel {name} { | ||
4763 | set cmd [concat $name cancel \;] | ||
4764 | # puts stderr $cmd | ||
4765 | pd $cmd | ||
4766 | } | ||
4767 | |||
4768 | proc dogatom_ok {name} { | ||
4769 | dogatom_apply $name | ||
4770 | dogatom_cancel $name | ||
4771 | } | ||
4772 | |||
4773 | proc pdtk_gatom_dialog {id initwidth initlo inithi \ | ||
4774 | wherelabel label symfrom symto} { | ||
4775 | |||
4776 | set vid [string trimleft $id .] | ||
4777 | |||
4778 | set var_gatomwidth [concat gatomwidth_$vid] | ||
4779 | global $var_gatomwidth | ||
4780 | set var_gatomlo [concat gatomlo_$vid] | ||
4781 | global $var_gatomlo | ||
4782 | set var_gatomhi [concat gatomhi_$vid] | ||
4783 | global $var_gatomhi | ||
4784 | set var_gatomwherelabel [concat gatomwherelabel_$vid] | ||
4785 | global $var_gatomwherelabel | ||
4786 | set var_gatomlabel [concat gatomlabel_$vid] | ||
4787 | global $var_gatomlabel | ||
4788 | set var_gatomsymfrom [concat gatomsymfrom_$vid] | ||
4789 | global $var_gatomsymfrom | ||
4790 | set var_gatomsymto [concat gatomsymto_$vid] | ||
4791 | global $var_gatomsymto | ||
4792 | |||
4793 | set $var_gatomwidth $initwidth | ||
4794 | set $var_gatomlo $initlo | ||
4795 | set $var_gatomhi $inithi | ||
4796 | set $var_gatomwherelabel $wherelabel | ||
4797 | set $var_gatomlabel [gatom_unescape $label] | ||
4798 | set $var_gatomsymfrom [gatom_unescape $symfrom] | ||
4799 | set $var_gatomsymto [gatom_unescape $symto] | ||
4800 | |||
4801 | toplevel $id | ||
4802 | wm title $id {Atom} | ||
4803 | wm protocol $id WM_DELETE_WINDOW [concat dogatom_cancel $id] | ||
4804 | |||
4805 | frame $id.buttonframe | ||
4806 | pack $id.buttonframe -side bottom -fill x -pady 2m | ||
4807 | button $id.buttonframe.cancel -text {Cancel}\ | ||
4808 | -command "dogatom_cancel $id" | ||
4809 | button $id.buttonframe.apply -text {Apply}\ | ||
4810 | -command "dogatom_apply $id" | ||
4811 | button $id.buttonframe.ok -text {OK}\ | ||
4812 | -command "dogatom_ok $id" | ||
4813 | pack $id.buttonframe.cancel -side left -expand 1 | ||
4814 | pack $id.buttonframe.apply -side left -expand 1 | ||
4815 | pack $id.buttonframe.ok -side left -expand 1 | ||
4816 | |||
4817 | frame $id.paramsymto | ||
4818 | pack $id.paramsymto -side bottom | ||
4819 | label $id.paramsymto.entryname -text {send symbol} | ||
4820 | entry $id.paramsymto.entry -textvariable $var_gatomsymto -width 20 | ||
4821 | pack $id.paramsymto.entryname $id.paramsymto.entry -side left | ||
4822 | |||
4823 | frame $id.paramsymfrom | ||
4824 | pack $id.paramsymfrom -side bottom | ||
4825 | label $id.paramsymfrom.entryname -text {receive symbol} | ||
4826 | entry $id.paramsymfrom.entry -textvariable $var_gatomsymfrom -width 20 | ||
4827 | pack $id.paramsymfrom.entryname $id.paramsymfrom.entry -side left | ||
4828 | |||
4829 | frame $id.radio | ||
4830 | pack $id.radio -side bottom | ||
4831 | label $id.radio.label -text {show label on:} | ||
4832 | frame $id.radio.l | ||
4833 | frame $id.radio.r | ||
4834 | pack $id.radio.label -side top | ||
4835 | pack $id.radio.l $id.radio.r -side left | ||
4836 | radiobutton $id.radio.l.radio0 -value 0 \ | ||
4837 | -variable $var_gatomwherelabel \ | ||
4838 | -text "left" | ||
4839 | radiobutton $id.radio.l.radio1 -value 1 \ | ||
4840 | -variable $var_gatomwherelabel \ | ||
4841 | -text "right" | ||
4842 | radiobutton $id.radio.r.radio2 -value 2 \ | ||
4843 | -variable $var_gatomwherelabel \ | ||
4844 | -text "top" | ||
4845 | radiobutton $id.radio.r.radio3 -value 3 \ | ||
4846 | -variable $var_gatomwherelabel \ | ||
4847 | -text "bottom" | ||
4848 | pack $id.radio.l.radio0 $id.radio.l.radio1 -side top -anchor w | ||
4849 | pack $id.radio.r.radio2 $id.radio.r.radio3 -side top -anchor w | ||
4850 | |||
4851 | |||
4852 | frame $id.paramlabel | ||
4853 | pack $id.paramlabel -side bottom | ||
4854 | label $id.paramlabel.entryname -text label | ||
4855 | entry $id.paramlabel.entry -textvariable $var_gatomlabel -width 20 | ||
4856 | pack $id.paramlabel.entryname $id.paramlabel.entry -side left | ||
4857 | |||
4858 | frame $id.paramhi | ||
4859 | pack $id.paramhi -side bottom | ||
4860 | label $id.paramhi.entryname -text "upper limit" | ||
4861 | entry $id.paramhi.entry -textvariable $var_gatomhi -width 8 | ||
4862 | pack $id.paramhi.entryname $id.paramhi.entry -side left | ||
4863 | |||
4864 | frame $id.paramlo | ||
4865 | pack $id.paramlo -side bottom | ||
4866 | label $id.paramlo.entryname -text "lower limit" | ||
4867 | entry $id.paramlo.entry -textvariable $var_gatomlo -width 8 | ||
4868 | pack $id.paramlo.entryname $id.paramlo.entry -side left | ||
4869 | |||
4870 | frame $id.params | ||
4871 | pack $id.params -side bottom | ||
4872 | label $id.params.entryname -text width | ||
4873 | entry $id.params.entry -textvariable $var_gatomwidth -width 4 | ||
4874 | pack $id.params.entryname $id.params.entry -side left | ||
4875 | |||
4876 | |||
4877 | |||
4878 | bind $id.paramhi.entry <KeyPress-Return> [concat dogatom_ok $id] | ||
4879 | bind $id.paramlo.entry <KeyPress-Return> [concat dogatom_ok $id] | ||
4880 | bind $id.params.entry <KeyPress-Return> [concat dogatom_ok $id] | ||
4881 | $id.params.entry select from 0 | ||
4882 | $id.params.entry select adjust end | ||
4883 | focus $id.params.entry | ||
4884 | } | ||
4885 | |||
4886 | ############ pdtk_canvas_popup -- popup menu for canvas ######### | ||
4887 | |||
4888 | set popup_xpix 0 | ||
4889 | set popup_ypix 0 | ||
4890 | |||
4891 | proc popup_action {name action} { | ||
4892 | global popup_xpix popup_ypix | ||
4893 | set cmd [concat $name done-popup $action $popup_xpix $popup_ypix \;] | ||
4894 | # puts stderr $cmd | ||
4895 | pd $cmd | ||
4896 | } | ||
4897 | |||
4898 | proc pdtk_canvas_popup {name xpix ypix canprop canopen} { | ||
4899 | global popup_xpix popup_ypix | ||
4900 | set popup_xpix $xpix | ||
4901 | set popup_ypix $ypix | ||
4902 | if {$canprop == 0} {$name.popup entryconfigure 0 -state disabled} | ||
4903 | if {$canprop == 1} {$name.popup entryconfigure 0 -state active} | ||
4904 | if {$canopen == 0} {$name.popup entryconfigure 1 -state disabled} | ||
4905 | if {$canopen == 1} {$name.popup entryconfigure 1 -state active} | ||
4906 | tk_popup $name.popup [expr $xpix + [winfo rootx $name.c]] \ | ||
4907 | [expr $ypix + [winfo rooty $name.c]] 0 | ||
4908 | } | ||
4909 | |||
4910 | ############ pdtk_graph_dialog -- dialog window for graphs ######### | ||
4911 | |||
4912 | # the graph and array dialogs can come up in many copies; but in TK the easiest | ||
4913 | # way to get data from an "entry", etc., is to set an associated variable | ||
4914 | # name. This is especially true for grouped "radio buttons". So we have | ||
4915 | # to synthesize variable names for each instance of the dialog. The dialog | ||
4916 | # gets a TK pathname $id, from which it strips the leading "." to make a | ||
4917 | # variable suffix $vid. Then you can get the actual value out by asking for | ||
4918 | # [eval concat $$variablename]. There should be an easier way but I don't see | ||
4919 | # it yet. | ||
4920 | |||
4921 | proc graph_apply {id} { | ||
4922 | # strip "." from the TK id to make a variable name suffix | ||
4923 | set vid [string trimleft $id .] | ||
4924 | # for each variable, make a local variable to hold its name... | ||
4925 | set var_graph_x1 [concat graph_x1_$vid] | ||
4926 | global $var_graph_x1 | ||
4927 | set var_graph_x2 [concat graph_x2_$vid] | ||
4928 | global $var_graph_x2 | ||
4929 | set var_graph_xpix [concat graph_xpix_$vid] | ||
4930 | global $var_graph_xpix | ||
4931 | set var_graph_y1 [concat graph_y1_$vid] | ||
4932 | global $var_graph_y1 | ||
4933 | set var_graph_y2 [concat graph_y2_$vid] | ||
4934 | global $var_graph_y2 | ||
4935 | set var_graph_ypix [concat graph_ypix_$vid] | ||
4936 | global $var_graph_ypix | ||
4937 | |||
4938 | pd [concat $id dialog \ | ||
4939 | [eval concat $$var_graph_x1] \ | ||
4940 | [eval concat $$var_graph_y1] \ | ||
4941 | [eval concat $$var_graph_x2] \ | ||
4942 | [eval concat $$var_graph_y2] \ | ||
4943 | [eval concat $$var_graph_xpix] \ | ||
4944 | [eval concat $$var_graph_ypix] \ | ||
4945 | \;] | ||
4946 | } | ||
4947 | |||
4948 | proc graph_cancel {id} { | ||
4949 | set cmd [concat $id cancel \;] | ||
4950 | # puts stderr $cmd | ||
4951 | pd $cmd | ||
4952 | } | ||
4953 | |||
4954 | proc graph_ok {id} { | ||
4955 | graph_apply $id | ||
4956 | graph_cancel $id | ||
4957 | } | ||
4958 | |||
4959 | proc pdtk_graph_dialog {id x1 y1 x2 y2 xpix ypix} { | ||
4960 | set vid [string trimleft $id .] | ||
4961 | set var_graph_x1 [concat graph_x1_$vid] | ||
4962 | global $var_graph_x1 | ||
4963 | set var_graph_x2 [concat graph_x2_$vid] | ||
4964 | global $var_graph_x2 | ||
4965 | set var_graph_xpix [concat graph_xpix_$vid] | ||
4966 | global $var_graph_xpix | ||
4967 | set var_graph_y1 [concat graph_y1_$vid] | ||
4968 | global $var_graph_y1 | ||
4969 | set var_graph_y2 [concat graph_y2_$vid] | ||
4970 | global $var_graph_y2 | ||
4971 | set var_graph_ypix [concat graph_ypix_$vid] | ||
4972 | global $var_graph_ypix | ||
4973 | |||
4974 | set $var_graph_x1 $x1 | ||
4975 | set $var_graph_x2 $x2 | ||
4976 | set $var_graph_xpix $xpix | ||
4977 | set $var_graph_y1 $y1 | ||
4978 | set $var_graph_y2 $y2 | ||
4979 | set $var_graph_ypix $ypix | ||
4980 | |||
4981 | toplevel $id | ||
4982 | wm title $id {graph} | ||
4983 | wm protocol $id WM_DELETE_WINDOW [concat graph_cancel $id] | ||
4984 | |||
4985 | label $id.label -text {GRAPH BOUNDS} | ||
4986 | pack $id.label -side top | ||
4987 | |||
4988 | frame $id.buttonframe | ||
4989 | pack $id.buttonframe -side bottom -fill x -pady 2m | ||
4990 | button $id.buttonframe.cancel -text {Cancel}\ | ||
4991 | -command "graph_cancel $id" | ||
4992 | button $id.buttonframe.apply -text {Apply}\ | ||
4993 | -command "graph_apply $id" | ||
4994 | button $id.buttonframe.ok -text {OK}\ | ||
4995 | -command "graph_ok $id" | ||
4996 | pack $id.buttonframe.cancel -side left -expand 1 | ||
4997 | pack $id.buttonframe.apply -side left -expand 1 | ||
4998 | pack $id.buttonframe.ok -side left -expand 1 | ||
4999 | |||
5000 | frame $id.xrangef | ||
5001 | pack $id.xrangef -side top | ||
5002 | |||
5003 | label $id.xrangef.l1 -text "X from:" | ||
5004 | entry $id.xrangef.x1 -textvariable $var_graph_x1 -width 7 | ||
5005 | label $id.xrangef.l2 -text "to:" | ||
5006 | entry $id.xrangef.x2 -textvariable $var_graph_x2 -width 7 | ||
5007 | label $id.xrangef.l3 -text "screen width:" | ||
5008 | entry $id.xrangef.xpix -textvariable $var_graph_xpix -width 7 | ||
5009 | pack $id.xrangef.l1 $id.xrangef.x1 \ | ||
5010 | $id.xrangef.l2 $id.xrangef.x2 \ | ||
5011 | $id.xrangef.l3 $id.xrangef.xpix -side left | ||
5012 | |||
5013 | frame $id.yrangef | ||
5014 | pack $id.yrangef -side top | ||
5015 | |||
5016 | # dig in the following that the upper bound is labeled y1 but the variable is | ||
5017 | # y2, etc. This is to deal with the inconsistent use of "upper and lower" | ||
5018 | # graph bounds... in the dialog the upper Y bound is the lower valued Y pixel. | ||
5019 | label $id.yrangef.l1 -text "Y from:" | ||
5020 | entry $id.yrangef.y1 -textvariable $var_graph_y2 -width 7 | ||
5021 | label $id.yrangef.l2 -text "to:" | ||
5022 | entry $id.yrangef.y2 -textvariable $var_graph_y1 -width 7 | ||
5023 | label $id.yrangef.l3 -text "screen height:" | ||
5024 | entry $id.yrangef.ypix -textvariable $var_graph_ypix -width 7 | ||
5025 | pack $id.yrangef.l1 $id.yrangef.y1 \ | ||
5026 | $id.yrangef.l2 $id.yrangef.y2 \ | ||
5027 | $id.yrangef.l3 $id.yrangef.ypix -side left | ||
5028 | |||
5029 | bind $id.xrangef.x1 <KeyPress-Return> [concat graph_ok $id] | ||
5030 | bind $id.xrangef.x2 <KeyPress-Return> [concat graph_ok $id] | ||
5031 | bind $id.xrangef.xpix <KeyPress-Return> [concat graph_ok $id] | ||
5032 | bind $id.yrangef.y1 <KeyPress-Return> [concat graph_ok $id] | ||
5033 | bind $id.yrangef.y2 <KeyPress-Return> [concat graph_ok $id] | ||
5034 | bind $id.yrangef.ypix <KeyPress-Return> [concat graph_ok $id] | ||
5035 | $id.xrangef.x2 select from 0 | ||
5036 | $id.xrangef.x2 select adjust end | ||
5037 | focus $id.xrangef.x2 | ||
5038 | } | ||
5039 | |||
5040 | # begin of change "iemlib" | ||
5041 | ############ pdtk_iemgui_dialog -- dialog window for iem guis ######### | ||
5042 | |||
5043 | set iemgui_define_min_flashhold 50 | ||
5044 | set iemgui_define_min_flashbreak 10 | ||
5045 | set iemgui_define_min_fontsize 4 | ||
5046 | |||
5047 | proc iemgui_clip_dim {id} { | ||
5048 | set vid [string trimleft $id .] | ||
5049 | |||
5050 | set var_iemgui_wdt [concat iemgui_wdt_$vid] | ||
5051 | global $var_iemgui_wdt | ||
5052 | set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid] | ||
5053 | global $var_iemgui_min_wdt | ||
5054 | set var_iemgui_hgt [concat iemgui_hgt_$vid] | ||
5055 | global $var_iemgui_hgt | ||
5056 | set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid] | ||
5057 | global $var_iemgui_min_hgt | ||
5058 | |||
5059 | if {[eval concat $$var_iemgui_wdt] < [eval concat $$var_iemgui_min_wdt]} { | ||
5060 | set $var_iemgui_wdt [eval concat $$var_iemgui_min_wdt] | ||
5061 | $id.dim.w_ent configure -textvariable $var_iemgui_wdt | ||
5062 | } | ||
5063 | if {[eval concat $$var_iemgui_hgt] < [eval concat $$var_iemgui_min_hgt]} { | ||
5064 | set $var_iemgui_hgt [eval concat $$var_iemgui_min_hgt] | ||
5065 | $id.dim.h_ent configure -textvariable $var_iemgui_hgt | ||
5066 | } | ||
5067 | } | ||
5068 | |||
5069 | proc iemgui_clip_num {id} { | ||
5070 | set vid [string trimleft $id .] | ||
5071 | |||
5072 | set var_iemgui_num [concat iemgui_num_$vid] | ||
5073 | global $var_iemgui_num | ||
5074 | |||
5075 | if {[eval concat $$var_iemgui_num] > 2000} { | ||
5076 | set $var_iemgui_num 2000 | ||
5077 | $id.para.num_ent configure -textvariable $var_iemgui_num | ||
5078 | } | ||
5079 | if {[eval concat $$var_iemgui_num] < 1} { | ||
5080 | set $var_iemgui_num 1 | ||
5081 | $id.para.num_ent configure -textvariable $var_iemgui_num | ||
5082 | } | ||
5083 | } | ||
5084 | |||
5085 | proc iemgui_sched_rng {id} { | ||
5086 | set vid [string trimleft $id .] | ||
5087 | |||
5088 | set var_iemgui_min_rng [concat iemgui_min_rng_$vid] | ||
5089 | global $var_iemgui_min_rng | ||
5090 | set var_iemgui_max_rng [concat iemgui_max_rng_$vid] | ||
5091 | global $var_iemgui_max_rng | ||
5092 | set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid] | ||
5093 | global $var_iemgui_rng_sch | ||
5094 | |||
5095 | global iemgui_define_min_flashhold | ||
5096 | global iemgui_define_min_flashbreak | ||
5097 | |||
5098 | if {[eval concat $$var_iemgui_rng_sch] == 2} { | ||
5099 | if {[eval concat $$var_iemgui_max_rng] < [eval concat $$var_iemgui_min_rng]} { | ||
5100 | set hhh [eval concat $$var_iemgui_min_rng] | ||
5101 | set $var_iemgui_min_rng [eval concat $$var_iemgui_max_rng] | ||
5102 | set $var_iemgui_max_rng $hhh | ||
5103 | $id.rng.max_ent configure -textvariable $var_iemgui_max_rng | ||
5104 | $id.rng.min_ent configure -textvariable $var_iemgui_min_rng } | ||
5105 | if {[eval concat $$var_iemgui_max_rng] < $iemgui_define_min_flashhold} { | ||
5106 | set $var_iemgui_max_rng $iemgui_define_min_flashhold | ||
5107 | $id.rng.max_ent configure -textvariable $var_iemgui_max_rng | ||
5108 | } | ||
5109 | if {[eval concat $$var_iemgui_min_rng] < $iemgui_define_min_flashbreak} { | ||
5110 | set $var_iemgui_min_rng $iemgui_define_min_flashbreak | ||
5111 | $id.rng.min_ent configure -textvariable $var_iemgui_min_rng | ||
5112 | } | ||
5113 | } | ||
5114 | if {[eval concat $$var_iemgui_rng_sch] == 1} { | ||
5115 | if {[eval concat $$var_iemgui_min_rng] == 0.0} { | ||
5116 | set $var_iemgui_min_rng 1.0 | ||
5117 | $id.rng.min_ent configure -textvariable $var_iemgui_min_rng | ||
5118 | } | ||
5119 | } | ||
5120 | } | ||
5121 | |||
5122 | proc iemgui_verify_rng {id} { | ||
5123 | set vid [string trimleft $id .] | ||
5124 | |||
5125 | set var_iemgui_min_rng [concat iemgui_min_rng_$vid] | ||
5126 | global $var_iemgui_min_rng | ||
5127 | set var_iemgui_max_rng [concat iemgui_max_rng_$vid] | ||
5128 | global $var_iemgui_max_rng | ||
5129 | set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] | ||
5130 | global $var_iemgui_lin0_log1 | ||
5131 | |||
5132 | if {[eval concat $$var_iemgui_lin0_log1] == 1} { | ||
5133 | if {[eval concat $$var_iemgui_max_rng] == 0.0 && [eval concat $$var_iemgui_min_rng] == 0.0} { | ||
5134 | set $var_iemgui_max_rng 1.0 | ||
5135 | $id.rng.max_ent configure -textvariable $var_iemgui_max_rng | ||
5136 | } | ||
5137 | if {[eval concat $$var_iemgui_max_rng] > 0} { | ||
5138 | if {[eval concat $$var_iemgui_min_rng] <= 0} { | ||
5139 | set $var_iemgui_min_rng [expr [eval concat $$var_iemgui_max_rng] * 0.01] | ||
5140 | $id.rng.min_ent configure -textvariable $var_iemgui_min_rng | ||
5141 | } | ||
5142 | } else { | ||
5143 | if {[eval concat $$var_iemgui_min_rng] > 0} { | ||
5144 | set $var_iemgui_max_rng [expr [eval concat $$var_iemgui_min_rng] * 0.01] | ||
5145 | $id.rng.max_ent configure -textvariable $var_iemgui_max_rng | ||
5146 | } | ||
5147 | } | ||
5148 | } | ||
5149 | } | ||
5150 | |||
5151 | proc iemgui_clip_fontsize {id} { | ||
5152 | set vid [string trimleft $id .] | ||
5153 | |||
5154 | set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid] | ||
5155 | global $var_iemgui_gn_fs | ||
5156 | |||
5157 | global iemgui_define_min_fontsize | ||
5158 | |||
5159 | if {[eval concat $$var_iemgui_gn_fs] < $iemgui_define_min_fontsize} { | ||
5160 | set $var_iemgui_gn_fs $iemgui_define_min_fontsize | ||
5161 | $id.gnfs.fs_ent configure -textvariable $var_iemgui_gn_fs | ||
5162 | } | ||
5163 | } | ||
5164 | |||
5165 | proc iemgui_set_col_example {id} { | ||
5166 | set vid [string trimleft $id .] | ||
5167 | |||
5168 | set var_iemgui_bcol [concat iemgui_bcol_$vid] | ||
5169 | global $var_iemgui_bcol | ||
5170 | set var_iemgui_fcol [concat iemgui_fcol_$vid] | ||
5171 | global $var_iemgui_fcol | ||
5172 | set var_iemgui_lcol [concat iemgui_lcol_$vid] | ||
5173 | global $var_iemgui_lcol | ||
5174 | |||
5175 | $id.col_example_choose.lb_bk configure \ | ||
5176 | -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
5177 | -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
5178 | -foreground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \ | ||
5179 | -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] | ||
5180 | |||
5181 | if { [eval concat $$var_iemgui_fcol] >= 0 } { | ||
5182 | $id.col_example_choose.fr_bk configure \ | ||
5183 | -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
5184 | -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
5185 | -foreground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \ | ||
5186 | -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] | ||
5187 | } else { | ||
5188 | $id.col_example_choose.fr_bk configure \ | ||
5189 | -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
5190 | -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
5191 | -foreground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
5192 | -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]]} | ||
5193 | } | ||
5194 | |||
5195 | proc iemgui_preset_col {id presetcol} { | ||
5196 | set vid [string trimleft $id .] | ||
5197 | |||
5198 | set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid] | ||
5199 | global $var_iemgui_l2_f1_b0 | ||
5200 | set var_iemgui_bcol [concat iemgui_bcol_$vid] | ||
5201 | global $var_iemgui_bcol | ||
5202 | set var_iemgui_fcol [concat iemgui_fcol_$vid] | ||
5203 | global $var_iemgui_fcol | ||
5204 | set var_iemgui_lcol [concat iemgui_lcol_$vid] | ||
5205 | global $var_iemgui_lcol | ||
5206 | |||
5207 | if { [eval concat $$var_iemgui_l2_f1_b0] == 0 } { set $var_iemgui_bcol $presetcol } | ||
5208 | if { [eval concat $$var_iemgui_l2_f1_b0] == 1 } { set $var_iemgui_fcol $presetcol } | ||
5209 | if { [eval concat $$var_iemgui_l2_f1_b0] == 2 } { set $var_iemgui_lcol $presetcol } | ||
5210 | iemgui_set_col_example $id | ||
5211 | } | ||
5212 | |||
5213 | proc iemgui_choose_col_bkfrlb {id} { | ||
5214 | set vid [string trimleft $id .] | ||
5215 | |||
5216 | set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid] | ||
5217 | global $var_iemgui_l2_f1_b0 | ||
5218 | set var_iemgui_bcol [concat iemgui_bcol_$vid] | ||
5219 | global $var_iemgui_bcol | ||
5220 | set var_iemgui_fcol [concat iemgui_fcol_$vid] | ||
5221 | global $var_iemgui_fcol | ||
5222 | set var_iemgui_lcol [concat iemgui_lcol_$vid] | ||
5223 | global $var_iemgui_lcol | ||
5224 | |||
5225 | if {[eval concat $$var_iemgui_l2_f1_b0] == 0} { | ||
5226 | set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC] | ||
5227 | set helpstring [tk_chooseColor -title "Background-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_bcol]]] | ||
5228 | if { $helpstring != "" } { | ||
5229 | set $var_iemgui_bcol [string replace $helpstring 0 0 "0x"] | ||
5230 | set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC] } | ||
5231 | } | ||
5232 | if {[eval concat $$var_iemgui_l2_f1_b0] == 1} { | ||
5233 | set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC] | ||
5234 | set helpstring [tk_chooseColor -title "Front-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_fcol]]] | ||
5235 | if { $helpstring != "" } { | ||
5236 | set $var_iemgui_fcol [string replace $helpstring 0 0 "0x"] | ||
5237 | set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC] } | ||
5238 | } | ||
5239 | if {[eval concat $$var_iemgui_l2_f1_b0] == 2} { | ||
5240 | set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC] | ||
5241 | set helpstring [tk_chooseColor -title "Label-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_lcol]]] | ||
5242 | if { $helpstring != "" } { | ||
5243 | set $var_iemgui_lcol [string replace $helpstring 0 0 "0x"] | ||
5244 | set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC] } | ||
5245 | } | ||
5246 | iemgui_set_col_example $id | ||
5247 | } | ||
5248 | |||
5249 | proc iemgui_lilo {id} { | ||
5250 | set vid [string trimleft $id .] | ||
5251 | |||
5252 | set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] | ||
5253 | global $var_iemgui_lin0_log1 | ||
5254 | set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] | ||
5255 | global $var_iemgui_lilo0 | ||
5256 | set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] | ||
5257 | global $var_iemgui_lilo1 | ||
5258 | |||
5259 | iemgui_sched_rng $id | ||
5260 | |||
5261 | if {[eval concat $$var_iemgui_lin0_log1] == 0} { | ||
5262 | set $var_iemgui_lin0_log1 1 | ||
5263 | $id.para.lilo configure -text [eval concat $$var_iemgui_lilo1] | ||
5264 | iemgui_verify_rng $id | ||
5265 | iemgui_sched_rng $id | ||
5266 | } else { | ||
5267 | set $var_iemgui_lin0_log1 0 | ||
5268 | $id.para.lilo configure -text [eval concat $$var_iemgui_lilo0] | ||
5269 | } | ||
5270 | } | ||
5271 | |||
5272 | proc iemgui_toggle_font {id} { | ||
5273 | set vid [string trimleft $id .] | ||
5274 | |||
5275 | set var_iemgui_gn_f [concat iemgui_gn_f_$vid] | ||
5276 | global $var_iemgui_gn_f | ||
5277 | |||
5278 | set $var_iemgui_gn_f [expr [eval concat $$var_iemgui_gn_f] + 1] | ||
5279 | if {[eval concat $$var_iemgui_gn_f] > 2} {set $var_iemgui_gn_f 0} | ||
5280 | if {[eval concat $$var_iemgui_gn_f] == 0} {$id.gnfs.fb configure -text "courier" -font {courier 10 bold}} | ||
5281 | if {[eval concat $$var_iemgui_gn_f] == 1} {$id.gnfs.fb configure -text "helvetica" -font {helvetica 10 bold}} | ||
5282 | if {[eval concat $$var_iemgui_gn_f] == 2} {$id.gnfs.fb configure -text "times" -font {times 10 bold}} | ||
5283 | } | ||
5284 | |||
5285 | proc iemgui_lb {id} { | ||
5286 | set vid [string trimleft $id .] | ||
5287 | |||
5288 | set var_iemgui_loadbang [concat iemgui_loadbang_$vid] | ||
5289 | global $var_iemgui_loadbang | ||
5290 | |||
5291 | if {[eval concat $$var_iemgui_loadbang] == 0} { | ||
5292 | set $var_iemgui_loadbang 1 | ||
5293 | $id.para.lb configure -text "init" | ||
5294 | } else { | ||
5295 | set $var_iemgui_loadbang 0 | ||
5296 | $id.para.lb configure -text "no init" | ||
5297 | } | ||
5298 | } | ||
5299 | |||
5300 | proc iemgui_stdy_jmp {id} { | ||
5301 | set vid [string trimleft $id .] | ||
5302 | |||
5303 | set var_iemgui_steady [concat iemgui_steady_$vid] | ||
5304 | global $var_iemgui_steady | ||
5305 | |||
5306 | if {[eval concat $$var_iemgui_steady]} { | ||
5307 | set $var_iemgui_steady 0 | ||
5308 | $id.para.stdy_jmp configure -text "jump on click" | ||
5309 | } else { | ||
5310 | set $var_iemgui_steady 1 | ||
5311 | $id.para.stdy_jmp configure -text "steady on click" | ||
5312 | } | ||
5313 | } | ||
5314 | |||
5315 | proc iemgui_apply {id} { | ||
5316 | set vid [string trimleft $id .] | ||
5317 | |||
5318 | set var_iemgui_wdt [concat iemgui_wdt_$vid] | ||
5319 | global $var_iemgui_wdt | ||
5320 | set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid] | ||
5321 | global $var_iemgui_min_wdt | ||
5322 | set var_iemgui_hgt [concat iemgui_hgt_$vid] | ||
5323 | global $var_iemgui_hgt | ||
5324 | set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid] | ||
5325 | global $var_iemgui_min_hgt | ||
5326 | set var_iemgui_min_rng [concat iemgui_min_rng_$vid] | ||
5327 | global $var_iemgui_min_rng | ||
5328 | set var_iemgui_max_rng [concat iemgui_max_rng_$vid] | ||
5329 | global $var_iemgui_max_rng | ||
5330 | set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] | ||
5331 | global $var_iemgui_lin0_log1 | ||
5332 | set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] | ||
5333 | global $var_iemgui_lilo0 | ||
5334 | set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] | ||
5335 | global $var_iemgui_lilo1 | ||
5336 | set var_iemgui_loadbang [concat iemgui_loadbang_$vid] | ||
5337 | global $var_iemgui_loadbang | ||
5338 | set var_iemgui_num [concat iemgui_num_$vid] | ||
5339 | global $var_iemgui_num | ||
5340 | set var_iemgui_steady [concat iemgui_steady_$vid] | ||
5341 | global $var_iemgui_steady | ||
5342 | set var_iemgui_snd [concat iemgui_snd_$vid] | ||
5343 | global $var_iemgui_snd | ||
5344 | set var_iemgui_rcv [concat iemgui_rcv_$vid] | ||
5345 | global $var_iemgui_rcv | ||
5346 | set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid] | ||
5347 | global $var_iemgui_gui_nam | ||
5348 | set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid] | ||
5349 | global $var_iemgui_gn_dx | ||
5350 | set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid] | ||
5351 | global $var_iemgui_gn_dy | ||
5352 | set var_iemgui_gn_f [concat iemgui_gn_f_$vid] | ||
5353 | global $var_iemgui_gn_f | ||
5354 | set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid] | ||
5355 | global $var_iemgui_gn_fs | ||
5356 | set var_iemgui_bcol [concat iemgui_bcol_$vid] | ||
5357 | global $var_iemgui_bcol | ||
5358 | set var_iemgui_fcol [concat iemgui_fcol_$vid] | ||
5359 | global $var_iemgui_fcol | ||
5360 | set var_iemgui_lcol [concat iemgui_lcol_$vid] | ||
5361 | global $var_iemgui_lcol | ||
5362 | |||
5363 | iemgui_clip_dim $id | ||
5364 | iemgui_clip_num $id | ||
5365 | iemgui_sched_rng $id | ||
5366 | iemgui_verify_rng $id | ||
5367 | iemgui_sched_rng $id | ||
5368 | iemgui_clip_fontsize $id | ||
5369 | |||
5370 | if {[eval concat $$var_iemgui_snd] == ""} {set hhhsnd "empty"} else {set hhhsnd [eval concat $$var_iemgui_snd]} | ||
5371 | if {[eval concat $$var_iemgui_rcv] == ""} {set hhhrcv "empty"} else {set hhhrcv [eval concat $$var_iemgui_rcv]} | ||
5372 | if {[eval concat $$var_iemgui_gui_nam] == ""} {set hhhgui_nam "empty" | ||
5373 | } else { | ||
5374 | set hhhgui_nam [eval concat $$var_iemgui_gui_nam]} | ||
5375 | |||
5376 | if {[string index $hhhsnd 0] == "$"} { | ||
5377 | set hhhsnd [string replace $hhhsnd 0 0 #] } | ||
5378 | if {[string index $hhhrcv 0] == "$"} { | ||
5379 | set hhhrcv [string replace $hhhrcv 0 0 #] } | ||
5380 | if {[string index $hhhgui_nam 0] == "$"} { | ||
5381 | set hhhgui_nam [string replace $hhhgui_nam 0 0 #] } | ||
5382 | |||
5383 | set hhhsnd [string map {" " _} $hhhsnd] | ||
5384 | set hhhrcv [string map {" " _} $hhhrcv] | ||
5385 | set hhhgui_nam [string map {" " _} $hhhgui_nam] | ||
5386 | |||
5387 | pd [concat $id dialog \ | ||
5388 | [eval concat $$var_iemgui_wdt] \ | ||
5389 | [eval concat $$var_iemgui_hgt] \ | ||
5390 | [eval concat $$var_iemgui_min_rng] \ | ||
5391 | [eval concat $$var_iemgui_max_rng] \ | ||
5392 | [eval concat $$var_iemgui_lin0_log1] \ | ||
5393 | [eval concat $$var_iemgui_loadbang] \ | ||
5394 | [eval concat $$var_iemgui_num] \ | ||
5395 | $hhhsnd \ | ||
5396 | $hhhrcv \ | ||
5397 | $hhhgui_nam \ | ||
5398 | [eval concat $$var_iemgui_gn_dx] \ | ||
5399 | [eval concat $$var_iemgui_gn_dy] \ | ||
5400 | [eval concat $$var_iemgui_gn_f] \ | ||
5401 | [eval concat $$var_iemgui_gn_fs] \ | ||
5402 | [eval concat $$var_iemgui_bcol] \ | ||
5403 | [eval concat $$var_iemgui_fcol] \ | ||
5404 | [eval concat $$var_iemgui_lcol] \ | ||
5405 | [eval concat $$var_iemgui_steady] \ | ||
5406 | \;] | ||
5407 | } | ||
5408 | |||
5409 | proc iemgui_cancel {id} {pd [concat $id cancel \;]} | ||
5410 | |||
5411 | proc iemgui_ok {id} { | ||
5412 | iemgui_apply $id | ||
5413 | iemgui_cancel $id | ||
5414 | } | ||
5415 | |||
5416 | proc pdtk_iemgui_dialog {id mainheader \ | ||
5417 | dim_header wdt min_wdt wdt_label hgt min_hgt hgt_label \ | ||
5418 | rng_header min_rng min_rng_label max_rng max_rng_label rng_sched \ | ||
5419 | lin0_log1 lilo0_label lilo1_label loadbang steady num_label num \ | ||
5420 | snd rcv \ | ||
5421 | gui_name \ | ||
5422 | gn_dx gn_dy \ | ||
5423 | gn_f gn_fs \ | ||
5424 | bcol fcol lcol} { | ||
5425 | |||
5426 | set vid [string trimleft $id .] | ||
5427 | |||
5428 | set var_iemgui_wdt [concat iemgui_wdt_$vid] | ||
5429 | global $var_iemgui_wdt | ||
5430 | set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid] | ||
5431 | global $var_iemgui_min_wdt | ||
5432 | set var_iemgui_hgt [concat iemgui_hgt_$vid] | ||
5433 | global $var_iemgui_hgt | ||
5434 | set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid] | ||
5435 | global $var_iemgui_min_hgt | ||
5436 | set var_iemgui_min_rng [concat iemgui_min_rng_$vid] | ||
5437 | global $var_iemgui_min_rng | ||
5438 | set var_iemgui_max_rng [concat iemgui_max_rng_$vid] | ||
5439 | global $var_iemgui_max_rng | ||
5440 | set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid] | ||
5441 | global $var_iemgui_rng_sch | ||
5442 | set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] | ||
5443 | global $var_iemgui_lin0_log1 | ||
5444 | set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] | ||
5445 | global $var_iemgui_lilo0 | ||
5446 | set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] | ||
5447 | global $var_iemgui_lilo1 | ||
5448 | set var_iemgui_loadbang [concat iemgui_loadbang_$vid] | ||
5449 | global $var_iemgui_loadbang | ||
5450 | set var_iemgui_num [concat iemgui_num_$vid] | ||
5451 | global $var_iemgui_num | ||
5452 | set var_iemgui_steady [concat iemgui_steady_$vid] | ||
5453 | global $var_iemgui_steady | ||
5454 | set var_iemgui_snd [concat iemgui_snd_$vid] | ||
5455 | global $var_iemgui_snd | ||
5456 | set var_iemgui_rcv [concat iemgui_rcv_$vid] | ||
5457 | global $var_iemgui_rcv | ||
5458 | set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid] | ||
5459 | global $var_iemgui_gui_nam | ||
5460 | set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid] | ||
5461 | global $var_iemgui_gn_dx | ||
5462 | set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid] | ||
5463 | global $var_iemgui_gn_dy | ||
5464 | set var_iemgui_gn_f [concat iemgui_gn_f_$vid] | ||
5465 | global $var_iemgui_gn_f | ||
5466 | set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid] | ||
5467 | global $var_iemgui_gn_fs | ||
5468 | set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid] | ||
5469 | global $var_iemgui_l2_f1_b0 | ||
5470 | set var_iemgui_bcol [concat iemgui_bcol_$vid] | ||
5471 | global $var_iemgui_bcol | ||
5472 | set var_iemgui_fcol [concat iemgui_fcol_$vid] | ||
5473 | global $var_iemgui_fcol | ||
5474 | set var_iemgui_lcol [concat iemgui_lcol_$vid] | ||
5475 | global $var_iemgui_lcol | ||
5476 | |||
5477 | set $var_iemgui_wdt $wdt | ||
5478 | set $var_iemgui_min_wdt $min_wdt | ||
5479 | set $var_iemgui_hgt $hgt | ||
5480 | set $var_iemgui_min_hgt $min_hgt | ||
5481 | set $var_iemgui_min_rng $min_rng | ||
5482 | set $var_iemgui_max_rng $max_rng | ||
5483 | set $var_iemgui_rng_sch $rng_sched | ||
5484 | set $var_iemgui_lin0_log1 $lin0_log1 | ||
5485 | set $var_iemgui_lilo0 $lilo0_label | ||
5486 | set $var_iemgui_lilo1 $lilo1_label | ||
5487 | set $var_iemgui_loadbang $loadbang | ||
5488 | set $var_iemgui_num $num | ||
5489 | set $var_iemgui_steady $steady | ||
5490 | if {$snd == "empty"} {set $var_iemgui_snd [format ""] | ||
5491 | } else {set $var_iemgui_snd [format "%s" $snd]} | ||
5492 | if {$rcv == "empty"} {set $var_iemgui_rcv [format ""] | ||
5493 | } else {set $var_iemgui_rcv [format "%s" $rcv]} | ||
5494 | if {$gui_name == "empty"} {set $var_iemgui_gui_nam [format ""] | ||
5495 | } else {set $var_iemgui_gui_nam [format "%s" $gui_name]} | ||
5496 | |||
5497 | if {[string index [eval concat $$var_iemgui_snd] 0] == "#"} { | ||
5498 | set $var_iemgui_snd [string replace [eval concat $$var_iemgui_snd] 0 0 $] } | ||
5499 | if {[string index [eval concat $$var_iemgui_rcv] 0] == "#"} { | ||
5500 | set $var_iemgui_rcv [string replace [eval concat $$var_iemgui_rcv] 0 0 $] } | ||
5501 | if {[string index [eval concat $$var_iemgui_gui_nam] 0] == "#"} { | ||
5502 | set $var_iemgui_gui_nam [string replace [eval concat $$var_iemgui_gui_nam] 0 0 $] } | ||
5503 | set $var_iemgui_gn_dx $gn_dx | ||
5504 | set $var_iemgui_gn_dy $gn_dy | ||
5505 | set $var_iemgui_gn_f $gn_f | ||
5506 | set $var_iemgui_gn_fs $gn_fs | ||
5507 | |||
5508 | set $var_iemgui_bcol $bcol | ||
5509 | set $var_iemgui_fcol $fcol | ||
5510 | set $var_iemgui_lcol $lcol | ||
5511 | |||
5512 | set $var_iemgui_l2_f1_b0 0 | ||
5513 | |||
5514 | toplevel $id | ||
5515 | wm title $id [format "%s-PROPERTIES" $mainheader] | ||
5516 | wm protocol $id WM_DELETE_WINDOW [concat iemgui_cancel $id] | ||
5517 | |||
5518 | frame $id.dim | ||
5519 | pack $id.dim -side top | ||
5520 | label $id.dim.head -text $dim_header | ||
5521 | label $id.dim.w_lab -text $wdt_label -width 6 | ||
5522 | entry $id.dim.w_ent -textvariable $var_iemgui_wdt -width 5 | ||
5523 | label $id.dim.dummy1 -text " " -width 10 | ||
5524 | label $id.dim.h_lab -text $hgt_label -width 6 | ||
5525 | entry $id.dim.h_ent -textvariable $var_iemgui_hgt -width 5 | ||
5526 | pack $id.dim.head -side top | ||
5527 | pack $id.dim.w_lab $id.dim.w_ent $id.dim.dummy1 -side left | ||
5528 | if { $hgt_label != "empty" } { | ||
5529 | pack $id.dim.h_lab $id.dim.h_ent -side left} | ||
5530 | |||
5531 | frame $id.rng | ||
5532 | pack $id.rng -side top | ||
5533 | label $id.rng.head -text $rng_header | ||
5534 | label $id.rng.min_lab -text $min_rng_label -width 6 | ||
5535 | entry $id.rng.min_ent -textvariable $var_iemgui_min_rng -width 9 | ||
5536 | label $id.rng.dummy1 -text " " -width 1 | ||
5537 | label $id.rng.max_lab -text $max_rng_label -width 8 | ||
5538 | entry $id.rng.max_ent -textvariable $var_iemgui_max_rng -width 9 | ||
5539 | if { $rng_header != "empty" } { | ||
5540 | pack $id.rng.head -side top | ||
5541 | if { $min_rng_label != "empty" } { | ||
5542 | pack $id.rng.min_lab $id.rng.min_ent -side left} | ||
5543 | if { $max_rng_label != "empty" } { | ||
5544 | pack $id.rng.dummy1 \ | ||
5545 | $id.rng.max_lab $id.rng.max_ent -side left} } | ||
5546 | |||
5547 | 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 } { | ||
5548 | label $id.space1 -text "---------------------------------" | ||
5549 | pack $id.space1 -side top } | ||
5550 | |||
5551 | frame $id.para | ||
5552 | pack $id.para -side top | ||
5553 | label $id.para.dummy2 -text "" -width 1 | ||
5554 | label $id.para.dummy3 -text "" -width 1 | ||
5555 | if {[eval concat $$var_iemgui_lin0_log1] == 0} { | ||
5556 | button $id.para.lilo -text [eval concat $$var_iemgui_lilo0] -width 5 -command "iemgui_lilo $id" } | ||
5557 | if {[eval concat $$var_iemgui_lin0_log1] == 1} { | ||
5558 | button $id.para.lilo -text [eval concat $$var_iemgui_lilo1] -width 5 -command "iemgui_lilo $id" } | ||
5559 | if {[eval concat $$var_iemgui_loadbang] == 0} { | ||
5560 | button $id.para.lb -text "no init" -width 5 -command "iemgui_lb $id" } | ||
5561 | if {[eval concat $$var_iemgui_loadbang] == 1} { | ||
5562 | button $id.para.lb -text "init" -width 5 -command "iemgui_lb $id" } | ||
5563 | label $id.para.num_lab -text $num_label -width 9 | ||
5564 | entry $id.para.num_ent -textvariable $var_iemgui_num -width 4 | ||
5565 | if {[eval concat $$var_iemgui_steady] == 0} { | ||
5566 | button $id.para.stdy_jmp -text "jump on click" -width 11 -command "iemgui_stdy_jmp $id" } | ||
5567 | if {[eval concat $$var_iemgui_steady] == 1} { | ||
5568 | button $id.para.stdy_jmp -text "steady on click" -width 11 -command "iemgui_stdy_jmp $id" } | ||
5569 | if {[eval concat $$var_iemgui_lin0_log1] >= 0} { | ||
5570 | pack $id.para.lilo -side left -expand 1} | ||
5571 | if {[eval concat $$var_iemgui_loadbang] >= 0} { | ||
5572 | pack $id.para.dummy2 $id.para.lb -side left -expand 1} | ||
5573 | if {[eval concat $$var_iemgui_num] > 0} { | ||
5574 | pack $id.para.dummy3 $id.para.num_lab $id.para.num_ent -side left -expand 1} | ||
5575 | if {[eval concat $$var_iemgui_steady] >= 0} { | ||
5576 | pack $id.para.dummy3 $id.para.stdy_jmp -side left -expand 1} | ||
5577 | if { $snd != "nosndno" || $rcv != "norcvno" } { | ||
5578 | label $id.space2 -text "---------------------------------" | ||
5579 | pack $id.space2 -side top } | ||
5580 | |||
5581 | frame $id.snd | ||
5582 | pack $id.snd -side top | ||
5583 | label $id.snd.dummy1 -text "" -width 2 | ||
5584 | label $id.snd.lab -text "send-symbol:" -width 12 | ||
5585 | entry $id.snd.ent -textvariable $var_iemgui_snd -width 20 | ||
5586 | if { $snd != "nosndno" } { | ||
5587 | pack $id.snd.dummy1 $id.snd.lab $id.snd.ent -side left} | ||
5588 | |||
5589 | frame $id.rcv | ||
5590 | pack $id.rcv -side top | ||
5591 | label $id.rcv.lab -text "receive-symbol:" -width 15 | ||
5592 | entry $id.rcv.ent -textvariable $var_iemgui_rcv -width 20 | ||
5593 | if { $rcv != "norcvno" } { | ||
5594 | pack $id.rcv.lab $id.rcv.ent -side left} | ||
5595 | |||
5596 | frame $id.gnam | ||
5597 | pack $id.gnam -side top | ||
5598 | label $id.gnam.head -text "--------------label:---------------" | ||
5599 | label $id.gnam.dummy1 -text "" -width 1 | ||
5600 | label $id.gnam.lab -text "name:" -width 6 | ||
5601 | entry $id.gnam.ent -textvariable $var_iemgui_gui_nam -width 29 | ||
5602 | label $id.gnam.dummy2 -text "" -width 1 | ||
5603 | pack $id.gnam.head -side top | ||
5604 | pack $id.gnam.dummy1 $id.gnam.lab $id.gnam.ent $id.gnam.dummy2 -side left | ||
5605 | |||
5606 | frame $id.gnxy | ||
5607 | pack $id.gnxy -side top | ||
5608 | label $id.gnxy.x_lab -text "x_off:" -width 6 | ||
5609 | entry $id.gnxy.x_ent -textvariable $var_iemgui_gn_dx -width 5 | ||
5610 | label $id.gnxy.dummy1 -text " " -width 10 | ||
5611 | label $id.gnxy.y_lab -text "y_off:" -width 6 | ||
5612 | entry $id.gnxy.y_ent -textvariable $var_iemgui_gn_dy -width 5 | ||
5613 | pack $id.gnxy.x_lab $id.gnxy.x_ent $id.gnxy.dummy1 \ | ||
5614 | $id.gnxy.y_lab $id.gnxy.y_ent -side left | ||
5615 | |||
5616 | frame $id.gnfs | ||
5617 | pack $id.gnfs -side top | ||
5618 | label $id.gnfs.f_lab -text "font:" -width 6 | ||
5619 | if {[eval concat $$var_iemgui_gn_f] == 0} { | ||
5620 | button $id.gnfs.fb -text "courier" -font {courier 10 bold} -width 7 -command "iemgui_toggle_font $id" } | ||
5621 | if {[eval concat $$var_iemgui_gn_f] == 1} { | ||
5622 | button $id.gnfs.fb -text "helvetica" -font {helvetica 10 bold} -width 7 -command "iemgui_toggle_font $id" } | ||
5623 | if {[eval concat $$var_iemgui_gn_f] == 2} { | ||
5624 | button $id.gnfs.fb -text "times" -font {times 10 bold} -width 7 -command "iemgui_toggle_font $id" } | ||
5625 | label $id.gnfs.dummy1 -text "" -width 1 | ||
5626 | label $id.gnfs.fs_lab -text "fontsize:" -width 8 | ||
5627 | entry $id.gnfs.fs_ent -textvariable $var_iemgui_gn_fs -width 5 | ||
5628 | pack $id.gnfs.f_lab $id.gnfs.fb $id.gnfs.dummy1 \ | ||
5629 | $id.gnfs.fs_lab $id.gnfs.fs_ent -side left | ||
5630 | |||
5631 | label $id.col_head -text "--------------colors:--------------" | ||
5632 | pack $id.col_head -side top | ||
5633 | |||
5634 | frame $id.col_select | ||
5635 | pack $id.col_select -side top | ||
5636 | radiobutton $id.col_select.radio0 -value 0 -variable $var_iemgui_l2_f1_b0 \ | ||
5637 | -text "backgd" -width 5 | ||
5638 | radiobutton $id.col_select.radio1 -value 1 -variable $var_iemgui_l2_f1_b0 \ | ||
5639 | -text "front" -width 5 | ||
5640 | radiobutton $id.col_select.radio2 -value 2 -variable $var_iemgui_l2_f1_b0 \ | ||
5641 | -text "label" -width 5 | ||
5642 | if { [eval concat $$var_iemgui_fcol] >= 0 } { | ||
5643 | pack $id.col_select.radio0 $id.col_select.radio1 $id.col_select.radio2 -side left | ||
5644 | } else {pack $id.col_select.radio0 $id.col_select.radio2 -side left} | ||
5645 | |||
5646 | frame $id.col_example_choose | ||
5647 | pack $id.col_example_choose -side top | ||
5648 | button $id.col_example_choose.but -text "compose color" -width 10 \ | ||
5649 | -command "iemgui_choose_col_bkfrlb $id" | ||
5650 | label $id.col_example_choose.dummy1 -text "" -width 1 | ||
5651 | if { [eval concat $$var_iemgui_fcol] >= 0 } { | ||
5652 | button $id.col_example_choose.fr_bk -text "o=||=o" -width 5 \ | ||
5653 | -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
5654 | -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
5655 | -foreground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \ | ||
5656 | -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] -pady 2 | ||
5657 | } else { | ||
5658 | button $id.col_example_choose.fr_bk -text "o=||=o" -width 5 \ | ||
5659 | -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
5660 | -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
5661 | -foreground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
5662 | -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] -pady 2} | ||
5663 | button $id.col_example_choose.lb_bk -text "testlabel" -width 7 \ | ||
5664 | -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
5665 | -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ | ||
5666 | -foreground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \ | ||
5667 | -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] -pady 2 | ||
5668 | |||
5669 | pack $id.col_example_choose.but $id.col_example_choose.dummy1 \ | ||
5670 | $id.col_example_choose.fr_bk $id.col_example_choose.lb_bk -side left | ||
5671 | |||
5672 | label $id.space3 -text "------or click color preset:-------" | ||
5673 | pack $id.space3 -side top | ||
5674 | |||
5675 | frame $id.bcol | ||
5676 | pack $id.bcol -side top | ||
5677 | foreach i { 0 1 2 3 4 5 6 7 8 9 } hexcol { 16579836 14737632 12369084 \ | ||
5678 | 16572640 16572608 16579784 14220504 14220540 14476540 16308476 } { | ||
5679 | button $id.bcol.c$i -background [format "#%6.6x" $hexcol] \ | ||
5680 | -activebackground [format "#%6.6x" $hexcol] \ | ||
5681 | -font {courier 2 normal} -padx 7 -pady 6 \ | ||
5682 | -command [format "iemgui_preset_col %s %d" $id $hexcol] } | ||
5683 | pack $id.bcol.c0 $id.bcol.c1 $id.bcol.c2 $id.bcol.c3 $id.bcol.c4 \ | ||
5684 | $id.bcol.c5 $id.bcol.c6 $id.bcol.c7 $id.bcol.c8 $id.bcol.c9 -side left | ||
5685 | |||
5686 | frame $id.fcol | ||
5687 | pack $id.fcol -side top | ||
5688 | foreach i { 0 1 2 3 4 5 6 7 8 9 } hexcol { 10526880 8158332 6316128 \ | ||
5689 | 16525352 16559172 15263784 1370132 2684148 3952892 16003312 } { | ||
5690 | button $id.fcol.c$i -background [format "#%6.6x" $hexcol] \ | ||
5691 | -activebackground [format "#%6.6x" $hexcol] \ | ||
5692 | -font {courier 2 normal} -padx 7 -pady 6 \ | ||
5693 | -command [format "iemgui_preset_col %s %d" $id $hexcol] } | ||
5694 | pack $id.fcol.c0 $id.fcol.c1 $id.fcol.c2 $id.fcol.c3 $id.fcol.c4 \ | ||
5695 | $id.fcol.c5 $id.fcol.c6 $id.fcol.c7 $id.fcol.c8 $id.fcol.c9 -side left | ||
5696 | |||
5697 | frame $id.lcol | ||
5698 | pack $id.lcol -side top | ||
5699 | foreach i { 0 1 2 3 4 5 6 7 8 9 } hexcol { 4210752 2105376 0 \ | ||
5700 | 9177096 5779456 7874580 2641940 17488 5256 5767248 } { | ||
5701 | button $id.lcol.c$i -background [format "#%6.6x" $hexcol] \ | ||
5702 | -activebackground [format "#%6.6x" $hexcol] \ | ||
5703 | -font {courier 2 normal} -padx 7 -pady 6 \ | ||
5704 | -command [format "iemgui_preset_col %s %d" $id $hexcol] } | ||
5705 | pack $id.lcol.c0 $id.lcol.c1 $id.lcol.c2 $id.lcol.c3 $id.lcol.c4 \ | ||
5706 | $id.lcol.c5 $id.lcol.c6 $id.lcol.c7 $id.lcol.c8 $id.lcol.c9 -side left | ||
5707 | |||
5708 | |||
5709 | label $id.space4 -text "---------------------------------" | ||
5710 | pack $id.space4 -side top | ||
5711 | |||
5712 | frame $id.cao | ||
5713 | pack $id.cao -side top | ||
5714 | button $id.cao.cancel -text {Cancel} -width 6 \ | ||
5715 | -command "iemgui_cancel $id" | ||
5716 | label $id.cao.dummy1 -text "" -width 3 | ||
5717 | button $id.cao.apply -text {Apply} -width 6 \ | ||
5718 | -command "iemgui_apply $id" | ||
5719 | label $id.cao.dummy2 -text "" -width 3 | ||
5720 | button $id.cao.ok -text {OK} -width 6 \ | ||
5721 | -command "iemgui_ok $id" | ||
5722 | pack $id.cao.cancel $id.cao.dummy1 \ | ||
5723 | $id.cao.apply $id.cao.dummy2 \ | ||
5724 | $id.cao.ok -side left | ||
5725 | |||
5726 | label $id.space5 -text "" | ||
5727 | pack $id.space5 -side top | ||
5728 | |||
5729 | if {[info tclversion] < 8.4} { | ||
5730 | bind $id <Key-Tab> {tkTabToWindow [tk_focusNext %W]} | ||
5731 | bind $id <<PrevWindow>> {tkTabToWindow [tk_focusPrev %W]} | ||
5732 | } else { | ||
5733 | bind $id <Key-Tab> {tk::TabToWindow [tk_focusNext %W]} | ||
5734 | bind $id <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]} | ||
5735 | } | ||
5736 | |||
5737 | bind $id.dim.w_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
5738 | bind $id.dim.h_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
5739 | bind $id.rng.min_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
5740 | bind $id.rng.max_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
5741 | bind $id.para.num_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
5742 | bind $id.snd.ent <KeyPress-Return> [concat iemgui_ok $id] | ||
5743 | bind $id.rcv.ent <KeyPress-Return> [concat iemgui_ok $id] | ||
5744 | bind $id.gnam.ent <KeyPress-Return> [concat iemgui_ok $id] | ||
5745 | bind $id.gnxy.x_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
5746 | bind $id.gnxy.y_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
5747 | bind $id.gnfs.fs_ent <KeyPress-Return> [concat iemgui_ok $id] | ||
5748 | bind $id.cao.ok <KeyPress-Return> [concat iemgui_ok $id] | ||
5749 | |||
5750 | $id.dim.w_ent select from 0 | ||
5751 | $id.dim.w_ent select adjust end | ||
5752 | focus $id.dim.w_ent | ||
5753 | } | ||
5754 | # end of change "iemlib" | ||
5755 | |||
5756 | ############ pdtk_array_dialog -- dialog window for arrays ######### | ||
5757 | proc array_apply {id} { | ||
5758 | # strip "." from the TK id to make a variable name suffix | ||
5759 | set vid [string trimleft $id .] | ||
5760 | # for each variable, make a local variable to hold its name... | ||
5761 | set var_array_name [concat array_name_$vid] | ||
5762 | global $var_array_name | ||
5763 | set var_array_n [concat array_n_$vid] | ||
5764 | global $var_array_n | ||
5765 | set var_array_saveit [concat array_saveit_$vid] | ||
5766 | global $var_array_saveit | ||
5767 | set var_array_otherflag [concat array_otherflag_$vid] | ||
5768 | global $var_array_otherflag | ||
5769 | set mofo [eval concat $$var_array_name] | ||
5770 | if {[string index $mofo 0] == "$"} { | ||
5771 | set mofo [string replace $mofo 0 0 #] } | ||
5772 | |||
5773 | pd [concat $id arraydialog $mofo \ | ||
5774 | [eval concat $$var_array_n] \ | ||
5775 | [eval concat $$var_array_saveit] \ | ||
5776 | [eval concat $$var_array_otherflag] \ | ||
5777 | \;] | ||
5778 | } | ||
5779 | |||
5780 | proc array_cancel {id} { | ||
5781 | set cmd [concat $id cancel \;] | ||
5782 | pd $cmd | ||
5783 | } | ||
5784 | |||
5785 | proc array_ok {id} { | ||
5786 | array_apply $id | ||
5787 | array_cancel $id | ||
5788 | } | ||
5789 | |||
5790 | proc pdtk_array_dialog {id name n saveit newone} { | ||
5791 | set vid [string trimleft $id .] | ||
5792 | |||
5793 | set var_array_name [concat array_name_$vid] | ||
5794 | global $var_array_name | ||
5795 | set var_array_n [concat array_n_$vid] | ||
5796 | global $var_array_n | ||
5797 | set var_array_saveit [concat array_saveit_$vid] | ||
5798 | global $var_array_saveit | ||
5799 | set var_array_otherflag [concat array_otherflag_$vid] | ||
5800 | global $var_array_otherflag | ||
5801 | |||
5802 | set $var_array_name $name | ||
5803 | set $var_array_n $n | ||
5804 | set $var_array_saveit $saveit | ||
5805 | set $var_array_otherflag 0 | ||
5806 | |||
5807 | toplevel $id | ||
5808 | wm title $id {array} | ||
5809 | wm protocol $id WM_DELETE_WINDOW [concat array_cancel $id] | ||
5810 | |||
5811 | frame $id.name | ||
5812 | pack $id.name -side top | ||
5813 | label $id.name.label -text "name" | ||
5814 | entry $id.name.entry -textvariable $var_array_name | ||
5815 | pack $id.name.label $id.name.entry -side left | ||
5816 | |||
5817 | frame $id.n | ||
5818 | pack $id.n -side top | ||
5819 | label $id.n.label -text "size" | ||
5820 | entry $id.n.entry -textvariable $var_array_n | ||
5821 | pack $id.n.label $id.n.entry -side left | ||
5822 | |||
5823 | checkbutton $id.saveme -text {save contents} -variable $var_array_saveit \ | ||
5824 | -anchor w | ||
5825 | pack $id.saveme -side top | ||
5826 | |||
5827 | if {$newone != 0} { | ||
5828 | frame $id.radio | ||
5829 | pack $id.radio -side top | ||
5830 | radiobutton $id.radio.radio0 -value 0 \ | ||
5831 | -variable $var_array_otherflag \ | ||
5832 | -text "in new graph" | ||
5833 | radiobutton $id.radio.radio1 -value 1 \ | ||
5834 | -variable $var_array_otherflag \ | ||
5835 | -text "in last graph" | ||
5836 | pack $id.radio.radio0 -side top -anchor w | ||
5837 | pack $id.radio.radio1 -side top -anchor w | ||
5838 | } else { | ||
5839 | checkbutton $id.deleteme -text {delete me} \ | ||
5840 | -variable $var_array_otherflag -anchor w | ||
5841 | pack $id.deleteme -side top | ||
5842 | } | ||
5843 | frame $id.buttonframe | ||
5844 | pack $id.buttonframe -side bottom -fill x -pady 2m | ||
5845 | button $id.buttonframe.cancel -text {Cancel}\ | ||
5846 | -command "array_cancel $id" | ||
5847 | if {$newone == 0} {button $id.buttonframe.apply -text {Apply}\ | ||
5848 | -command "array_apply $id"} | ||
5849 | button $id.buttonframe.ok -text {OK}\ | ||
5850 | -command "array_ok $id" | ||
5851 | pack $id.buttonframe.cancel -side left -expand 1 | ||
5852 | if {$newone == 0} {pack $id.buttonframe.apply -side left -expand 1} | ||
5853 | pack $id.buttonframe.ok -side left -expand 1 | ||
5854 | |||
5855 | bind $id.name.entry <KeyPress-Return> [concat array_ok $id] | ||
5856 | bind $id.n.entry <KeyPress-Return> [concat array_ok $id] | ||
5857 | $id.name.entry select from 0 | ||
5858 | $id.name.entry select adjust end | ||
5859 | focus $id.name.entry | ||
5860 | } | ||
5861 | |||
5862 | ############ pdtk_canvas_dialog -- dialog window for canvass ######### | ||
5863 | proc canvas_apply {id} { | ||
5864 | # strip "." from the TK id to make a variable name suffix | ||
5865 | set vid [string trimleft $id .] | ||
5866 | # for each variable, make a local variable to hold its name... | ||
5867 | set var_canvas_xscale [concat canvas_xscale_$vid] | ||
5868 | global $var_canvas_xscale | ||
5869 | set var_canvas_yscale [concat canvas_yscale_$vid] | ||
5870 | global $var_canvas_yscale | ||
5871 | set var_canvas_graphme [concat canvas_graphme_$vid] | ||
5872 | global $var_canvas_graphme | ||
5873 | # set var_canvas_stretch [concat canvas_stretch_$vid] | ||
5874 | # global $var_canvas_stretch | ||
5875 | pd [concat $id donecanvasdialog \ | ||
5876 | [eval concat $$var_canvas_xscale] \ | ||
5877 | [eval concat $$var_canvas_yscale] \ | ||
5878 | [eval concat $$var_canvas_graphme] \ | ||
5879 | \;] | ||
5880 | } | ||
5881 | |||
5882 | proc canvas_cancel {id} { | ||
5883 | set cmd [concat $id cancel \;] | ||
5884 | pd $cmd | ||
5885 | } | ||
5886 | |||
5887 | proc canvas_ok {id} { | ||
5888 | canvas_apply $id | ||
5889 | canvas_cancel $id | ||
5890 | } | ||
5891 | |||
5892 | proc pdtk_canvas_dialog {id xscale yscale graphme stretch} { | ||
5893 | set vid [string trimleft $id .] | ||
5894 | |||
5895 | set var_canvas_xscale [concat canvas_xscale_$vid] | ||
5896 | global $var_canvas_xscale | ||
5897 | set var_canvas_yscale [concat canvas_yscale_$vid] | ||
5898 | global $var_canvas_yscale | ||
5899 | set var_canvas_graphme [concat canvas_graphme_$vid] | ||
5900 | global $var_canvas_graphme | ||
5901 | # set var_canvas_stretch [concat canvas_stretch_$vid] | ||
5902 | # global $var_canvas_stretch | ||
5903 | |||
5904 | set $var_canvas_xscale $xscale | ||
5905 | set $var_canvas_yscale $yscale | ||
5906 | set $var_canvas_graphme $graphme | ||
5907 | # set $var_canvas_stretch $stretch | ||
5908 | |||
5909 | toplevel $id | ||
5910 | wm title $id {canvas} | ||
5911 | wm protocol $id WM_DELETE_WINDOW [concat canvas_cancel $id] | ||
5912 | |||
5913 | frame $id.xscale | ||
5914 | pack $id.xscale -side top | ||
5915 | label $id.xscale.label -text "X units per pixel" | ||
5916 | entry $id.xscale.entry -textvariable $var_canvas_xscale -width 10 | ||
5917 | pack $id.xscale.label $id.xscale.entry -side left | ||
5918 | |||
5919 | frame $id.yscale | ||
5920 | pack $id.yscale -side top | ||
5921 | label $id.yscale.label -text "Y units per pixel" | ||
5922 | entry $id.yscale.entry -textvariable $var_canvas_yscale -width 10 | ||
5923 | pack $id.yscale.label $id.yscale.entry -side left | ||
5924 | |||
5925 | checkbutton $id.graphme -text {graph on parent} \ | ||
5926 | -variable $var_canvas_graphme -anchor w | ||
5927 | pack $id.graphme -side top | ||
5928 | |||
5929 | # checkbutton $id.stretch -text {stretch on resize} \ | ||
5930 | # -variable $var_canvas_stretch -anchor w | ||
5931 | # pack $id.stretch -side top | ||
5932 | |||
5933 | |||
5934 | frame $id.buttonframe | ||
5935 | pack $id.buttonframe -side bottom -fill x -pady 2m | ||
5936 | button $id.buttonframe.cancel -text {Cancel}\ | ||
5937 | -command "canvas_cancel $id" | ||
5938 | button $id.buttonframe.apply -text {Apply}\ | ||
5939 | -command "canvas_apply $id" | ||
5940 | button $id.buttonframe.ok -text {OK}\ | ||
5941 | -command "canvas_ok $id" | ||
5942 | pack $id.buttonframe.cancel -side left -expand 1 | ||
5943 | pack $id.buttonframe.apply -side left -expand 1 | ||
5944 | pack $id.buttonframe.ok -side left -expand 1 | ||
5945 | |||
5946 | bind $id.xscale.entry <KeyPress-Return> [concat canvas_ok $id] | ||
5947 | bind $id.yscale.entry <KeyPress-Return> [concat canvas_ok $id] | ||
5948 | $id.xscale.entry select from 0 | ||
5949 | $id.xscale.entry select adjust end | ||
5950 | focus $id.xscale.entry | ||
5951 | } | ||
5952 | |||
5953 | ############ pdtk_data_dialog -- run a data dialog ######### | ||
5954 | proc dodata_send {name} { | ||
5955 | # puts stderr [$name.text get 0.0 end] | ||
5956 | |||
5957 | for {set i 1} {[$name.text compare [concat $i.0 + 3 chars] < end]} \ | ||
5958 | {incr i 1} { | ||
5959 | # puts stderr [concat it's [$name.text get $i.0 [expr $i + 1].0]] | ||
5960 | set cmd [concat $name data [$name.text get $i.0 [expr $i + 1].0] \;] | ||
5961 | # puts stderr $cmd | ||
5962 | pd $cmd | ||
5963 | } | ||
5964 | set cmd [concat $name end \;] | ||
5965 | # puts stderr $cmd | ||
5966 | pd $cmd | ||
5967 | } | ||
5968 | |||
5969 | proc dodata_cancel {name} { | ||
5970 | set cmd [concat $name cancel \;] | ||
5971 | # puts stderr $cmd | ||
5972 | pd $cmd | ||
5973 | } | ||
5974 | |||
5975 | proc dodata_ok {name} { | ||
5976 | dodata_send $name | ||
5977 | dodata_cancel $name | ||
5978 | } | ||
5979 | |||
5980 | proc pdtk_data_dialog {name stuff} { | ||
5981 | |||
5982 | toplevel $name | ||
5983 | wm title $name {Atom} | ||
5984 | wm protocol $name WM_DELETE_WINDOW [concat dodata_cancel $name] | ||
5985 | |||
5986 | frame $name.buttonframe | ||
5987 | pack $name.buttonframe -side bottom -fill x -pady 2m | ||
5988 | button $name.buttonframe.send -text {Send (Ctrl s)}\ | ||
5989 | -command [concat dodata_send $name] | ||
5990 | button $name.buttonframe.ok -text {OK (Ctrl t)}\ | ||
5991 | -command [concat dodata_ok $name] | ||
5992 | pack $name.buttonframe.send -side left -expand 1 | ||
5993 | pack $name.buttonframe.ok -side left -expand 1 | ||
5994 | |||
5995 | text $name.text -relief raised -bd 2 -height 40 -width 60 \ | ||
5996 | -yscrollcommand "$name.scroll set" -font -*-courier-bold--normal--12-* | ||
5997 | scrollbar $name.scroll -command "$name.text yview" | ||
5998 | pack $name.scroll -side right -fill y | ||
5999 | pack $name.text -side left -fill both -expand 1 | ||
6000 | $name.text insert end $stuff | ||
6001 | focus $name.text | ||
6002 | bind $name.text <Control-t> [concat dodata_ok $name] | ||
6003 | bind $name.text <Control-s> [concat dodata_send $name] | ||
6004 | } | ||
6005 | |||
6006 | ############ check or uncheck the "edit" menu item ############## | ||
6007 | #####################iemlib####################### | ||
6008 | proc pdtk_canvas_editval {name value} { | ||
6009 | if { $value } { | ||
6010 | $name.m.edit entryconfigure "Edit mode" -indicatoron true | ||
6011 | } else { | ||
6012 | $name.m.edit entryconfigure "Edit mode" -indicatoron false | ||
6013 | } | ||
6014 | } | ||
6015 | #####################iemlib####################### | ||
6016 | |||
6017 | ############ pdtk_text_new -- create a new text object #2########### | ||
6018 | proc pdtk_text_new {canvasname myname x y text font color} { | ||
6019 | # if {$font < 13} {set fontname [format -*-courier-bold----%d-* $font]} | ||
6020 | # if {$font >= 13} {set fontname [format -*-courier-----%d-* $font]} | ||
6021 | $canvasname create text $x $y \ | ||
6022 | -font [format -*-courier-bold--normal--%d-* $font] \ | ||
6023 | -tags $myname -text $text -fill $color -anchor nw | ||
6024 | # pd [concat $myname size [$canvasname bbox $myname] \;] | ||
6025 | } | ||
6026 | |||
6027 | ################ pdtk_text_set -- change the text ################## | ||
6028 | proc pdtk_text_set {canvasname myname text} { | ||
6029 | $canvasname itemconfig $myname -text $text | ||
6030 | # pd [concat $myname size [$canvasname bbox $myname] \;] | ||
6031 | } | ||
6032 | |||
6033 | ############### event binding procedures for Pd window ################ | ||
6034 | |||
6035 | proc pdtk_pd_ctrlkey {name key shift} { | ||
6036 | # puts stderr [concat key $key shift $shift] | ||
6037 | # .dummy itemconfig goo -text [concat ---> control-key event $key]; | ||
6038 | if {$key == "n" || $key == "N"} {menu_new} | ||
6039 | if {$key == "o" || $key == "O"} {menu_open} | ||
6040 | if {$key == "m" || $key == "M"} {menu_send} | ||
6041 | if {$key == "q" || $key == "Q"} { | ||
6042 | if {$shift == 1} {menu_really_quit} else {menu_quit} | ||
6043 | } | ||
6044 | if {$key == "slash"} {menu_audio 1} | ||
6045 | if {$key == "period"} {menu_audio 0} | ||
6046 | } | ||
6047 | |||
6048 | ######### startup function. ############## | ||
6049 | # Tell pd the current directory; this is used in case the command line | ||
6050 | # asked pd to open something. Also, get character width and height for | ||
6051 | # font sizes 8, 10, 12, 14, 16, and 24. | ||
6052 | |||
6053 | proc pdtk_pd_startup {version apilist} { | ||
6054 | global pd_myversion pd_apilist | ||
6055 | set pd_myversion $version | ||
6056 | set pd_apilist $apilist | ||
6057 | |||
6058 | set width1 [font measure -*-courier-bold--normal--8-* x] | ||
6059 | set height1 [lindex [font metrics -*-courier-bold--normal--8-*] 5] | ||
6060 | |||
6061 | set width2 [font measure -*-courier-bold--normal--10-* x] | ||
6062 | set height2 [lindex [font metrics -*-courier-bold--normal--10-*] 5] | ||
6063 | |||
6064 | set width3 [font measure -*-courier-bold--normal--12-* x] | ||
6065 | set height3 [lindex [font metrics -*-courier-bold--normal--12-*] 5] | ||
6066 | |||
6067 | set width4 [font measure -*-courier-bold--normal--14-* x] | ||
6068 | set height4 [lindex [font metrics -*-courier-bold--normal--14-*] 5] | ||
6069 | |||
6070 | set width5 [font measure -*-courier-bold--normal--16-* x] | ||
6071 | set height5 [lindex [font metrics -*-courier-bold--normal--16-*] 5] | ||
6072 | |||
6073 | set width6 [font measure -*-courier-bold--normal--24-* x] | ||
6074 | set height6 [lindex [font metrics -*-courier-bold--normal--24-*] 5] | ||
6075 | |||
6076 | set width7 [font measure -*-courier-bold--normal--36-* x] | ||
6077 | set height7 [lindex [font metrics -*-courier-bold--normal--36-*] 5] | ||
6078 | |||
6079 | set tclpatch [info patchlevel] | ||
6080 | if {$tclpatch == "8.3.0" || \ | ||
6081 | $tclpatch == "8.3.1" || \ | ||
6082 | $tclpatch == "8.3.2" || \ | ||
6083 | $tclpatch == "8.3.3" } { | ||
6084 | set oldtclversion 1 | ||
6085 | } else { | ||
6086 | set oldtclversion 0 | ||
6087 | } | ||
6088 | pd [concat pd init [pdtk_enquote [pwd]] \ | ||
6089 | 8 $width1 $height1 \ | ||
6090 | 10 $width2 $height2 \ | ||
6091 | 12 $width3 $height3 \ | ||
6092 | 14 $width4 $height4 \ | ||
6093 | 16 $width5 $height5 \ | ||
6094 | 24 $width6 $height6 \ | ||
6095 | 36 $width7 $height7 \ | ||
6096 | $oldtclversion \;]; | ||
6097 | |||
6098 | # add the audio and help menus to the Pd window. We delayed this | ||
6099 | # so that we'd know the value of "apilist". | ||
6100 | menu_addstd .mbar | ||
6101 | |||
6102 | } | ||
6103 | |||
6104 | ##################### DSP ON/OFF, METERS, DIO ERROR ################### | ||
6105 | proc pdtk_pd_dsp {value} { | ||
6106 | global ctrls_audio_on | ||
6107 | if {$value == "ON"} {set ctrls_audio_on 1} else {set ctrls_audio_on 0} | ||
6108 | # puts stderr [concat its $ctrls_audio_on] | ||
6109 | } | ||
6110 | |||
6111 | proc pdtk_pd_meters {indb outdb inclip outclip} { | ||
6112 | # puts stderr [concat meters $indb $outdb $inclip $outclip] | ||
6113 | global ctrls_inlevel ctrls_outlevel | ||
6114 | set ctrls_inlevel $indb | ||
6115 | if {$inclip == 1} { | ||
6116 | .controls.inout.in.clip configure -background red | ||
6117 | } else { | ||
6118 | .controls.inout.in.clip configure -background grey | ||
6119 | } | ||
6120 | set ctrls_outlevel $outdb | ||
6121 | if {$outclip == 1} { | ||
6122 | .controls.inout.out.clip configure -background red | ||
6123 | } else { | ||
6124 | .controls.inout.out.clip configure -background grey | ||
6125 | } | ||
6126 | |||
6127 | } | ||
6128 | |||
6129 | proc pdtk_pd_dio {red} { | ||
6130 | # puts stderr [concat dio $red] | ||
6131 | if {$red == 1} { | ||
6132 | .controls.dio configure -background red -activebackground red | ||
6133 | } else { | ||
6134 | .controls.dio configure -background grey -activebackground lightgrey | ||
6135 | } | ||
6136 | |||
6137 | } | ||
6138 | |||
6139 | ############# text editing from the "edit" menu ################### | ||
6140 | set edit_number 1 | ||
6141 | |||
6142 | proc texteditor_send {name} { | ||
6143 | set topname [string trimright $name .text] | ||
6144 | for {set i 0} \ | ||
6145 | {[$name compare [concat 0.0 + [expr $i + 1] chars] < end]} \ | ||
6146 | {incr i 1} { | ||
6147 | set cha [$name get [concat 0.0 + $i chars]] | ||
6148 | scan $cha %c keynum | ||
6149 | pd [concat pd key 1 $keynum 0 \;] | ||
6150 | } | ||
6151 | } | ||
6152 | |||
6153 | proc texteditor_ok {name} { | ||
6154 | set topname [string trimright $name .text] | ||
6155 | texteditor_send $name | ||
6156 | destroy $topname | ||
6157 | } | ||
6158 | |||
6159 | |||
6160 | proc pdtk_pd_texteditor {stuff} { | ||
6161 | global edit_number | ||
6162 | set name [format ".text%d" $edit_number] | ||
6163 | set edit_number [expr $edit_number + 1] | ||
6164 | |||
6165 | toplevel $name | ||
6166 | wm title $name {TEXT} | ||
6167 | |||
6168 | frame $name.buttons | ||
6169 | pack $name.buttons -side bottom -fill x -pady 2m | ||
6170 | button $name.buttons.send -text {Send (Ctrl s)}\ | ||
6171 | -command "texteditor_send $name.text" | ||
6172 | button $name.buttons.ok -text {OK (Ctrl t)}\ | ||
6173 | -command "texteditor_ok $name.text" | ||
6174 | pack $name.buttons.send -side left -expand 1 | ||
6175 | pack $name.buttons.ok -side left -expand 1 | ||
6176 | |||
6177 | text $name.text -relief raised -bd 2 -height 12 -width 60 \ | ||
6178 | -yscrollcommand "$name.scroll set" -font -*-courier-bold--normal--12-* | ||
6179 | scrollbar $name.scroll -command "$name.text yview" | ||
6180 | pack $name.scroll -side right -fill y | ||
6181 | pack $name.text -side left -fill both -expand 1 | ||
6182 | $name.text insert end $stuff | ||
6183 | focus $name.text | ||
6184 | bind $name.text <Control-t> {texteditor_ok %W} | ||
6185 | bind $name.text <Control-s> {texteditor_send %W} | ||
6186 | } | ||
6187 | |||
6188 | ############# open and save dialogs for objects in Pd ########## | ||
6189 | |||
6190 | proc pdtk_openpanel {target} { | ||
6191 | global pd_opendir | ||
6192 | set filename [tk_getOpenFile \ | ||
6193 | -initialdir $pd_opendir] | ||
6194 | if {$filename != ""} { | ||
6195 | set directory [string range $filename 0 \ | ||
6196 | [expr [string last / $filename ] - 1]] | ||
6197 | set pd_opendir $directory | ||
6198 | |||
6199 | pd [concat $target symbol [pdtk_enquote $filename] \;] | ||
6200 | } | ||
6201 | } | ||
6202 | |||
6203 | proc pdtk_savepanel {target} { | ||
6204 | set filename [tk_getSaveFile] | ||
6205 | if {$filename != ""} { | ||
6206 | pd [concat $target symbol [pdtk_enquote $filename] \;] | ||
6207 | } | ||
6208 | } | ||
6209 | |||
6210 | ########################### comport hack ######################## | ||
6211 | |||
6212 | set com1 0 | ||
6213 | set com2 0 | ||
6214 | set com3 0 | ||
6215 | set com4 0 | ||
6216 | |||
6217 | proc com1_open {} { | ||
6218 | global com1 | ||
6219 | set com1 [open com1 w] | ||
6220 | .dummy itemconfig goo -text $com1 | ||
6221 | fconfigure $com1 -buffering none | ||
6222 | fconfigure $com1 -mode 19200,e,8,2 | ||
6223 | } | ||
6224 | |||
6225 | proc com1_send {str} { | ||
6226 | global com1 | ||
6227 | puts -nonewline $com1 $str | ||
6228 | } | ||
6229 | |||
6230 | |||
6231 | ############# start a polling process to watch the socket ############## | ||
6232 | # this is needed for nt, and presumably for Mac as well. | ||
6233 | # in UNIX this is handled by a tcl callback (set up in t_tkcmd.c) | ||
6234 | |||
6235 | if {$pd_nt == 1} { | ||
6236 | proc polleofloop {} { | ||
6237 | pd_pollsocket | ||
6238 | after 20 polleofloop | ||
6239 | } | ||
6240 | |||
6241 | polleofloop | ||
6242 | } | ||
6243 | |||
6244 | ####################### audio dialog ##################3 | ||
6245 | |||
6246 | proc audio_apply {id} { | ||
6247 | global audio_indev1 audio_indev2 audio_indev3 audio_indev4 | ||
6248 | global audio_inchan1 audio_inchan2 audio_inchan3 audio_inchan4 | ||
6249 | global audio_outdev1 audio_outdev2 audio_outdev3 audio_outdev4 | ||
6250 | global audio_outchan1 audio_outchan2 audio_outchan3 audio_outchan4 | ||
6251 | global audio_sr audio_advance | ||
6252 | |||
6253 | pd [concat pd audio-dialog \ | ||
6254 | $audio_indev1 \ | ||
6255 | $audio_indev2 \ | ||
6256 | $audio_indev3 \ | ||
6257 | $audio_indev4 \ | ||
6258 | $audio_inchan1 \ | ||
6259 | $audio_inchan2 \ | ||
6260 | $audio_inchan3 \ | ||
6261 | $audio_inchan4 \ | ||
6262 | $audio_outdev1 \ | ||
6263 | $audio_outdev2 \ | ||
6264 | $audio_outdev3 \ | ||
6265 | $audio_outdev4 \ | ||
6266 | $audio_outchan1 \ | ||
6267 | $audio_outchan2 \ | ||
6268 | $audio_outchan3 \ | ||
6269 | $audio_outchan4 \ | ||
6270 | $audio_sr \ | ||
6271 | $audio_advance \ | ||
6272 | \;] | ||
6273 | } | ||
6274 | |||
6275 | proc audio_cancel {id} { | ||
6276 | pd [concat $id cancel \;] | ||
6277 | } | ||
6278 | |||
6279 | proc audio_ok {id} { | ||
6280 | audio_apply $id | ||
6281 | audio_cancel $id | ||
6282 | } | ||
6283 | |||
6284 | # callback from popup menu | ||
6285 | proc audio_popup_action {buttonname varname devlist index} { | ||
6286 | global audio_indevlist audio_outdevlist $varname | ||
6287 | $buttonname configure -text [lindex $devlist $index] | ||
6288 | # puts stderr [concat popup_action $buttonname $varname $index] | ||
6289 | set $varname $index | ||
6290 | } | ||
6291 | |||
6292 | # create a popup menu | ||
6293 | proc audio_popup {name buttonname varname devlist} { | ||
6294 | if [winfo exists $name.popup] {destroy $name.popup} | ||
6295 | menu $name.popup -tearoff false | ||
6296 | # puts stderr [concat $devlist ] | ||
6297 | for {set x 0} {$x<[llength $devlist]} {incr x} { | ||
6298 | $name.popup add command -label [lindex $devlist $x] \ | ||
6299 | -command [list audio_popup_action \ | ||
6300 | $buttonname $varname $devlist $x] | ||
6301 | } | ||
6302 | tk_popup $name.popup [winfo pointerx $name] [winfo pointery $name] 0 | ||
6303 | } | ||
6304 | |||
6305 | # start a dialog window to select audio devices and settings. "multi" | ||
6306 | # is 0 if only one device is allowed; 1 if one apiece may be specified for | ||
6307 | # input and output; and 2 if we can select multiple devices. "longform" | ||
6308 | # (which only makes sense if "multi" is 2) asks us to make controls for | ||
6309 | # opening several devices; if not, we get an extra button to turn longform | ||
6310 | # on and restart the dialog. | ||
6311 | |||
6312 | proc pdtk_audio_dialog {id indevlist indev1 indev2 indev3 indev4 \ | ||
6313 | inchan1 inchan2 inchan3 inchan4 \ | ||
6314 | outdevlist outdev1 outdev2 outdev3 outdev4 \ | ||
6315 | outchan1 outchan2 outchan3 outchan4 sr advance multi longform} { | ||
6316 | global audio_indev1 audio_indev2 audio_indev3 audio_indev4 | ||
6317 | global audio_inchan1 audio_inchan2 audio_inchan3 audio_inchan4 | ||
6318 | global audio_outdev1 audio_outdev2 audio_outdev3 audio_outdev4 | ||
6319 | global audio_outchan1 audio_outchan2 audio_outchan3 audio_outchan4 | ||
6320 | global audio_sr audio_advance | ||
6321 | global audio_indevlist audio_outdevlist | ||
6322 | |||
6323 | set audio_indev1 $indev1 | ||
6324 | set audio_indev2 $indev2 | ||
6325 | set audio_indev3 $indev3 | ||
6326 | set audio_indev4 $indev4 | ||
6327 | set audio_inchan1 $inchan1 | ||
6328 | set audio_inchan2 $inchan2 | ||
6329 | set audio_inchan3 $inchan3 | ||
6330 | set audio_inchan4 $inchan4 | ||
6331 | set audio_outdev1 $outdev1 | ||
6332 | set audio_outdev2 $outdev2 | ||
6333 | set audio_outdev3 $outdev3 | ||
6334 | set audio_outdev4 $outdev4 | ||
6335 | set audio_outchan1 $outchan1 | ||
6336 | set audio_outchan2 $outchan2 | ||
6337 | set audio_outchan3 $outchan3 | ||
6338 | set audio_outchan4 $outchan4 | ||
6339 | set audio_sr $sr | ||
6340 | set audio_advance $advance | ||
6341 | set audio_indevlist $indevlist | ||
6342 | set audio_outdevlist $outdevlist | ||
6343 | |||
6344 | toplevel $id | ||
6345 | wm title $id {audio} | ||
6346 | wm protocol $id WM_DELETE_WINDOW [concat audio_cancel $id] | ||
6347 | |||
6348 | frame $id.buttonframe | ||
6349 | pack $id.buttonframe -side bottom -fill x -pady 2m | ||
6350 | button $id.buttonframe.cancel -text {Cancel}\ | ||
6351 | -command "audio_cancel $id" | ||
6352 | button $id.buttonframe.apply -text {Apply}\ | ||
6353 | -command "audio_apply $id" | ||
6354 | button $id.buttonframe.ok -text {OK}\ | ||
6355 | -command "audio_ok $id" | ||
6356 | pack $id.buttonframe.cancel -side left -expand 1 | ||
6357 | pack $id.buttonframe.apply -side left -expand 1 | ||
6358 | pack $id.buttonframe.ok -side left -expand 1 | ||
6359 | |||
6360 | # sample rate and advance | ||
6361 | frame $id.srf | ||
6362 | pack $id.srf -side top | ||
6363 | |||
6364 | label $id.srf.l1 -text "sample rate:" | ||
6365 | entry $id.srf.x1 -textvariable audio_sr -width 7 | ||
6366 | label $id.srf.l2 -text "delay (msec):" | ||
6367 | entry $id.srf.x2 -textvariable audio_advance -width 4 | ||
6368 | pack $id.srf.l1 $id.srf.x1 $id.srf.l2 $id.srf.x2 -side left | ||
6369 | |||
6370 | # input device 1 | ||
6371 | frame $id.in1f | ||
6372 | pack $id.in1f -side top | ||
6373 | |||
6374 | label $id.in1f.l1 -text "input device 1:" | ||
6375 | button $id.in1f.x1 -text [lindex $indevlist $audio_indev1] \ | ||
6376 | -command [list audio_popup $id $id.in1f.x1 audio_indev1 $indevlist] | ||
6377 | label $id.in1f.l2 -text "channels:" | ||
6378 | entry $id.in1f.x2 -textvariable audio_inchan1 -width 3 | ||
6379 | pack $id.in1f.l1 $id.in1f.x1 $id.in1f.l2 $id.in1f.x2 -side left | ||
6380 | |||
6381 | # input device 2 | ||
6382 | if {$longform && $multi > 1 && [llength $indevlist] > 1} { | ||
6383 | frame $id.in2f | ||
6384 | pack $id.in2f -side top | ||
6385 | |||
6386 | label $id.in2f.l1 -text "input device 2:" | ||
6387 | button $id.in2f.x1 -text [lindex $indevlist $audio_indev2] \ | ||
6388 | -command [list audio_popup $id $id.in2f.x1 audio_indev2 $indevlist] | ||
6389 | label $id.in2f.l2 -text "channels:" | ||
6390 | entry $id.in2f.x2 -textvariable audio_inchan2 -width 3 | ||
6391 | pack $id.in2f.l1 $id.in2f.x1 $id.in2f.l2 $id.in2f.x2 -side left | ||
6392 | } | ||
6393 | |||
6394 | # input device 3 | ||
6395 | if {$longform && $multi > 1 && [llength $indevlist] > 2} { | ||
6396 | frame $id.in3f | ||
6397 | pack $id.in3f -side top | ||
6398 | |||
6399 | label $id.in3f.l1 -text "input device 3:" | ||
6400 | button $id.in3f.x1 -text [lindex $indevlist $audio_indev3] \ | ||
6401 | -command [list audio_popup $id $id.in3f.x1 audio_indev3 $indevlist] | ||
6402 | label $id.in3f.l2 -text "channels:" | ||
6403 | entry $id.in3f.x2 -textvariable audio_inchan3 -width 3 | ||
6404 | pack $id.in3f.l1 $id.in3f.x1 $id.in3f.l2 $id.in3f.x2 -side left | ||
6405 | } | ||
6406 | |||
6407 | # input device 4 | ||
6408 | if {$longform && $multi > 1 && [llength $indevlist] > 3} { | ||
6409 | frame $id.in4f | ||
6410 | pack $id.in4f -side top | ||
6411 | |||
6412 | label $id.in4f.l1 -text "input device 4:" | ||
6413 | button $id.in4f.x1 -text [lindex $indevlist $audio_indev4] \ | ||
6414 | -command [list audio_popup $id $id.in4f.x1 audio_indev4 $indevlist] | ||
6415 | label $id.in4f.l2 -text "channels:" | ||
6416 | entry $id.in4f.x2 -textvariable audio_inchan4 -width 3 | ||
6417 | pack $id.in4f.l1 $id.in4f.x1 $id.in4f.l2 $id.in4f.x2 -side left | ||
6418 | } | ||
6419 | |||
6420 | # output device 1 | ||
6421 | frame $id.out1f | ||
6422 | pack $id.out1f -side top | ||
6423 | |||
6424 | if {$multi == 0} { | ||
6425 | label $id.out1f.l1 \ | ||
6426 | -text "(output device same as input device) .............. " | ||
6427 | } else { | ||
6428 | label $id.out1f.l1 -text "output device 1:" | ||
6429 | button $id.out1f.x1 -text [lindex $outdevlist $audio_outdev1] \ | ||
6430 | -command \ | ||
6431 | [list audio_popup $id $id.out1f.x1 audio_outdev1 $outdevlist] | ||
6432 | } | ||
6433 | label $id.out1f.l2 -text "channels:" | ||
6434 | entry $id.out1f.x2 -textvariable audio_outchan1 -width 3 | ||
6435 | if {$multi == 0} { | ||
6436 | pack $id.out1f.l1 $id.out1f.l2 $id.out1f.x2 -side left | ||
6437 | } else { | ||
6438 | pack $id.out1f.l1 $id.out1f.x1 $id.out1f.l2 $id.out1f.x2 -side left | ||
6439 | } | ||
6440 | |||
6441 | # output device 2 | ||
6442 | if {$longform && $multi > 1 && [llength $indevlist] > 1} { | ||
6443 | frame $id.out2f | ||
6444 | pack $id.out2f -side top | ||
6445 | label $id.out2f.l1 -text "output device 2:" | ||
6446 | button $id.out2f.x1 -text [lindex $outdevlist $audio_outdev2] \ | ||
6447 | -command \ | ||
6448 | [list audio_popup $id $id.out2f.x1 audio_outdev2 $outdevlist] | ||
6449 | label $id.out2f.l2 -text "channels:" | ||
6450 | entry $id.out2f.x2 -textvariable audio_outchan2 -width 3 | ||
6451 | pack $id.out2f.l1 $id.out2f.x1 $id.out2f.l2 $id.out2f.x2 -side left | ||
6452 | } | ||
6453 | |||
6454 | # output device 3 | ||
6455 | if {$longform && $multi > 1 && [llength $indevlist] > 2} { | ||
6456 | frame $id.out3f | ||
6457 | pack $id.out3f -side top | ||
6458 | label $id.out3f.l1 -text "output device 3:" | ||
6459 | button $id.out3f.x1 -text [lindex $outdevlist $audio_outdev3] \ | ||
6460 | -command \ | ||
6461 | [list audio_popup $id $id.out3f.x1 audio_outdev3 $outdevlist] | ||
6462 | label $id.out3f.l2 -text "channels:" | ||
6463 | entry $id.out3f.x2 -textvariable audio_outchan3 -width 3 | ||
6464 | pack $id.out3f.l1 $id.out3f.x1 $id.out3f.l2 $id.out3f.x2 -side left | ||
6465 | } | ||
6466 | |||
6467 | # output device 4 | ||
6468 | if {$longform && $multi > 1 && [llength $indevlist] > 3} { | ||
6469 | frame $id.out4f | ||
6470 | pack $id.out4f -side top | ||
6471 | label $id.out4f.l1 -text "output device 4:" | ||
6472 | button $id.out4f.x1 -text [lindex $outdevlist $audio_outdev4] \ | ||
6473 | -command \ | ||
6474 | [list audio_popup $id $id.out4f.x1 audio_outdev4 $outdevlist] | ||
6475 | label $id.out4f.l2 -text "channels:" | ||
6476 | entry $id.out4f.x2 -textvariable audio_outchan4 -width 3 | ||
6477 | pack $id.out4f.l1 $id.out4f.x1 $id.out4f.l2 $id.out4f.x2 -side left | ||
6478 | } | ||
6479 | |||
6480 | # if not the "long form" but if "multi" is 2, make a button to | ||
6481 | # restart with longform set. | ||
6482 | |||
6483 | if {$longform == 0 && $multi > 1} { | ||
6484 | frame $id.longbutton | ||
6485 | pack $id.longbutton -side top | ||
6486 | button $id.longbutton.b -text {use multiple devices} \ | ||
6487 | -command {pd pd audio-properties 1 \;} | ||
6488 | pack $id.longbutton.b | ||
6489 | } | ||
6490 | bind $id.srf.x1 <KeyPress-Return> [concat audio_ok $id] | ||
6491 | bind $id.srf.x2 <KeyPress-Return> [concat audio_ok $id] | ||
6492 | bind $id.in1f.x2 <KeyPress-Return> [concat audio_ok $id] | ||
6493 | $id.srf.x1 select from 0 | ||
6494 | $id.srf.x1 select adjust end | ||
6495 | focus $id.srf.x1 | ||
6496 | } | ||
6497 | |||
6498 | ####################### midi dialog ##################3 | ||
6499 | |||
6500 | proc midi_apply {id} { | ||
6501 | global midi_indev1 midi_indev2 midi_indev3 midi_indev4 | ||
6502 | global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4 | ||
6503 | |||
6504 | pd [concat pd midi-dialog \ | ||
6505 | $midi_indev1 \ | ||
6506 | $midi_indev2 \ | ||
6507 | $midi_indev3 \ | ||
6508 | $midi_indev4 \ | ||
6509 | $midi_outdev1 \ | ||
6510 | $midi_outdev2 \ | ||
6511 | $midi_outdev3 \ | ||
6512 | $midi_outdev4 \ | ||
6513 | \;] | ||
6514 | } | ||
6515 | |||
6516 | proc midi_cancel {id} { | ||
6517 | pd [concat $id cancel \;] | ||
6518 | } | ||
6519 | |||
6520 | proc midi_ok {id} { | ||
6521 | midi_apply $id | ||
6522 | midi_cancel $id | ||
6523 | } | ||
6524 | |||
6525 | # callback from popup menu | ||
6526 | proc midi_popup_action {buttonname varname devlist index} { | ||
6527 | global midi_indevlist midi_outdevlist $varname | ||
6528 | $buttonname configure -text [lindex $devlist $index] | ||
6529 | # puts stderr [concat popup_action $buttonname $varname $index] | ||
6530 | set $varname $index | ||
6531 | } | ||
6532 | |||
6533 | # create a popup menu | ||
6534 | proc midi_popup {name buttonname varname devlist} { | ||
6535 | if [winfo exists $name.popup] {destroy $name.popup} | ||
6536 | menu $name.popup -tearoff false | ||
6537 | # puts stderr [concat $devlist ] | ||
6538 | for {set x 0} {$x<[llength $devlist]} {incr x} { | ||
6539 | $name.popup add command -label [lindex $devlist $x] \ | ||
6540 | -command [list midi_popup_action \ | ||
6541 | $buttonname $varname $devlist $x] | ||
6542 | } | ||
6543 | tk_popup $name.popup [winfo pointerx $name] [winfo pointery $name] 0 | ||
6544 | } | ||
6545 | |||
6546 | # start a dialog window to select midi devices. "longform" asks us to make | ||
6547 | # controls for opening several devices; if not, we get an extra button to | ||
6548 | # turn longform on and restart the dialog. | ||
6549 | |||
6550 | proc pdtk_midi_dialog {id indevlist indev1 indev2 indev3 indev4 \ | ||
6551 | outdevlist outdev1 outdev2 outdev3 outdev4 longform} { | ||
6552 | global midi_indev1 midi_indev2 midi_indev3 midi_indev4 | ||
6553 | global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4 | ||
6554 | global midi_indevlist midi_outdevlist | ||
6555 | |||
6556 | set midi_indev1 $indev1 | ||
6557 | set midi_indev2 $indev2 | ||
6558 | set midi_indev3 $indev3 | ||
6559 | set midi_indev4 $indev4 | ||
6560 | set midi_outdev1 $outdev1 | ||
6561 | set midi_outdev2 $outdev2 | ||
6562 | set midi_outdev3 $outdev3 | ||
6563 | set midi_outdev4 $outdev4 | ||
6564 | set midi_indevlist $indevlist | ||
6565 | set midi_outdevlist $outdevlist | ||
6566 | |||
6567 | toplevel $id | ||
6568 | wm title $id {midi} | ||
6569 | wm protocol $id WM_DELETE_WINDOW [concat midi_cancel $id] | ||
6570 | |||
6571 | frame $id.buttonframe | ||
6572 | pack $id.buttonframe -side bottom -fill x -pady 2m | ||
6573 | button $id.buttonframe.cancel -text {Cancel}\ | ||
6574 | -command "midi_cancel $id" | ||
6575 | button $id.buttonframe.apply -text {Apply}\ | ||
6576 | -command "midi_apply $id" | ||
6577 | button $id.buttonframe.ok -text {OK}\ | ||
6578 | -command "midi_ok $id" | ||
6579 | pack $id.buttonframe.cancel -side left -expand 1 | ||
6580 | pack $id.buttonframe.apply -side left -expand 1 | ||
6581 | pack $id.buttonframe.ok -side left -expand 1 | ||
6582 | |||
6583 | # input device 1 | ||
6584 | frame $id.in1f | ||
6585 | pack $id.in1f -side top | ||
6586 | |||
6587 | label $id.in1f.l1 -text "input device 1:" | ||
6588 | button $id.in1f.x1 -text [lindex $indevlist $midi_indev1] \ | ||
6589 | -command [list midi_popup $id $id.in1f.x1 midi_indev1 $indevlist] | ||
6590 | pack $id.in1f.l1 $id.in1f.x1 -side left | ||
6591 | |||
6592 | # input device 2 | ||
6593 | if {$longform && [llength $indevlist] > 2} { | ||
6594 | frame $id.in2f | ||
6595 | pack $id.in2f -side top | ||
6596 | |||
6597 | label $id.in2f.l1 -text "input device 2:" | ||
6598 | button $id.in2f.x1 -text [lindex $indevlist $midi_indev2] \ | ||
6599 | -command [list midi_popup $id $id.in2f.x1 midi_indev2 $indevlist] | ||
6600 | pack $id.in2f.l1 $id.in2f.x1 -side left | ||
6601 | } | ||
6602 | |||
6603 | # input device 3 | ||
6604 | if {$longform && [llength $indevlist] > 3} { | ||
6605 | frame $id.in3f | ||
6606 | pack $id.in3f -side top | ||
6607 | |||
6608 | label $id.in3f.l1 -text "input device 3:" | ||
6609 | button $id.in3f.x1 -text [lindex $indevlist $midi_indev3] \ | ||
6610 | -command [list midi_popup $id $id.in3f.x1 midi_indev3 $indevlist] | ||
6611 | pack $id.in3f.l1 $id.in3f.x1 -side left | ||
6612 | } | ||
6613 | |||
6614 | # input device 4 | ||
6615 | if {$longform && [llength $indevlist] > 4} { | ||
6616 | frame $id.in4f | ||
6617 | pack $id.in4f -side top | ||
6618 | |||
6619 | label $id.in4f.l1 -text "input device 4:" | ||
6620 | button $id.in4f.x1 -text [lindex $indevlist $midi_indev4] \ | ||
6621 | -command [list midi_popup $id $id.in4f.x1 midi_indev4 $indevlist] | ||
6622 | pack $id.in4f.l1 $id.in4f.x1 -side left | ||
6623 | } | ||
6624 | |||
6625 | # output device 1 | ||
6626 | |||
6627 | frame $id.out1f | ||
6628 | pack $id.out1f -side top | ||
6629 | label $id.out1f.l1 -text "output device 1:" | ||
6630 | button $id.out1f.x1 -text [lindex $outdevlist $midi_outdev1] \ | ||
6631 | -command [list midi_popup $id $id.out1f.x1 midi_outdev1 $outdevlist] | ||
6632 | pack $id.out1f.l1 $id.out1f.x1 -side left | ||
6633 | |||
6634 | # output device 2 | ||
6635 | if {$longform && [llength $indevlist] > 2} { | ||
6636 | frame $id.out2f | ||
6637 | pack $id.out2f -side top | ||
6638 | label $id.out2f.l1 -text "output device 2:" | ||
6639 | button $id.out2f.x1 -text [lindex $outdevlist $midi_outdev2] \ | ||
6640 | -command \ | ||
6641 | [list midi_popup $id $id.out2f.x1 midi_outdev2 $outdevlist] | ||
6642 | pack $id.out2f.l1 $id.out2f.x1 -side left | ||
6643 | } | ||
6644 | |||
6645 | # output device 3 | ||
6646 | if {$longform && [llength $indevlist] > 3} { | ||
6647 | frame $id.out3f | ||
6648 | pack $id.out3f -side top | ||
6649 | label $id.out3f.l1 -text "output device 3:" | ||
6650 | button $id.out3f.x1 -text [lindex $outdevlist $midi_outdev3] \ | ||
6651 | -command \ | ||
6652 | [list midi_popup $id $id.out3f.x1 midi_outdev3 $outdevlist] | ||
6653 | pack $id.out3f.l1 $id.out3f.x1 -side left | ||
6654 | } | ||
6655 | |||
6656 | # output device 4 | ||
6657 | if {$longform && [llength $indevlist] > 4} { | ||
6658 | frame $id.out4f | ||
6659 | pack $id.out4f -side top | ||
6660 | label $id.out4f.l1 -text "output device 4:" | ||
6661 | button $id.out4f.x1 -text [lindex $outdevlist $midi_outdev4] \ | ||
6662 | -command \ | ||
6663 | [list midi_popup $id $id.out4f.x1 midi_outdev4 $outdevlist] | ||
6664 | pack $id.out4f.l1 $id.out4f.x1 -side left | ||
6665 | } | ||
6666 | |||
6667 | # if not the "long form" make a button to | ||
6668 | # restart with longform set. | ||
6669 | |||
6670 | if {$longform == 0} { | ||
6671 | frame $id.longbutton | ||
6672 | pack $id.longbutton -side top | ||
6673 | button $id.longbutton.b -text {use multiple devices} \ | ||
6674 | -command {pd pd midi-properties 1 \;} | ||
6675 | pack $id.longbutton.b | ||
6676 | } | ||
6677 | } | ||
6678 | |||
6679 | ############ pdtk_path_dialog -- dialog window for search path ######### | ||
6680 | |||
6681 | proc path_apply {id} { | ||
6682 | global pd_path0 pd_path1 pd_path2 pd_path3 pd_path4 | ||
6683 | global pd_path5 pd_path6 pd_path7 pd_path8 pd_path9 | ||
6684 | |||
6685 | pd [concat pd path-dialog \ | ||
6686 | $pd_path0 $pd_path1 $pd_path2 $pd_path3 $pd_path4 \ | ||
6687 | $pd_path5 $pd_path6 $pd_path7 $pd_path8 $pd_path9 \ | ||
6688 | \;] | ||
6689 | } | ||
6690 | |||
6691 | proc path_cancel {id} { | ||
6692 | pd [concat $id cancel \;] | ||
6693 | } | ||
6694 | |||
6695 | proc path_ok {id} { | ||
6696 | path_apply $id | ||
6697 | path_cancel $id | ||
6698 | } | ||
6699 | set pd_path0 sdfgh | ||
6700 | |||
6701 | proc pdtk_path_dialog {id} { | ||
6702 | global pd_path0 pd_path1 pd_path2 pd_path3 pd_path4 | ||
6703 | global pd_path5 pd_path6 pd_path7 pd_path8 pd_path9 | ||
6704 | |||
6705 | toplevel $id | ||
6706 | wm title $id {PD search path for patches and other files} | ||
6707 | wm protocol $id WM_DELETE_WINDOW [concat path_cancel $id] | ||
6708 | |||
6709 | frame $id.buttonframe | ||
6710 | pack $id.buttonframe -side bottom -fill x -pady 2m | ||
6711 | button $id.buttonframe.cancel -text {Cancel}\ | ||
6712 | -command "path_cancel $id" | ||
6713 | button $id.buttonframe.apply -text {Apply}\ | ||
6714 | -command "path_apply $id" | ||
6715 | button $id.buttonframe.ok -text {OK}\ | ||
6716 | -command "path_ok $id" | ||
6717 | pack $id.buttonframe.cancel -side left -expand 1 | ||
6718 | pack $id.buttonframe.apply -side left -expand 1 | ||
6719 | pack $id.buttonframe.ok -side left -expand 1 | ||
6720 | |||
6721 | for {set x 0} {$x < 10} {incr x} { | ||
6722 | # input device 1 | ||
6723 | entry $id.f$x -textvariable pd_path$x -width 80 | ||
6724 | bind $id.f$x <KeyPress-Return> [concat path_ok $id] | ||
6725 | pack $id.f$x -side top | ||
6726 | } | ||
6727 | |||
6728 | focus $id.f0 | ||
6729 | } | ||
6730 | |||
6731 | proc pd_set {var value} { | ||
6732 | global $var | ||
6733 | set $var $value | ||
6734 | } | ||