summaryrefslogtreecommitdiff
path: root/apps/plugins/pdbox/PDa/src/u_main.tk
diff options
context:
space:
mode:
Diffstat (limited to 'apps/plugins/pdbox/PDa/src/u_main.tk')
-rw-r--r--apps/plugins/pdbox/PDa/src/u_main.tk3366
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}
3368set 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:
3385set pd_tearoff 0
3386set menubar 1
3387
3388set File "F"
3389set Windows "W"
3390set Edit "E"
3391set Find "F"
3392set Put "P"
3393set Media "M"
3394set Help "H"
3395
3396set color grey16
3397set lightcolor grey24
3398
3399option add *font -*-helvetica-*--bold--9-*
3400
3401# los colores de la muerte
3402
3403option add *background $color
3404option add *activeBackground $lightcolor
3405
3406option add *foreground white
3407option add *activeForeground white
3408
3409option add *troughColor $lightcolor
3410
3411option add *highlightThickness 0
3412option add *relief solid startupFile
3413
3414if {$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
3424if {$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
3436if {$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
3448bind all <Key-Tab> ""
3449bind all <<PrevWindow>> ""
3450bind Text <Control-t> {}
3451bind Text <Control-s> {}
3452# puts stderr [bind all]
3453
3454################## set up main window #########################
3455menu .mbar
3456canvas .dummy -height 2p -width 6c
3457
3458frame .controls
3459pack .controls .dummy -side top -fill x
3460menu .mbar.file -tearoff $pd_tearoff
3461.mbar add cascade -label "$File" -menu .mbar.file
3462menu .mbar.find -tearoff $pd_tearoff
3463.mbar add cascade -label "$Find" -menu .mbar.find
3464menu .mbar.windows -postcommand [concat pdtk_fixwindowmenu] -tearoff $pd_tearoff
3465menu .mbar.audio -tearoff $pd_tearoff
3466if {$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}
3474menu .mbar.help -tearoff $pd_tearoff
3475.mbar add cascade -label "$Help" -menu .mbar.help
3476
3477set ctrls_audio_on 0
3478set ctrls_meter_on 0
3479set ctrls_inlevel 0
3480set ctrls_outlevel 0
3481
3482frame .controls.switches
3483checkbutton .controls.switches.audiobutton -text {compute audio} \
3484 -variable ctrls_audio_on \
3485 -anchor w \
3486 -command {pd [concat pd dsp $ctrls_audio_on \;]}
3487
3488checkbutton .controls.switches.meterbutton -text {peak meters} \
3489 -variable ctrls_meter_on \
3490 -anchor w \
3491 -command {pd [concat pd meters $ctrls_meter_on \;]}
3492
3493pack .controls.switches.meterbutton .controls.switches.audiobutton -side left
3494
3495frame .controls.inout
3496frame .controls.inout.in
3497label .controls.inout.in.label -text IN
3498entry .controls.inout.in.level -textvariable ctrls_inlevel -width 3
3499button .controls.inout.in.clip -text {CLIP} -state disabled
3500pack .controls.inout.in.label .controls.inout.in.level \
3501 .controls.inout.in.clip -side top -pady 2
3502
3503frame .controls.inout.out
3504label .controls.inout.out.label -text OUT
3505entry .controls.inout.out.level -textvariable ctrls_outlevel -width 3
3506button .controls.inout.out.clip -text {CLIP} -state disabled
3507pack .controls.inout.out.label .controls.inout.out.level \
3508 .controls.inout.out.clip -side top -pady 2
3509
3510button .controls.dio -text "DIO\nerrors" \
3511 -command {pd [concat pd audiostatus \;]}
3512
3513pack .controls.switches -side bottom -pady 12
3514pack .controls.inout.in .controls.inout.out -side left -padx 6
3515pack .controls.inout -side left -padx 14
3516pack .controls.dio -side right -padx 20
3517
3518bind . <Control-Key> {pdtk_pd_ctrlkey %W %K 0}
3519bind . <Control-Shift-Key> {pdtk_pd_ctrlkey %W %K 1}
3520if {$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
3526wm title . "PDa"
3527. configure -menu .mbar -width 200 -height 150
3528
3529############### set up global variables ################################
3530
3531set untitled_number 1
3532set untitled_directory [pwd]
3533set saveas_client doggy
3534set pd_opendir $untitled_directory
3535set pd_undoaction no
3536set pd_redoaction no
3537set pd_undocanvas no
3538
3539################ utility functions #########################
3540
3541proc pdtk_enquote {x} {
3542 set foo [string map {"," "" ";" "" \" ""} $x]
3543 set foo2 [string map {" " "\\ "} $foo]
3544 concat $foo2
3545}
3546
3547proc pdtk_debug {x} {
3548 tk_messageBox -message $x -type ok
3549}
3550
3551proc pdtk_watchdog {} {
3552 pd [concat pd ping \;]
3553 after 2000 {pdtk_watchdog}
3554}
3555
3556proc 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
3563set menu_windowlist {}
3564
3565proc 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
3577proc 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 ########################
3595proc 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
3608proc 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 #########################
3630proc 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 #########################
3644proc menu_really_quit {} {pd {pd quit;}}
3645
3646proc menu_quit {} {pd {pd quit;}}
3647
3648######### the "Pd" menu command, which puts the Pd window on top ########
3649proc menu_pop_pd {} {raise .}
3650
3651######### the "audio" menu command ###############
3652proc menu_audio {flag} {pd [concat pd dsp $flag \;]}
3653
3654######### the "documentation" menu command ###############
3655
3656set doc_number 1
3657
3658proc 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
3681set help_directory $pd_guidir/doc
3682
3683proc 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
3718proc 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
3733proc 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
3788proc menu_save {name} {
3789 pdtk_canvas_checkgeometry $name
3790 pd [concat $name menusave \;]
3791}
3792
3793proc menu_saveas {name} {
3794 pdtk_canvas_checkgeometry $name
3795 pd [concat $name menusaveas \;]
3796}
3797
3798proc 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
3808proc menu_close {name} {
3809 pd [concat $name menuclose \;]
3810}
3811
3812proc 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
3821proc 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
3830proc menu_cut {name} {
3831 pd [concat $name cut \;]
3832}
3833
3834proc menu_copy {name} {
3835 pd [concat $name copy \;]
3836}
3837
3838proc menu_paste {name} {
3839 pd [concat $name paste \;]
3840}
3841
3842proc menu_duplicate {name} {
3843 pd [concat $name duplicate \;]
3844}
3845
3846proc menu_selectall {name} {
3847 pd [concat $name selectall \;]
3848}
3849
3850proc menu_texteditor {name} {
3851 pd [concat $name texteditor \;]
3852}
3853
3854proc menu_font {name} {
3855 pd [concat $name menufont \;]
3856}
3857
3858proc menu_tidyup {name} {
3859 pd [concat $name tidy \;]
3860}
3861
3862proc menu_editmode {name} {
3863 pd [concat $name editmode 0 \;]
3864}
3865
3866proc menu_object {name accel} {
3867 pd [concat $name obj $accel \;]
3868}
3869
3870proc menu_message {name accel} {
3871 pd [concat $name msg $accel \;]
3872}
3873
3874proc menu_floatatom {name accel} {
3875 pd [concat $name floatatom $accel \;]
3876}
3877
3878proc menu_symbolatom {name accel} {
3879 pd [concat $name symbolatom $accel \;]
3880}
3881
3882proc menu_comment {name accel} {
3883 pd [concat $name text $accel \;]
3884}
3885
3886proc menu_graph {name} {
3887 pd [concat $name graph \;]
3888}
3889
3890proc menu_array {name} {
3891 pd [concat $name menuarray \;]
3892}
3893
3894############iemlib##################
3895proc menu_bng {name accel} {
3896 pd [concat $name bng $accel \;]
3897}
3898
3899proc menu_toggle {name accel} {
3900 pd [concat $name toggle $accel \;]
3901}
3902
3903proc menu_numbox {name accel} {
3904 pd [concat $name numbox $accel \;]
3905}
3906
3907proc menu_vslider {name accel} {
3908 pd [concat $name vslider $accel \;]
3909}
3910
3911proc menu_hslider {name accel} {
3912 pd [concat $name hslider $accel \;]
3913}
3914
3915proc menu_hradio {name accel} {
3916 pd [concat $name hradio $accel \;]
3917}
3918
3919proc menu_vradio {name accel} {
3920 pd [concat $name vradio $accel \;]
3921}
3922
3923proc menu_vumeter {name accel} {
3924 pd [concat $name vumeter $accel \;]
3925}
3926
3927proc 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
3935proc 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
3955proc 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
3969proc menu_windowparent {name} {
3970 pd [concat $name findparent \;]
3971}
3972
3973proc menu_findagain {name} {
3974 pd [concat $name findagain \;]
3975}
3976
3977proc menu_finderror {} {
3978 pd [concat pd finderror \;]
3979}
3980
3981proc menu_domenuwindow {i} {
3982 raise $i
3983}
3984
3985proc 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
4006set find_canvas nobody
4007set find_string ""
4008set find_count 1
4009
4010proc 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
4022proc find_cancel {name} {
4023 after 50 destroy $name
4024}
4025
4026proc 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
4061proc 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 ###############
4279proc 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
4375proc canvastosym {name} {
4376 string range $name 0 [expr [string length $name] - 3]
4377}
4378
4379set pdtk_lastcanvasconfigured ""
4380set pdtk_lastcanvasconfiguration ""
4381
4382proc 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
4395proc 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
4400proc pdtk_canvas_shiftclick {name x y b} {
4401 pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 1 \;
4402}
4403
4404proc pdtk_canvas_ctrlclick {name x y b} {
4405 pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 2 \;
4406}
4407
4408proc pdtk_canvas_altclick {name x y b} {
4409 pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 3 \;
4410}
4411
4412proc pdtk_canvas_dblclick {name x y b} {
4413 pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 4 \;
4414}
4415
4416set pdtk_canvas_mouseup_name 0
4417set pdtk_canvas_mouseup_xminval 0
4418set pdtk_canvas_mouseup_xmaxval 0
4419set pdtk_canvas_mouseup_yminval 0
4420set pdtk_canvas_mouseup_ymaxval 0
4421
4422proc 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
4472proc 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
4500proc 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
4510proc 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
4526proc 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
4563proc 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.
4571proc pdtk_canvas_map {name} {
4572# puts stderr [concat map $name]
4573 pd [canvastosym $name] map 1 \;
4574}
4575
4576proc pdtk_canvas_unmap {name} {
4577# puts stderr [concat unmap $name]
4578 pd [canvastosym $name] map 0 \;
4579}
4580
4581set saveas_dir nowhere
4582
4583############ pdtk_canvas_saveas -- run a saveas dialog ##############
4584
4585proc 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
4603set fontsize 0
4604set stretchval 0
4605set whichstretch 0
4606
4607proc 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
4616proc dofont_cancel {name} {
4617 set cmd [concat $name cancel \;]
4618# puts stderr $cmd
4619 pd $cmd
4620}
4621
4622proc 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
4691proc 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
4712proc 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
4728proc 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
4762proc dogatom_cancel {name} {
4763 set cmd [concat $name cancel \;]
4764# puts stderr $cmd
4765 pd $cmd
4766}
4767
4768proc dogatom_ok {name} {
4769 dogatom_apply $name
4770 dogatom_cancel $name
4771}
4772
4773proc 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
4888set popup_xpix 0
4889set popup_ypix 0
4890
4891proc 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
4898proc 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
4921proc 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
4948proc graph_cancel {id} {
4949 set cmd [concat $id cancel \;]
4950# puts stderr $cmd
4951 pd $cmd
4952}
4953
4954proc graph_ok {id} {
4955 graph_apply $id
4956 graph_cancel $id
4957}
4958
4959proc 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
5043set iemgui_define_min_flashhold 50
5044set iemgui_define_min_flashbreak 10
5045set iemgui_define_min_fontsize 4
5046
5047proc 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
5069proc 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
5085proc 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
5122proc 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
5151proc 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
5165proc 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
5195proc 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
5213proc 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
5249proc 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
5272proc 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
5285proc 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
5300proc 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
5315proc 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
5409proc iemgui_cancel {id} {pd [concat $id cancel \;]}
5410
5411proc iemgui_ok {id} {
5412 iemgui_apply $id
5413 iemgui_cancel $id
5414}
5415
5416proc 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 #########
5757proc 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
5780proc array_cancel {id} {
5781 set cmd [concat $id cancel \;]
5782 pd $cmd
5783}
5784
5785proc array_ok {id} {
5786 array_apply $id
5787 array_cancel $id
5788}
5789
5790proc 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 #########
5863proc 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
5882proc canvas_cancel {id} {
5883 set cmd [concat $id cancel \;]
5884 pd $cmd
5885}
5886
5887proc canvas_ok {id} {
5888 canvas_apply $id
5889 canvas_cancel $id
5890}
5891
5892proc 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 #########
5954proc 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
5969proc dodata_cancel {name} {
5970 set cmd [concat $name cancel \;]
5971# puts stderr $cmd
5972 pd $cmd
5973}
5974
5975proc dodata_ok {name} {
5976 dodata_send $name
5977 dodata_cancel $name
5978}
5979
5980proc 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#######################
6008proc 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###########
6018proc 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 ##################
6028proc 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
6035proc 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
6053proc 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 ###################
6105proc 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
6111proc 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
6129proc 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 ###################
6140set edit_number 1
6141
6142proc 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
6153proc texteditor_ok {name} {
6154 set topname [string trimright $name .text]
6155 texteditor_send $name
6156 destroy $topname
6157}
6158
6159
6160proc 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
6190proc 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
6203proc 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
6212set com1 0
6213set com2 0
6214set com3 0
6215set com4 0
6216
6217proc 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
6225proc 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
6235if {$pd_nt == 1} {
6236 proc polleofloop {} {
6237 pd_pollsocket
6238 after 20 polleofloop
6239 }
6240
6241 polleofloop
6242}
6243
6244####################### audio dialog ##################3
6245
6246proc 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
6275proc audio_cancel {id} {
6276 pd [concat $id cancel \;]
6277}
6278
6279proc audio_ok {id} {
6280 audio_apply $id
6281 audio_cancel $id
6282}
6283
6284# callback from popup menu
6285proc 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
6293proc 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
6312proc 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
6500proc 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
6516proc midi_cancel {id} {
6517 pd [concat $id cancel \;]
6518}
6519
6520proc midi_ok {id} {
6521 midi_apply $id
6522 midi_cancel $id
6523}
6524
6525# callback from popup menu
6526proc 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
6534proc 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
6550proc 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
6681proc 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
6691proc path_cancel {id} {
6692 pd [concat $id cancel \;]
6693}
6694
6695proc path_ok {id} {
6696 path_apply $id
6697 path_cancel $id
6698}
6699set pd_path0 sdfgh
6700
6701proc 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
6731proc pd_set {var value} {
6732 global $var
6733 set $var $value
6734}
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-12 17:34:47 +0000