diff options
author | Peter D'Hoye <peter.dhoye@gmail.com> | 2009-05-24 21:28:16 +0000 |
---|---|---|
committer | Peter D'Hoye <peter.dhoye@gmail.com> | 2009-05-24 21:28:16 +0000 |
commit | 526b5580dabbfed7cfe5439dc3a90ec727f563c2 (patch) | |
tree | 22b1af92348785daad16714ee5e2b633017e0e48 /apps/plugins/pdbox/PDa/src/u_main.tk | |
parent | 4f2dfcc01b260d946044ef2b6af5fe36cb772c8d (diff) | |
download | rockbox-526b5580dabbfed7cfe5439dc3a90ec727f563c2.tar.gz rockbox-526b5580dabbfed7cfe5439dc3a90ec727f563c2.zip |
Cut the files in half and it might work better (note to self: check your tree is really clean before patching)
git-svn-id: svn://svn.rockbox.org/rockbox/trunk@21070 a1c6a512-1295-4272-9138-f99709370657
Diffstat (limited to 'apps/plugins/pdbox/PDa/src/u_main.tk')
-rw-r--r-- | apps/plugins/pdbox/PDa/src/u_main.tk | 3366 |
1 files changed, 0 insertions, 3366 deletions
diff --git a/apps/plugins/pdbox/PDa/src/u_main.tk b/apps/plugins/pdbox/PDa/src/u_main.tk index 00cb25c4a2..e8d5702f32 100644 --- a/apps/plugins/pdbox/PDa/src/u_main.tk +++ b/apps/plugins/pdbox/PDa/src/u_main.tk | |||
@@ -3365,3370 +3365,4 @@ proc pd_set {var value} { | |||
3365 | global $var | 3365 | global $var |
3366 | set $var $value | 3366 | set $var $value |
3367 | } | 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 | 3368 | ||
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 | } | ||