diff options
Diffstat (limited to 'pd/src/u_main.tk.test')
-rw-r--r-- | pd/src/u_main.tk.test | 2686 |
1 files changed, 0 insertions, 2686 deletions
diff --git a/pd/src/u_main.tk.test b/pd/src/u_main.tk.test deleted file mode 100644 index fc32a321..00000000 --- a/pd/src/u_main.tk.test +++ /dev/null @@ -1,2686 +0,0 @@ -set pd_nt 0 -# (The above is 0 for unix, 1 for microsoft, and 2 for Mac OSX. The first -# line is automatically munged by the relevant makefiles.) - -# Copyright (c) 1997-1999 Miller Puckette. -# For information on usage and redistribution, and for a DISCLAIMER OF ALL -# WARRANTIES, see the file, "LICENSE.txt," in this distribution. - -# changed by Thomas Musil 09.2001 -# between "pdtk_graph_dialog -- dialog window for graphs" -# and "pdtk_array_dialog -- dialog window for arrays" -# a new dialogbox was inserted, named: -# "pdtk_iemgui_dialog -- dialog window for iem guis" -# -# there are 2 new features: 1.) line-delete-protection in edit-menue -# -# 2.) there are all iem-guis in a seperated put-gui-menue -# -# all this changes are labeled with #######iemlib########## - -if {$pd_nt == 1} { - global pd_guidir - set pd_gui2 [string range $argv0 0 [expr [string last \\ $argv0 ] - 1]] - regsub -all \\\\ $pd_gui2 / pd_gui3 - set pd_guidir $pd_gui3/.. - load $pd_guidir/bin/pdtcl -} - -if {$pd_nt == 2} { - global pd_guidir - set pd_gui2 [string range $argv0 0 [expr [string last / $argv0 ] - 1]] - set pd_guidir $pd_gui2/.. - load $pd_guidir/bin/pdtcl -} - -# it's unfortunate but we seem to have to turn off global bindings -# for Text objects to get control-s and control-t to do what we want for -# "text" dialogs below. Also we have to get rid of tab's changing the focus. - -bind all <Key-Tab> "" -bind all <Shift-Key-Tab> "" -bind Text <Control-t> {} -bind Text <Control-s> {} -# puts stderr [bind all] - -################## set up main window ######################### -frame .mbar -relief raised -bd 2 -canvas .dummy -height 1c -width 1c -frame .controls -pack .mbar .controls .dummy -side top -fill x -menubutton .mbar.file -text File -menu .mbar.file.menu -menubutton .mbar.find -text Find -menu .mbar.find.menu -menubutton .mbar.windows -text Windows -menu .mbar.windows.menu -menubutton .mbar.audio -text Audio -menu .mbar.audio.menu -menubutton .mbar.help -text Help -menu .mbar.help.menu -pack .mbar.file .mbar.find .mbar.windows .mbar.audio -side left -pack .mbar.help -side right -menu .mbar.file.menu -menu .mbar.find.menu -menu .mbar.windows.menu -postcommand [concat pdtk_fixwindowmenu] -menu .mbar.audio.menu -menu .mbar.help.menu - -set ctrls_audio_on 0 -set ctrls_meter_on 0 -set ctrls_inlevel 0 -set ctrls_outlevel 0 - -frame .controls.switches -checkbutton .controls.switches.audiobutton -text {compute audio} \ - -variable ctrls_audio_on \ - -anchor w \ - -command {pd [concat pd dsp $ctrls_audio_on \;]} - -checkbutton .controls.switches.meterbutton -text {peak meters} \ - -variable ctrls_meter_on \ - -anchor w \ - -command {pd [concat pd meters $ctrls_meter_on \;]} - -pack .controls.switches.meterbutton .controls.switches.audiobutton -side left - -frame .controls.in -label .controls.in.label -text IN -entry .controls.in.level -textvariable ctrls_inlevel -width 3 -button .controls.in.clip -text {CLIP} -state disabled -pack .controls.in.label .controls.in.level .controls.in.clip -side top - -frame .controls.out -label .controls.out.label -text OUT -entry .controls.out.level -textvariable ctrls_outlevel -width 3 -button .controls.out.clip -text {CLIP} -state disabled -pack .controls.out.label .controls.out.level .controls.out.clip -side top - -button .controls.dio -text "DIO\nerrors" \ - -command {pd [concat pd audiostatus \;]} - -pack .controls.switches -side bottom -pack .controls.in .controls.out -side left -pack .controls.dio -side right - -bind . <Control-Key> {pdtk_pd_ctrlkey %W %K 0} -bind . <Control-Shift-Key> {pdtk_pd_ctrlkey %W %K 1} - - -############### set up global variables ################################ - -set untitled_number 1 -set untitled_directory [pwd] -set saveas_client doggy -set pd_opendir $untitled_directory -############iemlib################## -# need it to know, if new or open file -set iem_new_open_flag "open" -############iemlib################## - -################ utility functions ######################### - -proc pdtk_enquote {x} { - set foo [string map {"," "" ";" "" \" ""} $x] - set foo2 [string map {" " "\\ "} $foo] - concat $foo2 -} - -proc pdtk_debug {x} { - tk_messageBox -message $x -type ok -} - -proc pdtk_watchdog {} { - pd [concat pd ping \;] - after 2000 {pdtk_watchdog} -} - -proc pdtk_check {x message} { - set answer [tk_messageBox \-message $x \-type yesno \-icon question] - switch $answer { - yes {pd $message} } -# no {tk_messageBox \-message "cancelled" \-type ok} -} - -set menu_windowlist {} - -proc pdtk_fixwindowmenu {} { - global menu_windowlist - .mbar.windows.menu delete 0 end - foreach i $menu_windowlist { - .mbar.windows.menu add command -label [lindex $i 0] \ - -command [concat menu_domenuwindow [lindex $i 1]] - } -} - -############### the "New" menu command ######################## -proc menu_new {} { - global untitled_number - global untitled_directory -############iemlib################## - global iem_new_open_flag - - set iem_new_open_flag "new" -############iemlib################## - pd [concat pd filename Untitled-$untitled_number $untitled_directory \;] - pd { - #N canvas; - #X pop 1; - } - set untitled_number [expr $untitled_number + 1] -} - -################## the "Open" menu command ######################### - -proc menu_open {} { - global pd_opendir - global pd_nt -############iemlib################## - global iem_new_open_flag - - set iem_new_open_flag "open" -############iemlib################## - -# workaround -- initialdir doesn't work on MACOSX yet --- - if {$pd_nt == 2} { - cd $pd_opendir - set filename [tk_getOpenFile -defaultextension .pd \ - -filetypes { {{pd files} {.pd}} {{max files} {.pat}}} ] - } else { - set filename [tk_getOpenFile -defaultextension .pd \ - -filetypes { {{pd files} {.pd}} {{max files} {.pat}}} \ - -initialdir $pd_opendir] - } -# puts stderr $filename - if {$filename != ""} { - set directory [string range $filename 0 \ - [expr [string last / $filename ] - 1]] - set pd_opendir $directory - set basename [string range $filename \ - [expr [string last / $filename ] + 1] end] - -# pd_debug [concat file $filename base $basename dir $directory] - - pd [concat pd open [pdtk_enquote $basename] \ - [pdtk_enquote $directory]\;] - } -} - -################## the "Message" menu command ######################### -proc menu_send {} { - toplevel .sendpanel - entry .sendpanel.entry -textvariable send_textvariable - pack .sendpanel.entry -side bottom -fill both -ipadx 100 - .sendpanel.entry select from 0 - .sendpanel.entry select adjust end - bind .sendpanel.entry <KeyPress-Return> { - pd [concat $send_textvariable \;] - after 50 {destroy .sendpanel} - } - focus .sendpanel.entry -} - -################## the "Quit" menu command ######################### -proc menu_really_quit {} {pd {pd quit;}} - -proc menu_quit {} {pdtk_check {Really quit?} {pd quit;}} - -######### the "Pd" menu command, which puts the Pd window on top ######## -proc menu_pop_pd {} {raise .} - -######### the "audio" menu command ############### -proc menu_audio {flag} {pd [concat pd dsp $flag \;]} - -######### the "documentation" menu command ############### - -set doc_number 1 - -proc menu_opentext {filename} { - global doc_number - global pd_guidir - global pd_myversion - set name [format ".help%d" $doc_number] - toplevel $name - text $name.text -relief raised -bd 2 -font fixed \ - -yscrollcommand "$name.scroll set" -background white - scrollbar $name.scroll -command "$name.text yview" - pack $name.scroll -side right -fill y - pack $name.text -side left -fill both -expand 1 - - set f [open $filename] - while {![eof $f]} { - set bigstring [read $f 1000] - regsub -all PD_BASEDIR $bigstring $pd_guidir bigstring2 - regsub -all PD_VERSION $bigstring2 $pd_myversion bigstring3 - $name.text insert end $bigstring3 - } - close $f - set doc_number [expr $doc_number + 1] -} - -set help_directory $pd_guidir/doc - -proc menu_documentation {} { - global help_directory - global pd_nt -############iemlib################## - global iem_new_open_flag - - set iem_new_open_flag "open" -############iemlib################## - - if {$pd_nt == 2} { - cd $help_directory - set filename [tk_getOpenFile -defaultextension .pd \ - -filetypes { {{documentation} {.pd .txt .htm}} } ] - } else { - set filename [tk_getOpenFile -defaultextension .pd \ - -filetypes { {{documentation} {.pd .txt .htm}} } \ - -initialdir $help_directory] - } - - if {$filename != ""} { - if {[string first .txt $filename] >= 0} { - menu_opentext $filename - } elseif {[string first .htm $filename] >= 0} { - if {$pd_nt == 0} { -#I wish I could get this to run in the background; the "&" doesn't do it: - exec sh -c \ - [format "mozilla file:%s || netscape file:%s &\n" \ - $filename $filename] - } else { - tk_messageBox -message \ - {sorry -- can't open htm files yet; open this manually} \ - -type ok - } - } else { - set help_directory [string range $filename 0 \ - [expr [string last / $filename ] - 1]] - set basename [string range $filename \ - [expr [string last / $filename ] + 1] end] - pd [concat pd open [pdtk_enquote $basename] \ - [pdtk_enquote $help_directory] \;] - } - } -} - -proc menu_doc_open {subdir basename} { - global pd_guidir -############iemlib################## - global iem_new_open_flag - - set iem_new_open_flag "open" -############iemlib################## - - set dirname $pd_guidir/$subdir - - if {[string first .txt $basename] >= 0} { - menu_opentext $dirname/$basename - } else { - pd [concat pd open [pdtk_enquote $basename] \ - [pdtk_enquote $dirname] \;] - } -} - -#################### the "File" menu for the Pd window ############## -.mbar.file.menu add command -label New -command {menu_new} \ - -accelerator "Ctrl+n" -.mbar.file.menu add command -label Open -command {menu_open} \ - -accelerator "Ctrl+o" -.mbar.file.menu add command -label Message -command {menu_send} \ - -accelerator "Ctrl+m" -.mbar.file.menu add separator -.mbar.file.menu add command -label Quit -command {menu_quit} \ - -accelerator "Ctrl+q" - -#################### the "Find" menu for the Pd window ############## -.mbar.find.menu add command -label {last error?} -command {menu_finderror} - -#################### the "Audio" menu for the Pd window ############## -.mbar.audio.menu add command -label On -accelerator "Ctrl+/" \ - -command {menu_audio 1} -.mbar.audio.menu add command -label Off -accelerator "Ctrl+." \ - -command {menu_audio 0} - -#################### the "Help" menu for the Pd window ############## -.mbar.help.menu add command -label {About Pd} \ - -command {menu_doc_open doc/1.manual 1.introduction.txt} -.mbar.help.menu add command -label {Test Audio and MIDI} \ - -command {menu_doc_open doc/7.stuff/tools testtone.pd} -.mbar.help.menu add command -label {Load Meter} \ - -command {menu_doc_open doc/7.stuff/tools load-meter.pd} -.mbar.help.menu add command -label {Pure Documentation...} \ - -command {menu_documentation} - -########### functions for menu functions on document windows ######## - -proc menu_save {name} { - pdtk_canvas_checkgeometry $name - pd [concat $name menusave \;] -} - -proc menu_saveas {name} { - pdtk_canvas_checkgeometry $name - pd [concat $name menusaveas \;] -} - -proc menu_print {name} { - $name.c postscript -file x.ps -} - -proc menu_close {name} { - pd [concat $name menuclose \;] -} - -proc menu_cut {name} { - pd [concat $name cut \;] -} - -proc menu_copy {name} { - pd [concat $name copy \;] -} - -proc menu_paste {name} { - pd [concat $name paste \;] -} - -proc menu_duplicate {name} { - pd [concat $name duplicate \;] -} - -proc menu_selectall {name} { - pd [concat $name selectall \;] -} - -proc menu_texteditor {name} { - pd [concat $name texteditor \;] -} - -proc menu_font {name} { - pd [concat $name menufont \;] -} - -proc menu_tidyup {name} { - pd [concat $name tidy \;] -} - -proc menu_editmode {name} { - pd [concat $name editmode 0 \;] -} - -proc menu_object {name accel} { - pd [concat $name obj $accel \;] -} - -proc menu_message {name accel} { - pd [concat $name msg $accel \;] -} - -proc menu_floatatom {name accel} { - pd [concat $name floatatom $accel \;] -} - -proc menu_symbolatom {name accel} { - pd [concat $name symbolatom $accel \;] -} - -proc menu_comment {name accel} { - pd [concat $name text $accel \;] -} - -proc menu_graph {name} { - pd [concat $name graph \;] -} - -proc menu_array {name} { - pd [concat $name menuarray \;] -} - -############iemlib################## -proc menu_bng {name accel} { - pd [concat $name bng $accel \;] -} - -proc menu_toggle {name accel} { - pd [concat $name toggle $accel \;] -} - -proc menu_numbox {name accel} { - pd [concat $name numbox $accel \;] -} - -proc menu_vslider {name accel} { - pd [concat $name vslider $accel \;] -} - -proc menu_hslider {name accel} { - pd [concat $name hslider $accel \;] -} - -proc menu_hdial {name accel} { - pd [concat $name hdial $accel \;] -} - -proc menu_vdial {name accel} { - pd [concat $name vdial $accel \;] -} - -proc menu_vumeter {name accel} { - pd [concat $name vumeter $accel \;] -} - -proc menu_mycnv {name accel} { - pd [concat $name mycnv $accel \;] -} - -proc menu_protectmode {name} { - pd [concat $name protectmode 0 \;] -} - -############iemlib################## - -proc menu_windowparent {name} { - pd [concat $name findparent \;] -} - -proc menu_findagain {name} { - pd [concat $name findagain \;] -} - -proc menu_finderror {} { - pd [concat pd finderror \;] -} - -proc menu_domenuwindow {i} { - raise $i -} - -proc menu_fixwindowmenu {name} { - global menu_windowlist - $name.m.windows.m add command - $name.m.windows.m delete 4 end - foreach i $menu_windowlist { - $name.m.windows.m add command -label [lindex $i 0] \ - -command [concat menu_domenuwindow [lindex $i 1]] - } -} - -################## the "find" menu item ################### - -set find_canvas nobody -set find_string "" -set find_count 1 - -proc find_apply {name} { - global find_string - global find_canvas - regsub -all \; $find_string " _semi_ " find_string2 - regsub -all \, $find_string2 " _comma_ " find_string3 -# puts stderr [concat $find_canvas find $find_string3 \ -# \;] - pd [concat $find_canvas find $find_string3 \ - \;] - after 50 destroy $name -} - -proc find_cancel {name} { - after 50 destroy $name -} - -proc menu_findobject {canvas} { - global find_string - global find_canvas - global find_count - - set name [format ".find%d" $find_count] - set find_count [expr $find_count + 1] - - set find_canvas $canvas - - toplevel $name - - label $name.label -text {find...} - pack $name.label -side top - - entry $name.entry -textvariable find_string - pack $name.entry -side top - - frame $name.buttonframe - pack $name.buttonframe -side bottom -fill x -pady 2m - button $name.buttonframe.cancel -text {Cancel}\ - -command "find_cancel $name" - button $name.buttonframe.ok -text {OK}\ - -command "find_apply $name" - pack $name.buttonframe.cancel -side left -expand 1 - pack $name.buttonframe.ok -side left -expand 1 - - $name.entry select from 0 - $name.entry select adjust end - bind $name.entry <KeyPress-Return> [ concat find_apply $name] - focus $name.entry -} - - -############# pdtk_canvas_new -- create a new canvas ############### -proc pdtk_canvas_new {name width height geometry} { - global pd_opendir - global iem_new_open_flag - - toplevel $name - frame $name.m -relief raised -bd 2 -# puts stderr [concat geometry: $geometry] - wm geometry $name $geometry - canvas $name.c -width $width -height $height -background white \ - -yscrollcommand "$name.scrollvert set" \ - -xscrollcommand "$name.scrollhort set" \ - -scrollregion [concat 0 0 $width $height] - - scrollbar $name.scrollvert -command "$name.c yview" - scrollbar $name.scrollhort -command "$name.c xview" \ - -orient horizontal - - pack $name.m -side top -fill x - pack $name.scrollhort -side bottom -fill x - pack $name.scrollvert -side right -fill y - pack $name.c -side left -expand 1 -fill both - wm minsize $name 1 1 - wm geometry $name $geometry - -# the file menu - - menubutton $name.m.file -text File -menu $name.m.file.m - pack $name.m.file -side left - menu $name.m.file.m - - $name.m.file.m add command -label New -command {menu_new} \ - -accelerator "Ctrl+n" - - $name.m.file.m add command -label Open -command {menu_open} \ - -accelerator "Ctrl+o" - - $name.m.file.m add command -label Message -command {menu_send} \ - -accelerator "Ctrl+m" - - $name.m.file.m add separator - $name.m.file.m add command -label Save -command [concat menu_save $name] \ - -accelerator "Ctrl+s" - - $name.m.file.m add command -label Close \ - -command [concat menu_close $name] \ - -accelerator "Ctrl+w" - - $name.m.file.m add command -label "Save as..." \ - -command [concat menu_saveas $name] \ - -accelerator "Ctrl+S" - - $name.m.file.m add command -label Print -command [concat menu_print $name] \ - -accelerator "Ctrl+p" - - $name.m.file.m add separator - - $name.m.file.m add command -label Quit -command {menu_quit} \ - -accelerator "Ctrl+q" - -# the edit menu - menubutton $name.m.edit -text Edit -menu $name.m.edit.m - pack $name.m.edit -side left - menu $name.m.edit.m - - - $name.m.edit.m add command -label Cut -command [concat menu_cut $name] \ - -accelerator "Ctrl+x" - - $name.m.edit.m add command -label Copy -command [concat menu_copy $name] \ - -accelerator "Ctrl+c" - - $name.m.edit.m add command -label Paste \ - -command [concat menu_paste $name] \ - -accelerator "Ctrl+v" - - $name.m.edit.m add command -label Duplicate \ - -command [concat menu_duplicate $name] \ - -accelerator "Ctrl+d" - - $name.m.edit.m add command -label {Select all} \ - -command [concat menu_selectall $name] \ - -accelerator "Ctrl+a" - - $name.m.edit.m add command -label {Text Editor} \ - -command [concat menu_texteditor $name] \ - -accelerator "Ctrl+t" - - $name.m.edit.m add command -label Font \ - -command [concat menu_font $name] - - $name.m.edit.m add command -label {Tidy Up} \ - -command [concat menu_tidyup $name] - - $name.m.edit.m add separator - -############iemlib################## -# instead of "red = #BC3C60" we take "grey85", so there is no difference, -# if widget is selected or not. - - $name.m.edit.m add checkbutton -label "Edit mode" \ - -indicatoron true -selectcolor grey85 \ - -command [concat menu_editmode $name] \ - -accelerator "Ctrl+e" - - - - $name.m.edit.m add checkbutton -label "Protect" \ - -indicatoron true -selectcolor grey85 \ - -command [concat menu_protectmode $name] \ - -accelerator "Ctrl+r" - - if { $iem_new_open_flag == "open" } { - $name.m.edit.m entryconfigure "Edit mode" -indicatoron false } - $name.m.edit.m entryconfigure "Protect" -indicatoron false - -############iemlib################## - -# the put menu - menubutton $name.m.put -text Put -menu $name.m.put.m - pack $name.m.put -side left - menu $name.m.put.m - - $name.m.put.m add command -label Object \ - -command [concat menu_object $name 0] \ - -accelerator "Ctrl+1" - - $name.m.put.m add command -label Message \ - -command [concat menu_message $name 0] \ - -accelerator "Ctrl+2" - - $name.m.put.m add command -label Number \ - -command [concat menu_floatatom $name 0] \ - -accelerator "Ctrl+3" - - $name.m.put.m add command -label Symbol \ - -command [concat menu_symbolatom $name 0] \ - -accelerator "Ctrl+4" - - $name.m.put.m add command -label Comment \ - -command [concat menu_comment $name 0] \ - -accelerator "Ctrl+5" - -############iemlib################## - - $name.m.put.m add command -label Bang \ - -command [concat menu_bng $name 0] \ - -accelerator "Alt+b" - - $name.m.put.m add command -label Toggle \ - -command [concat menu_toggle $name 0] \ - -accelerator "Alt+t" - - $name.m.put.m add command -label Number2 \ - -command [concat menu_numbox $name 0] \ - -accelerator "Alt+n" - - $name.m.put.m add command -label Vslider \ - -command [concat menu_vslider $name 0] \ - -accelerator "Alt+v" - - $name.m.put.m add command -label Hslider \ - -command [concat menu_hslider $name 0] \ - -accelerator "Alt+h" - - $name.m.put.m add command -label Vdial \ - -command [concat menu_vdial $name 0] \ - -accelerator "Alt+d" - - $name.m.put.m add command -label Hdial \ - -command [concat menu_hdial $name 0] \ - -accelerator "Alt+i" - - $name.m.put.m add command -label VU \ - -command [concat menu_vumeter $name 0] \ - -accelerator "Alt+u" - - $name.m.put.m add command -label Canvas \ - -command [concat menu_mycnv $name 0] \ - -accelerator "Alt+c" - -############iemlib################## - - $name.m.put.m add command -label Graph \ - -command [concat menu_graph $name] - - $name.m.put.m add command -label Array \ - -command [concat menu_array $name] - - - -# the find menu - menubutton $name.m.find -text Find -menu $name.m.find.m - pack $name.m.find -side left - menu $name.m.find.m - $name.m.find.m add command -label {Find...} -accelerator "Ctrl+f" \ - -command [concat menu_findobject $name] - $name.m.find.m add command -label {Find Again} -accelerator "Ctrl+g" \ - -command [concat menu_findagain $name] - $name.m.find.m add command -label {Find last error} \ - -command [concat menu_finderror] - -# the window menu - menubutton $name.m.windows -text Windows -menu $name.m.windows.m - pack $name.m.windows -side left - menu $name.m.windows.m -postcommand [concat menu_fixwindowmenu $name] - $name.m.windows.m add command -label {parent window}\ - -command [concat menu_windowparent $name] - $name.m.windows.m add command -label {Pd window} -command menu_pop_pd - $name.m.windows.m add separator - -# the audio menu - menubutton $name.m.audio -text Audio -menu $name.m.audio.m - pack $name.m.audio -side left - menu $name.m.audio.m - $name.m.audio.m add command -label On -accelerator "Ctrl+/" \ - -command {menu_audio 1} - $name.m.audio.m add command -label Off -accelerator "Ctrl+." \ - -command {menu_audio 0} - -# the help menu - menubutton $name.m.help -text Help -menu $name.m.help.m - pack $name.m.help -side right - menu $name.m.help.m - $name.m.help.m add command -label {Getting Started} \ - -command {menu_doc_open doc/1.manual 1.introduction.txt} - $name.m.help.m add command -label {Test Audio and MIDI} \ - -command {menu_doc_open doc/7.stuff/tools testtone.pd} - $name.m.help.m add command -label {Load Meter} \ - -command {menu_doc_open doc/7.stuff/tools load-meter.pd} - $name.m.help.m add command -label {Pure Documentation} \ - -command {menu_documentation} - -# the popup menu - menu $name.popup -tearoff false - $name.popup add command -label {Properties} \ - -command [concat popup_action $name 0] - $name.popup add command -label {Open} \ - -command [concat popup_action $name 1] - $name.popup add command -label {Help} \ - -command [concat popup_action $name 2] - -# WM protocol - wm protocol $name WM_DELETE_WINDOW [concat menu_close $name] - -# bindings. -# this is idiotic -- how do you just sense what mod keys are down and -# pass them on? I can't find it anywhere. -# Here we encode shift as 1, control 2, alt 4, in agreement -# with definitions in g_canvas.c. The third button gets "8" but we don't -# bother with modifiers there. -# We don't handle multiple clicks yet. - - bind $name.c <Button> {pdtk_canvas_click %W %x %y %b 0} - bind $name.c <Shift-Button> {pdtk_canvas_click %W %x %y %b 1} - bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 2} - bind $name.c <Control-Shift-Button> {pdtk_canvas_click %W %x %y %b 3} - bind $name.c <Alt-Button> {pdtk_canvas_click %W %x %y %b 4} - bind $name.c <Alt-Shift-Button> {pdtk_canvas_click %W %x %y %b 5} - bind $name.c <Alt-Control-Button> {pdtk_canvas_click %W %x %y %b 6} - bind $name.c <Alt-Control-Shift-Button> {pdtk_canvas_click %W %x %y %b 7} - bind $name.c <Button-3> {pdtk_canvas_click %W %x %y %b 8} - - bind $name.c <ButtonRelease> {pdtk_canvas_mouseup %W %x %y %b} - bind $name.c <Control-Key> {pdtk_canvas_ctrlkey %W %K 0} - bind $name.c <Control-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1} - bind $name.c <Alt-Key> {pdtk_canvas_altkey %W %K %A} -# bind $name.c <Mod1-Key> {puts stderr [concat mod1 %W %K %A]} - bind $name.c <Key> {pdtk_canvas_key %W %K %A} - bind $name.c <KeyRelease> {pdtk_canvas_keyup %W %K %A} - bind $name.c <Motion> {pdtk_canvas_motion %W %x %y 0} - bind $name.c <Alt-Motion> {pdtk_canvas_motion %W %x %y 4} - bind $name.c <Map> {pdtk_canvas_map %W %s} -# bind $name.c <Unmap> {puts stderr map} - focus $name.c -# puts stderr "all done" -# after 1 [concat raise $name] -} - -#################### event binding procedures ################ - -#get the name of the toplevel window for a canvas; this is also -#the name of the canvas object in Pd. - -proc canvastosym {name} { - string range $name 0 [expr [string length $name] - 3] -} - -set pdtk_lastcanvasconfigured "" -set pdtk_lastcanvasconfiguration "" - -proc pdtk_canvas_checkgeometry {topname} { - set boo [winfo geometry $topname.c] - set boo2 [wm geometry $topname] - global pdtk_lastcanvasconfigured - global pdtk_lastcanvasconfiguration - if {$topname != $pdtk_lastcanvasconfigured || \ - $boo != $pdtk_lastcanvasconfiguration} { - set pdtk_lastcanvasconfigured $topname - set pdtk_lastcanvasconfiguration $boo - pd $topname relocate $boo $boo2 \; - } -} - -proc pdtk_canvas_click {name x y b f} { -# puts stderr [concat got $f] - pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b $f \; -} - -proc pdtk_canvas_shiftclick {name x y b} { - pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 1 \; -} - -proc pdtk_canvas_ctrlclick {name x y b} { - pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 2 \; -} - -proc pdtk_canvas_altclick {name x y b} { - pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 3 \; -} - -proc pdtk_canvas_dblclick {name x y b} { - pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 4 \; -} - -set pdtk_canvas_mouseup_name 0 -set pdtk_canvas_mouseup_xminval 0 -set pdtk_canvas_mouseup_xmaxval 0 -set pdtk_canvas_mouseup_yminval 0 -set pdtk_canvas_mouseup_ymaxval 0 - -proc pdtk_canvas_mouseup {name x y b} { - pd [concat [canvastosym $name] mouseup [$name canvasx $x] \ - [$name canvasy $y] $b \;] - -# we use the mouseup event to update scrollbar ranges and recheck the -# geometry of the window since I haven't taken the time to figure out -# how to do it right. - - global pdtk_canvas_mouseup_name - global pdtk_canvas_mouseup_xminval - global pdtk_canvas_mouseup_xmaxval - global pdtk_canvas_mouseup_yminval - global pdtk_canvas_mouseup_ymaxval - - set size [$name bbox all] - if {$size != ""} { - set xminval 0 - set yminval 0 - set xmaxval 100 - set ymaxval 100 - set x1 [lindex $size 0] - set x2 [lindex $size 2] - set y1 [lindex $size 1] - set y2 [lindex $size 3] - - if {$x1 < 0} {set xminval $x1} - if {$y1 < 0} {set yminval $y1} - - if {$x2 > 100} {set xmaxval $x2} - if {$y2 > 100} {set ymaxval $y2} - - if {$pdtk_canvas_mouseup_name != $name || \ - $pdtk_canvas_mouseup_xminval != $xminval || \ - $pdtk_canvas_mouseup_xmaxval != $xmaxval || \ - $pdtk_canvas_mouseup_yminval != $yminval || \ - $pdtk_canvas_mouseup_ymaxval != $ymaxval } { - - set newsize "$xminval $yminval $xmaxval $ymaxval" - $name configure -scrollregion $newsize - set pdtk_canvas_mouseup_name $name - set pdtk_canvas_mouseup_xminval $xminval - set pdtk_canvas_mouseup_xmaxval $xmaxval - set pdtk_canvas_mouseup_yminval $yminval - set pdtk_canvas_mouseup_ymaxval $ymaxval - } - - } - pdtk_canvas_checkgeometry [canvastosym $name] -} - -proc pdtk_canvas_key {name key iso} { -# puts stderr [concat down key= $key iso= $iso] -# .controls.switches.meterbutton configure -text $key -# HACK for MAC OSX -- backspace seems different; I don't understand why. -# invesigate this LATER... - global pd_nt - if {$pd_nt == 2} { - if {$key == "BackSpace"} { - set key 8 - set keynum 8 - } - if {$key == "Delete"} { - set key 8 - set keynum 8 - } - } - if {$iso != ""} { - scan $iso %c keynum - pd [canvastosym $name] key 1 $keynum \; - } else { - pd [canvastosym $name] key 1 $key \; - } -} - -proc pdtk_canvas_keyup {name key iso} { -# puts stderr [concat up key= $key iso= $iso] - if {$iso != ""} { - scan $iso %c keynum - pd [canvastosym $name] key 0 $keynum \; - } else { - pd [canvastosym $name] key 0 $key \; - } -} - -proc pdtk_canvas_altkey {name key iso} { -# puts stderr [concat alt-key $iso] -############iemlib################## - set topname [string trimright $name .c] - if {$key == "b" || $key == "B"} {menu_bng $topname 1} - if {$key == "t" || $key == "T"} {menu_toggle $topname 1} - if {$key == "n" || $key == "N"} {menu_numbox $topname 1} - if {$key == "v" || $key == "V"} {menu_vslider $topname 1} - if {$key == "h" || $key == "H"} {menu_hslider $topname 1} - if {$key == "i" || $key == "I"} {menu_hdial $topname 1} - if {$key == "d" || $key == "D"} {menu_vdial $topname 1} - if {$key == "u" || $key == "U"} {menu_vumeter $topname 1} - if {$key == "c" || $key == "C"} {menu_mycnv $topname 1} -############iemlib################## -} - -proc pdtk_canvas_ctrlkey {name key shift} { -# first get rid of ".c" suffix; we'll refer to the toplevel instead - set topname [string trimright $name .c] -# puts stderr [concat ctrl-key $key $topname] - - if {$key == "n" || $key == "N"} {menu_new} - if {$key == "o" || $key == "O"} {menu_open} - if {$key == "m" || $key == "M"} {menu_send} - if {$key == "q" || $key == "Q"} { - if {$shift == 1} {menu_really_quit} else {menu_quit} - } - if {$key == "s" || $key == "S"} { - if {$shift == 1} {menu_saveas $topname} else {menu_save $topname} - } - if {$key == "w" || $key == "W"} {menu_close $topname} - if {$key == "p" || $key == "P"} {menu_print $topname} - if {$key == "x" || $key == "X"} {menu_cut $topname} - if {$key == "c" || $key == "C"} {menu_copy $topname} - if {$key == "v" || $key == "V"} {menu_paste $topname} - if {$key == "d" || $key == "D"} {menu_duplicate $topname} - if {$key == "a" || $key == "A"} {menu_selectall $topname} - if {$key == "t" || $key == "T"} {menu_texteditor $topname} - if {$key == "f" || $key == "F"} {menu_findobject $topname} - if {$key == "g" || $key == "G"} {menu_findagain $topname} - if {$key == "1"} {menu_object $topname 1} - if {$key == "2"} {menu_message $topname 1} - if {$key == "3"} {menu_floatatom $topname 1} - if {$key == "4"} {menu_symbolatom $topname 1} - if {$key == "5"} {menu_comment $topname 1} - if {$key == "slash"} {menu_audio 1} - if {$key == "period"} {menu_audio 0} - if {$key == "e" || $key == "E"} {menu_editmode $topname} -############iemlib################## - if {$key == "r" || $key == "R"} {menu_protectmode $topname} -############iemlib################## -} - -proc pdtk_canvas_motion {name x y mods} { -# puts stderr [concat [canvastosym $name] $name $x $y] - pd [canvastosym $name] motion [$name canvasx $x] [$name canvasy $y] $mods \; -} - -# "map" event tells us when the canvas becomes visible (arg is "0") or -# invisible (arg is ""). Invisibility means the Window Manager has minimized -# us. We don't get a final "unmap" event when we destroy the window. -proc pdtk_canvas_map {name arg} { - if {$arg == "0"} { - pd [canvastosym $name] map 1 \; - } else { - pd [canvastosym $name] map 0 \; - } -} - -set saveas_dir nowhere - -############ pdtk_canvas_saveas -- run a saveas dialog ############## - -proc pdtk_canvas_saveas {name initfile initdir} { - global pd_nt - if {$pd_nt == 2} { - cd $initdir - set filename [tk_getSaveFile -initialfile $initfile \ - -defaultextension .pd \ - -filetypes { {{pd files} {.pd}} {{max files} {.pat}} }] - } else { - set filename [tk_getSaveFile -initialfile $initfile \ - -initialdir $initdir -defaultextension .pd \ - -filetypes { {{pd files} {.pd}} {{max files} {.pat}} }] - } - if {$filename != ""} { - set directory [string range $filename 0 \ - [expr [string last / $filename ] - 1]] - set basename [string range $filename \ - [expr [string last / $filename ] + 1] end] - pd [concat $name savetofile [pdtk_enquote $basename] \ - [pdtk_enquote $directory] \;] -# pd [concat $name savetofile $basename $directory \;] - } -} - -############ pdtk_canvas_dofont -- run a font and resize dialog ######### - -set fontsize 0 -set stretchval 0 -set whichstretch 0 - -proc dofont_apply {name} { - global fontsize - global stretchval - global whichstretch - set cmd [concat $name font $fontsize $stretchval $whichstretch \;] -# puts stderr $cmd - pd $cmd -} - -proc dofont_cancel {name} { - set cmd [concat $name cancel \;] -# puts stderr $cmd - pd $cmd -} - -proc pdtk_canvas_dofont {name initsize} { - - global fontsize - set fontsize $initsize - - global stretchval - set stretchval 100 - - global whichstretch - set whichstretch 1 - - toplevel $name - wm title $name {FONT BOMB} - wm protocol $name WM_DELETE_WINDOW [concat dofont_cancel $name] - - frame $name.buttonframe - pack $name.buttonframe -side bottom -fill x -pady 2m - button $name.buttonframe.cancel -text {Cancel}\ - -command "dofont_cancel $name" - button $name.buttonframe.ok -text {Do it}\ - -command "dofont_apply $name" - pack $name.buttonframe.cancel -side left -expand 1 - pack $name.buttonframe.ok -side left -expand 1 - - frame $name.radiof - pack $name.radiof -side left - - label $name.radiof.label -text {Font Size:} - pack $name.radiof.label -side top - - radiobutton $name.radiof.radio8 -value 8 -variable fontsize -text "8" - radiobutton $name.radiof.radio10 -value 10 -variable fontsize -text "10" - radiobutton $name.radiof.radio12 -value 12 -variable fontsize -text "12" - radiobutton $name.radiof.radio16 -value 16 -variable fontsize -text "16" - radiobutton $name.radiof.radio24 -value 24 -variable fontsize -text "24" - radiobutton $name.radiof.radio36 -value 36 -variable fontsize -text "36" - pack $name.radiof.radio8 -side top -anchor w - pack $name.radiof.radio10 -side top -anchor w - pack $name.radiof.radio12 -side top -anchor w - pack $name.radiof.radio16 -side top -anchor w - pack $name.radiof.radio24 -side top -anchor w - pack $name.radiof.radio36 -side top -anchor w - - frame $name.stretchf - pack $name.stretchf -side left - - label $name.stretchf.label -text {Stretch:} - pack $name.stretchf.label -side top - - entry $name.stretchf.entry -textvariable stretchval -width 5 - pack $name.stretchf.entry -side left - - radiobutton $name.stretchf.radio1 \ - -value 1 -variable whichstretch -text "X and Y" - radiobutton $name.stretchf.radio2 \ - -value 2 -variable whichstretch -text "X only" - radiobutton $name.stretchf.radio3 \ - -value 3 -variable whichstretch -text "Y only" - - pack $name.stretchf.radio1 -side top -anchor w - pack $name.stretchf.radio2 -side top -anchor w - pack $name.stretchf.radio3 -side top -anchor w - -} - -############ pdtk_gatom_dialog -- run a gatom dialog ######### - -# see graph_apply, etc., for comments about handling variable names here... - -proc gatom_escape {sym} { - if {[string length $sym] == 0} { - set ret "-" -# puts stderr [concat escape1 $sym $ret] - } else { - if {[string equal -length 1 $sym "-"]} { - set ret [string replace $sym 0 0 "--"] -# puts stderr [concat escape $sym $ret] - } else { - set ret $sym -# puts stderr [concat escape $sym "no change"] - } - } - concat $ret -} - -proc gatom_unescape {sym} { - if {[string equal -length 1 $sym "-"]} { - set ret [string replace $sym 0 0 ""] -# puts stderr [concat unescape $sym $ret] - } else { - set ret $sym -# puts stderr [concat unescape $sym "no change"] - } - concat $ret -} - -proc dogatom_apply {id} { - set vid [string trimleft $id .] - - set var_gatomwidth [concat gatomwidth_$vid] - global $var_gatomwidth - set var_gatomlo [concat gatomlo_$vid] - global $var_gatomlo - set var_gatomhi [concat gatomhi_$vid] - global $var_gatomhi - set var_gatomwherelabel [concat gatomwherelabel_$vid] - global $var_gatomwherelabel - set var_gatomlabel [concat gatomlabel_$vid] - global $var_gatomlabel - set var_gatomsymfrom [concat gatomsymfrom_$vid] - global $var_gatomsymfrom - set var_gatomsymto [concat gatomsymto_$vid] - global $var_gatomsymto - -# set cmd [concat $id param $gatomwidth $gatomlo $gatomhi \;] - - set cmd [concat $id param \ - [eval concat $$var_gatomwidth] \ - [eval concat $$var_gatomlo] \ - [eval concat $$var_gatomhi] \ - [eval gatom_escape $$var_gatomlabel] \ - [eval concat $$var_gatomwherelabel] \ - [eval gatom_escape $$var_gatomsymfrom] \ - [eval gatom_escape $$var_gatomsymto] \ - \;] - -# puts stderr $cmd - pd $cmd -} - -proc dogatom_cancel {name} { - set cmd [concat $name cancel \;] -# puts stderr $cmd - pd $cmd -} - -proc dogatom_ok {name} { - dogatom_apply $name - dogatom_cancel $name -} - -proc pdtk_gatom_dialog {id initwidth initlo inithi \ - wherelabel label symfrom symto} { - - set vid [string trimleft $id .] - - set var_gatomwidth [concat gatomwidth_$vid] - global $var_gatomwidth - set var_gatomlo [concat gatomlo_$vid] - global $var_gatomlo - set var_gatomhi [concat gatomhi_$vid] - global $var_gatomhi - set var_gatomwherelabel [concat gatomwherelabel_$vid] - global $var_gatomwherelabel - set var_gatomlabel [concat gatomlabel_$vid] - global $var_gatomlabel - set var_gatomsymfrom [concat gatomsymfrom_$vid] - global $var_gatomsymfrom - set var_gatomsymto [concat gatomsymto_$vid] - global $var_gatomsymto - - set $var_gatomwidth $initwidth - set $var_gatomlo $initlo - set $var_gatomhi $inithi - set $var_gatomwherelabel $wherelabel - set $var_gatomlabel [gatom_unescape $label] - set $var_gatomsymfrom [gatom_unescape $symfrom] - set $var_gatomsymto [gatom_unescape $symto] - - toplevel $id - wm title $id {Atom} - wm protocol $id WM_DELETE_WINDOW [concat dogatom_cancel $id] - - frame $id.buttonframe - pack $id.buttonframe -side bottom -fill x -pady 2m - button $id.buttonframe.cancel -text {Cancel}\ - -command "dogatom_cancel $id" - button $id.buttonframe.ok -text {Apply}\ - -command "dogatom_apply $id" - pack $id.buttonframe.cancel -side left -expand 1 - pack $id.buttonframe.ok -side left -expand 1 - - frame $id.paramsymto - pack $id.paramsymto -side bottom - label $id.paramsymto.entryname -text {send symbol} - entry $id.paramsymto.entry -textvariable $var_gatomsymto -width 20 - pack $id.paramsymto.entryname $id.paramsymto.entry -side left - - frame $id.paramsymfrom - pack $id.paramsymfrom -side bottom - label $id.paramsymfrom.entryname -text {receive symbol} - entry $id.paramsymfrom.entry -textvariable $var_gatomsymfrom -width 20 - pack $id.paramsymfrom.entryname $id.paramsymfrom.entry -side left - - frame $id.radio - pack $id.radio -side bottom - label $id.radio.label -text {show label on:} - frame $id.radio.l - frame $id.radio.r - pack $id.radio.label -side top - pack $id.radio.l $id.radio.r -side left - radiobutton $id.radio.l.radio0 -value 0 \ - -variable $var_gatomwherelabel \ - -text "left" - radiobutton $id.radio.l.radio1 -value 1 \ - -variable $var_gatomwherelabel \ - -text "right" - radiobutton $id.radio.r.radio2 -value 2 \ - -variable $var_gatomwherelabel \ - -text "top" - radiobutton $id.radio.r.radio3 -value 3 \ - -variable $var_gatomwherelabel \ - -text "bottom" - pack $id.radio.l.radio0 $id.radio.l.radio1 -side top -anchor w - pack $id.radio.r.radio2 $id.radio.r.radio3 -side top -anchor w - - - frame $id.paramlabel - pack $id.paramlabel -side bottom - label $id.paramlabel.entryname -text label - entry $id.paramlabel.entry -textvariable $var_gatomlabel -width 20 - pack $id.paramlabel.entryname $id.paramlabel.entry -side left - - frame $id.paramhi - pack $id.paramhi -side bottom - label $id.paramhi.entryname -text "upper limit" - entry $id.paramhi.entry -textvariable $var_gatomhi -width 8 - pack $id.paramhi.entryname $id.paramhi.entry -side left - - frame $id.paramlo - pack $id.paramlo -side bottom - label $id.paramlo.entryname -text "lower limit" - entry $id.paramlo.entry -textvariable $var_gatomlo -width 8 - pack $id.paramlo.entryname $id.paramlo.entry -side left - - frame $id.params - pack $id.params -side bottom - label $id.params.entryname -text width - entry $id.params.entry -textvariable $var_gatomwidth -width 4 - pack $id.params.entryname $id.params.entry -side left - - - - bind $id.paramhi.entry <KeyPress-Return> [concat dogatom_ok $id] - bind $id.paramlo.entry <KeyPress-Return> [concat dogatom_ok $id] - bind $id.params.entry <KeyPress-Return> [concat dogatom_ok $id] - $id.params.entry select from 0 - $id.params.entry select adjust end - focus $id.params.entry -} - -############ pdtk_canvas_popup -- popup menu for canvas ######### - -set popup_xpix 0 -set popup_ypix 0 - -proc popup_action {name action} { - global popup_xpix popup_ypix - set cmd [concat $name done-popup $action $popup_xpix $popup_ypix \;] -# puts stderr $cmd - pd $cmd -} - -proc pdtk_canvas_popup {name xpix ypix canprop canopen} { - global popup_xpix popup_ypix - set popup_xpix $xpix - set popup_ypix $ypix - if {$canprop == 0} {$name.popup entryconfigure 0 -state disabled} - if {$canprop == 1} {$name.popup entryconfigure 0 -state active} - if {$canopen == 0} {$name.popup entryconfigure 1 -state disabled} - if {$canopen == 1} {$name.popup entryconfigure 1 -state active} - tk_popup $name.popup [expr $xpix + [winfo rootx $name.c]] \ - [expr $ypix + [winfo rooty $name.c]] 0 -} - -############ pdtk_graph_dialog -- dialog window for graphs ######### - -# the graph and array dialogs can come up in many copies; but in TK the easiest -# way to get data from an "entry", etc., is to set an associated variable -# name. This is especially true for grouped "radio buttons". So we have -# to synthesize variable names for each instance of the dialog. The dialog -# gets a TK pathname $id, from which it strips the leading "." to make a -# variable suffix $vid. Then you can get the actual value out by asking for -# [eval concat $$variablename]. There should be an easier way but I don't see -# it yet. - -proc graph_apply {id} { -# strip "." from the TK id to make a variable name suffix - set vid [string trimleft $id .] -# for each variable, make a local variable to hold its name... - set var_graph_x1 [concat graph_x1_$vid] - global $var_graph_x1 - set var_graph_x2 [concat graph_x2_$vid] - global $var_graph_x2 - set var_graph_xpix [concat graph_xpix_$vid] - global $var_graph_xpix - set var_graph_y1 [concat graph_y1_$vid] - global $var_graph_y1 - set var_graph_y2 [concat graph_y2_$vid] - global $var_graph_y2 - set var_graph_ypix [concat graph_ypix_$vid] - global $var_graph_ypix - - pd [concat $id dialog \ - [eval concat $$var_graph_x1] \ - [eval concat $$var_graph_y1] \ - [eval concat $$var_graph_x2] \ - [eval concat $$var_graph_y2] \ - [eval concat $$var_graph_xpix] \ - [eval concat $$var_graph_ypix] \ - \;] -} - -proc graph_cancel {id} { - set cmd [concat $id cancel \;] -# puts stderr $cmd - pd $cmd -} - -proc graph_ok {id} { - graph_apply $id - graph_cancel $id -} - -proc pdtk_graph_dialog {id x1 y1 x2 y2 xpix ypix} { - set vid [string trimleft $id .] - set var_graph_x1 [concat graph_x1_$vid] - global $var_graph_x1 - set var_graph_x2 [concat graph_x2_$vid] - global $var_graph_x2 - set var_graph_xpix [concat graph_xpix_$vid] - global $var_graph_xpix - set var_graph_y1 [concat graph_y1_$vid] - global $var_graph_y1 - set var_graph_y2 [concat graph_y2_$vid] - global $var_graph_y2 - set var_graph_ypix [concat graph_ypix_$vid] - global $var_graph_ypix - - set $var_graph_x1 $x1 - set $var_graph_x2 $x2 - set $var_graph_xpix $xpix - set $var_graph_y1 $y1 - set $var_graph_y2 $y2 - set $var_graph_ypix $ypix - - toplevel $id - wm title $id {graph} - wm protocol $id WM_DELETE_WINDOW [concat graph_cancel $id] - - label $id.label -text {GRAPH BOUNDS} - pack $id.label -side top - - frame $id.buttonframe - pack $id.buttonframe -side bottom -fill x -pady 2m - button $id.buttonframe.cancel -text {Cancel}\ - -command "graph_cancel $id" - button $id.buttonframe.apply -text {Apply}\ - -command "graph_apply $id" - button $id.buttonframe.ok -text {OK}\ - -command "graph_ok $id" - pack $id.buttonframe.cancel -side left -expand 1 - pack $id.buttonframe.apply -side left -expand 1 - pack $id.buttonframe.ok -side left -expand 1 - - frame $id.xrangef - pack $id.xrangef -side top - - label $id.xrangef.l1 -text "X from:" - entry $id.xrangef.x1 -textvariable $var_graph_x1 -width 7 - label $id.xrangef.l2 -text "to:" - entry $id.xrangef.x2 -textvariable $var_graph_x2 -width 7 - label $id.xrangef.l3 -text "screen width:" - entry $id.xrangef.xpix -textvariable $var_graph_xpix -width 7 - pack $id.xrangef.l1 $id.xrangef.x1 \ - $id.xrangef.l2 $id.xrangef.x2 \ - $id.xrangef.l3 $id.xrangef.xpix -side left - - frame $id.yrangef - pack $id.yrangef -side top - -# dig in the following that the upper bound is labeled y1 but the variable is -# y2, etc. This is to deal with the inconsistent use of "upper and lower" -# graph bounds... in the dialog the upper Y bound is the lower valued Y pixel. - label $id.yrangef.l1 -text "Y from:" - entry $id.yrangef.y1 -textvariable $var_graph_y2 -width 7 - label $id.yrangef.l2 -text "to:" - entry $id.yrangef.y2 -textvariable $var_graph_y1 -width 7 - label $id.yrangef.l3 -text "screen height:" - entry $id.yrangef.ypix -textvariable $var_graph_ypix -width 7 - pack $id.yrangef.l1 $id.yrangef.y1 \ - $id.yrangef.l2 $id.yrangef.y2 \ - $id.yrangef.l3 $id.yrangef.ypix -side left - - bind $id.xrangef.x1 <KeyPress-Return> [concat graph_ok $id] - bind $id.xrangef.x2 <KeyPress-Return> [concat graph_ok $id] - bind $id.xrangef.xpix <KeyPress-Return> [concat graph_ok $id] - bind $id.yrangef.y1 <KeyPress-Return> [concat graph_ok $id] - bind $id.yrangef.y2 <KeyPress-Return> [concat graph_ok $id] - bind $id.yrangef.ypix <KeyPress-Return> [concat graph_ok $id] - $id.xrangef.x2 select from 0 - $id.xrangef.x2 select adjust end - focus $id.xrangef.x2 -} - -# begin of change "iemlib" -############ pdtk_iemgui_dialog -- dialog window for iem guis ######### - -set iemgui_define_min_flashhold 50 -set iemgui_define_min_flashbreak 10 -set iemgui_define_min_fontsize 4 - -proc iemgui_clip_dim {id} { - set vid [string trimleft $id .] - - set var_iemgui_wdt [concat iemgui_wdt_$vid] - global $var_iemgui_wdt - set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid] - global $var_iemgui_min_wdt - set var_iemgui_hgt [concat iemgui_hgt_$vid] - global $var_iemgui_hgt - set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid] - global $var_iemgui_min_hgt - - if {[eval concat $$var_iemgui_wdt] < [eval concat $$var_iemgui_min_wdt]} { - set $var_iemgui_wdt [eval concat $$var_iemgui_min_wdt] - $id.dim.w_ent configure -textvariable $var_iemgui_wdt - } - if {[eval concat $$var_iemgui_hgt] < [eval concat $$var_iemgui_min_hgt]} { - set $var_iemgui_hgt [eval concat $$var_iemgui_min_hgt] - $id.dim.h_ent configure -textvariable $var_iemgui_hgt - } -} - -proc iemgui_clip_num {id} { - set vid [string trimleft $id .] - - set var_iemgui_num [concat iemgui_num_$vid] - global $var_iemgui_num - - if {[eval concat $$var_iemgui_num] > 2000} { - set $var_iemgui_num 2000 - $id.para.num_ent configure -textvariable $var_iemgui_num - } - if {[eval concat $$var_iemgui_num] < 1} { - set $var_iemgui_num 1 - $id.para.num_ent configure -textvariable $var_iemgui_num - } -} - -proc iemgui_sched_rng {id} { - set vid [string trimleft $id .] - - set var_iemgui_min_rng [concat iemgui_min_rng_$vid] - global $var_iemgui_min_rng - set var_iemgui_max_rng [concat iemgui_max_rng_$vid] - global $var_iemgui_max_rng - set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid] - global $var_iemgui_rng_sch - - global iemgui_define_min_flashhold - global iemgui_define_min_flashbreak - - if {[eval concat $$var_iemgui_rng_sch] == 2} { - if {[eval concat $$var_iemgui_max_rng] < [eval concat $$var_iemgui_min_rng]} { - set hhh [eval concat $$var_iemgui_min_rng] - set $var_iemgui_min_rng [eval concat $$var_iemgui_max_rng] - set $var_iemgui_max_rng $hhh - $id.rng.max_ent configure -textvariable $var_iemgui_max_rng - $id.rng.min_ent configure -textvariable $var_iemgui_min_rng } - if {[eval concat $$var_iemgui_max_rng] < $iemgui_define_min_flashhold} { - set $var_iemgui_max_rng $iemgui_define_min_flashhold - $id.rng.max_ent configure -textvariable $var_iemgui_max_rng - } - if {[eval concat $$var_iemgui_min_rng] < $iemgui_define_min_flashbreak} { - set $var_iemgui_min_rng $iemgui_define_min_flashbreak - $id.rng.min_ent configure -textvariable $var_iemgui_min_rng - } - } - if {[eval concat $$var_iemgui_rng_sch] == 1} { - if {[eval concat $$var_iemgui_min_rng] == 0.0} { - set $var_iemgui_min_rng 1.0 - $id.rng.min_ent configure -textvariable $var_iemgui_min_rng - } - } -} - -proc iemgui_verify_rng {id} { - set vid [string trimleft $id .] - - set var_iemgui_min_rng [concat iemgui_min_rng_$vid] - global $var_iemgui_min_rng - set var_iemgui_max_rng [concat iemgui_max_rng_$vid] - global $var_iemgui_max_rng - set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] - global $var_iemgui_lin0_log1 - - if {[eval concat $$var_iemgui_lin0_log1] == 1} { - if {[eval concat $$var_iemgui_max_rng] == 0.0 && [eval concat $$var_iemgui_min_rng] == 0.0} { - set $var_iemgui_max_rng 1.0 - $id.rng.max_ent configure -textvariable $var_iemgui_max_rng - } - if {[eval concat $$var_iemgui_max_rng] > 0} { - if {[eval concat $$var_iemgui_min_rng] <= 0} { - set $var_iemgui_min_rng [expr [eval concat $$var_iemgui_max_rng] * 0.01] - $id.rng.min_ent configure -textvariable $var_iemgui_min_rng - } - } else { - if {[eval concat $$var_iemgui_min_rng] > 0} { - set $var_iemgui_max_rng [expr [eval concat $$var_iemgui_min_rng] * 0.01] - $id.rng.max_ent configure -textvariable $var_iemgui_max_rng - } - } - } -} - -proc iemgui_clip_fontsize {id} { - set vid [string trimleft $id .] - - set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid] - global $var_iemgui_gn_fs - - global iemgui_define_min_fontsize - - if {[eval concat $$var_iemgui_gn_fs] < $iemgui_define_min_fontsize} { - set $var_iemgui_gn_fs $iemgui_define_min_fontsize - $id.gnfs.fs_ent configure -textvariable $var_iemgui_gn_fs - } -} - -proc iemgui_set_col_example {id} { - set vid [string trimleft $id .] - - set var_iemgui_bcol [concat iemgui_bcol_$vid] - global $var_iemgui_bcol - set var_iemgui_fcol [concat iemgui_fcol_$vid] - global $var_iemgui_fcol - set var_iemgui_lcol [concat iemgui_lcol_$vid] - global $var_iemgui_lcol - - $id.col_example_choose.lb_bk configure \ - -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -foreground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \ - -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] - - if { [eval concat $$var_iemgui_fcol] >= 0 } { - $id.col_example_choose.fr_bk configure \ - -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -foreground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \ - -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] - } else { - $id.col_example_choose.fr_bk configure \ - -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -foreground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]]} -} - -proc iemgui_preset_col {id presetcol} { - set vid [string trimleft $id .] - - set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid] - global $var_iemgui_l2_f1_b0 - set var_iemgui_bcol [concat iemgui_bcol_$vid] - global $var_iemgui_bcol - set var_iemgui_fcol [concat iemgui_fcol_$vid] - global $var_iemgui_fcol - set var_iemgui_lcol [concat iemgui_lcol_$vid] - global $var_iemgui_lcol - - if { [eval concat $$var_iemgui_l2_f1_b0] == 0 } { set $var_iemgui_bcol $presetcol } - if { [eval concat $$var_iemgui_l2_f1_b0] == 1 } { set $var_iemgui_fcol $presetcol } - if { [eval concat $$var_iemgui_l2_f1_b0] == 2 } { set $var_iemgui_lcol $presetcol } - iemgui_set_col_example $id -} - -proc iemgui_choose_col_bkfrlb {id} { - set vid [string trimleft $id .] - - set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid] - global $var_iemgui_l2_f1_b0 - set var_iemgui_bcol [concat iemgui_bcol_$vid] - global $var_iemgui_bcol - set var_iemgui_fcol [concat iemgui_fcol_$vid] - global $var_iemgui_fcol - set var_iemgui_lcol [concat iemgui_lcol_$vid] - global $var_iemgui_lcol - - if {[eval concat $$var_iemgui_l2_f1_b0] == 0} { - set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC] - set helpstring [tk_chooseColor -title "Background-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_bcol]]] - if { $helpstring != "" } { - set $var_iemgui_bcol [string replace $helpstring 0 0 "0x"] - set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC] } - } - if {[eval concat $$var_iemgui_l2_f1_b0] == 1} { - set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC] - set helpstring [tk_chooseColor -title "Front-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_fcol]]] - if { $helpstring != "" } { - set $var_iemgui_fcol [string replace $helpstring 0 0 "0x"] - set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC] } - } - if {[eval concat $$var_iemgui_l2_f1_b0] == 2} { - set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC] - set helpstring [tk_chooseColor -title "Label-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_lcol]]] - if { $helpstring != "" } { - set $var_iemgui_lcol [string replace $helpstring 0 0 "0x"] - set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC] } - } - iemgui_set_col_example $id -} - -proc iemgui_lilo {id} { - set vid [string trimleft $id .] - - set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] - global $var_iemgui_lin0_log1 - set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] - global $var_iemgui_lilo0 - set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] - global $var_iemgui_lilo1 - - iemgui_sched_rng $id - - if {[eval concat $$var_iemgui_lin0_log1] == 0} { - set $var_iemgui_lin0_log1 1 - $id.para.lilo configure -text [eval concat $$var_iemgui_lilo1] - iemgui_verify_rng $id - iemgui_sched_rng $id - } else { - set $var_iemgui_lin0_log1 0 - $id.para.lilo configure -text [eval concat $$var_iemgui_lilo0] - } -} - -proc iemgui_toggle_font {id} { - set vid [string trimleft $id .] - - set var_iemgui_gn_f [concat iemgui_gn_f_$vid] - global $var_iemgui_gn_f - - set $var_iemgui_gn_f [expr [eval concat $$var_iemgui_gn_f] + 1] - if {[eval concat $$var_iemgui_gn_f] > 2} {set $var_iemgui_gn_f 0} - if {[eval concat $$var_iemgui_gn_f] == 0} {$id.gnfs.fb configure -text "courier" -font {courier 10 bold}} - if {[eval concat $$var_iemgui_gn_f] == 1} {$id.gnfs.fb configure -text "helvetica" -font {helvetica 10 bold}} - if {[eval concat $$var_iemgui_gn_f] == 2} {$id.gnfs.fb configure -text "times" -font {times 10 bold}} -} - -proc iemgui_lb {id} { - set vid [string trimleft $id .] - - set var_iemgui_loadbang [concat iemgui_loadbang_$vid] - global $var_iemgui_loadbang - - if {[eval concat $$var_iemgui_loadbang] == 0} { - set $var_iemgui_loadbang 1 - $id.para.lb configure -text "init" - } else { - set $var_iemgui_loadbang 0 - $id.para.lb configure -text "no init" - } -} - -proc iemgui_stdy_jmp {id} { - set vid [string trimleft $id .] - - set var_iemgui_steady [concat iemgui_steady_$vid] - global $var_iemgui_steady - - if {[eval concat $$var_iemgui_steady]} { - set $var_iemgui_steady 0 - $id.para.stdy_jmp configure -text "jump on click" - } else { - set $var_iemgui_steady 1 - $id.para.stdy_jmp configure -text "steady on click" - } -} - -proc iemgui_apply {id} { - set vid [string trimleft $id .] - - set var_iemgui_wdt [concat iemgui_wdt_$vid] - global $var_iemgui_wdt - set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid] - global $var_iemgui_min_wdt - set var_iemgui_hgt [concat iemgui_hgt_$vid] - global $var_iemgui_hgt - set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid] - global $var_iemgui_min_hgt - set var_iemgui_min_rng [concat iemgui_min_rng_$vid] - global $var_iemgui_min_rng - set var_iemgui_max_rng [concat iemgui_max_rng_$vid] - global $var_iemgui_max_rng - set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] - global $var_iemgui_lin0_log1 - set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] - global $var_iemgui_lilo0 - set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] - global $var_iemgui_lilo1 - set var_iemgui_loadbang [concat iemgui_loadbang_$vid] - global $var_iemgui_loadbang - set var_iemgui_num [concat iemgui_num_$vid] - global $var_iemgui_num - set var_iemgui_steady [concat iemgui_steady_$vid] - global $var_iemgui_steady - set var_iemgui_snd [concat iemgui_snd_$vid] - global $var_iemgui_snd - set var_iemgui_rcv [concat iemgui_rcv_$vid] - global $var_iemgui_rcv - set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid] - global $var_iemgui_gui_nam - set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid] - global $var_iemgui_gn_dx - set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid] - global $var_iemgui_gn_dy - set var_iemgui_gn_f [concat iemgui_gn_f_$vid] - global $var_iemgui_gn_f - set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid] - global $var_iemgui_gn_fs - set var_iemgui_bcol [concat iemgui_bcol_$vid] - global $var_iemgui_bcol - set var_iemgui_fcol [concat iemgui_fcol_$vid] - global $var_iemgui_fcol - set var_iemgui_lcol [concat iemgui_lcol_$vid] - global $var_iemgui_lcol - - iemgui_clip_dim $id - iemgui_clip_num $id - iemgui_sched_rng $id - iemgui_verify_rng $id - iemgui_sched_rng $id - iemgui_clip_fontsize $id - - if {[eval concat $$var_iemgui_snd] == ""} {set hhhsnd "empty"} else {set hhhsnd [eval concat $$var_iemgui_snd]} - if {[eval concat $$var_iemgui_rcv] == ""} {set hhhrcv "empty"} else {set hhhrcv [eval concat $$var_iemgui_rcv]} - if {[eval concat $$var_iemgui_gui_nam] == ""} {set hhhgui_nam "empty" - } else { - set hhhgui_nam [eval concat $$var_iemgui_gui_nam]} - - if {[string index $hhhsnd 0] == "$"} { - set hhhsnd [string replace $hhhsnd 0 0 #] } - if {[string index $hhhrcv 0] == "$"} { - set hhhrcv [string replace $hhhrcv 0 0 #] } - if {[string index $hhhgui_nam 0] == "$"} { - set hhhgui_nam [string replace $hhhgui_nam 0 0 #] } - - pd [concat $id dialog \ - [eval concat $$var_iemgui_wdt] \ - [eval concat $$var_iemgui_hgt] \ - [eval concat $$var_iemgui_min_rng] \ - [eval concat $$var_iemgui_max_rng] \ - [eval concat $$var_iemgui_lin0_log1] \ - [eval concat $$var_iemgui_loadbang] \ - [eval concat $$var_iemgui_num] \ - $hhhsnd \ - $hhhrcv \ - $hhhgui_nam \ - [eval concat $$var_iemgui_gn_dx] \ - [eval concat $$var_iemgui_gn_dy] \ - [eval concat $$var_iemgui_gn_f] \ - [eval concat $$var_iemgui_gn_fs] \ - [eval concat $$var_iemgui_bcol] \ - [eval concat $$var_iemgui_fcol] \ - [eval concat $$var_iemgui_lcol] \ - [eval concat $$var_iemgui_steady] \ - \;] -} - -proc iemgui_cancel {id} {pd [concat $id cancel \;]} - -proc iemgui_ok {id} { - iemgui_apply $id - iemgui_cancel $id -} - -proc pdtk_iemgui_dialog {id mainheader \ - dim_header wdt min_wdt wdt_label hgt min_hgt hgt_label \ - rng_header min_rng min_rng_label max_rng max_rng_label rng_sched \ - lin0_log1 lilo0_label lilo1_label loadbang steady num_label num \ - snd rcv \ - gui_name \ - gn_dx gn_dy \ - gn_f gn_fs \ - bcol fcol lcol} { - - set vid [string trimleft $id .] - - set var_iemgui_wdt [concat iemgui_wdt_$vid] - global $var_iemgui_wdt - set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid] - global $var_iemgui_min_wdt - set var_iemgui_hgt [concat iemgui_hgt_$vid] - global $var_iemgui_hgt - set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid] - global $var_iemgui_min_hgt - set var_iemgui_min_rng [concat iemgui_min_rng_$vid] - global $var_iemgui_min_rng - set var_iemgui_max_rng [concat iemgui_max_rng_$vid] - global $var_iemgui_max_rng - set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid] - global $var_iemgui_rng_sch - set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid] - global $var_iemgui_lin0_log1 - set var_iemgui_lilo0 [concat iemgui_lilo0_$vid] - global $var_iemgui_lilo0 - set var_iemgui_lilo1 [concat iemgui_lilo1_$vid] - global $var_iemgui_lilo1 - set var_iemgui_loadbang [concat iemgui_loadbang_$vid] - global $var_iemgui_loadbang - set var_iemgui_num [concat iemgui_num_$vid] - global $var_iemgui_num - set var_iemgui_steady [concat iemgui_steady_$vid] - global $var_iemgui_steady - set var_iemgui_snd [concat iemgui_snd_$vid] - global $var_iemgui_snd - set var_iemgui_rcv [concat iemgui_rcv_$vid] - global $var_iemgui_rcv - set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid] - global $var_iemgui_gui_nam - set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid] - global $var_iemgui_gn_dx - set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid] - global $var_iemgui_gn_dy - set var_iemgui_gn_f [concat iemgui_gn_f_$vid] - global $var_iemgui_gn_f - set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid] - global $var_iemgui_gn_fs - set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid] - global $var_iemgui_l2_f1_b0 - set var_iemgui_bcol [concat iemgui_bcol_$vid] - global $var_iemgui_bcol - set var_iemgui_fcol [concat iemgui_fcol_$vid] - global $var_iemgui_fcol - set var_iemgui_lcol [concat iemgui_lcol_$vid] - global $var_iemgui_lcol - - set $var_iemgui_wdt $wdt - set $var_iemgui_min_wdt $min_wdt - set $var_iemgui_hgt $hgt - set $var_iemgui_min_hgt $min_hgt - set $var_iemgui_min_rng $min_rng - set $var_iemgui_max_rng $max_rng - set $var_iemgui_rng_sch $rng_sched - set $var_iemgui_lin0_log1 $lin0_log1 - set $var_iemgui_lilo0 $lilo0_label - set $var_iemgui_lilo1 $lilo1_label - set $var_iemgui_loadbang $loadbang - set $var_iemgui_num $num - set $var_iemgui_steady $steady - if {$snd == "empty"} {set $var_iemgui_snd [format ""] - } else {set $var_iemgui_snd [format "%s" $snd]} - if {$rcv == "empty"} {set $var_iemgui_rcv [format ""] - } else {set $var_iemgui_rcv [format "%s" $rcv]} - if {$gui_name == "empty"} {set $var_iemgui_gui_nam [format ""] - } else {set $var_iemgui_gui_nam [format "%s" $gui_name]} - - if {[string index [eval concat $$var_iemgui_snd] 0] == "#"} { - set $var_iemgui_snd [string replace [eval concat $$var_iemgui_snd] 0 0 $] } - if {[string index [eval concat $$var_iemgui_rcv] 0] == "#"} { - set $var_iemgui_rcv [string replace [eval concat $$var_iemgui_rcv] 0 0 $] } - if {[string index [eval concat $$var_iemgui_gui_nam] 0] == "#"} { - set $var_iemgui_gui_nam [string replace [eval concat $$var_iemgui_gui_nam] 0 0 $] } - set $var_iemgui_gn_dx $gn_dx - set $var_iemgui_gn_dy $gn_dy - set $var_iemgui_gn_f $gn_f - set $var_iemgui_gn_fs $gn_fs - - set $var_iemgui_bcol $bcol - set $var_iemgui_fcol $fcol - set $var_iemgui_lcol $lcol - - set $var_iemgui_l2_f1_b0 0 - - toplevel $id - wm title $id [format "%s-PROPERTIES" $mainheader] - wm protocol $id WM_DELETE_WINDOW [concat iemgui_cancel $id] - - frame $id.dim - pack $id.dim -side top - label $id.dim.head -text $dim_header - label $id.dim.w_lab -text $wdt_label -width 6 - entry $id.dim.w_ent -textvariable $var_iemgui_wdt -width 5 - label $id.dim.dummy1 -text " " -width 10 - label $id.dim.h_lab -text $hgt_label -width 6 - entry $id.dim.h_ent -textvariable $var_iemgui_hgt -width 5 - pack $id.dim.head -side top - pack $id.dim.w_lab $id.dim.w_ent $id.dim.dummy1 -side left - if { $hgt_label != "empty" } { - pack $id.dim.h_lab $id.dim.h_ent -side left} - - frame $id.rng - pack $id.rng -side top - label $id.rng.head -text $rng_header - label $id.rng.min_lab -text $min_rng_label -width 6 - entry $id.rng.min_ent -textvariable $var_iemgui_min_rng -width 9 - label $id.rng.dummy1 -text " " -width 1 - label $id.rng.max_lab -text $max_rng_label -width 8 - entry $id.rng.max_ent -textvariable $var_iemgui_max_rng -width 9 - if { $rng_header != "empty" } { - pack $id.rng.head -side top - if { $min_rng_label != "empty" } { - pack $id.rng.min_lab $id.rng.min_ent -side left} - if { $max_rng_label != "empty" } { - pack $id.rng.dummy1 \ - $id.rng.max_lab $id.rng.max_ent -side left} } - - 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 } { - label $id.space1 -text "---------------------------------" - pack $id.space1 -side top } - - frame $id.para - pack $id.para -side top - label $id.para.dummy2 -text "" -width 1 - label $id.para.dummy3 -text "" -width 1 - if {[eval concat $$var_iemgui_lin0_log1] == 0} { - button $id.para.lilo -text [eval concat $$var_iemgui_lilo0] -width 5 -command "iemgui_lilo $id" } - if {[eval concat $$var_iemgui_lin0_log1] == 1} { - button $id.para.lilo -text [eval concat $$var_iemgui_lilo1] -width 5 -command "iemgui_lilo $id" } - if {[eval concat $$var_iemgui_loadbang] == 0} { - button $id.para.lb -text "no init" -width 5 -command "iemgui_lb $id" } - if {[eval concat $$var_iemgui_loadbang] == 1} { - button $id.para.lb -text "init" -width 5 -command "iemgui_lb $id" } - label $id.para.num_lab -text $num_label -width 9 - entry $id.para.num_ent -textvariable $var_iemgui_num -width 4 - if {[eval concat $$var_iemgui_steady] == 0} { - button $id.para.stdy_jmp -text "jump on click" -width 11 -command "iemgui_stdy_jmp $id" } - if {[eval concat $$var_iemgui_steady] == 1} { - button $id.para.stdy_jmp -text "steady on click" -width 11 -command "iemgui_stdy_jmp $id" } - if {[eval concat $$var_iemgui_lin0_log1] >= 0} { - pack $id.para.lilo -side left -expand 1} - if {[eval concat $$var_iemgui_loadbang] >= 0} { - pack $id.para.dummy2 $id.para.lb -side left -expand 1} - if {[eval concat $$var_iemgui_num] > 0} { - pack $id.para.dummy3 $id.para.num_lab $id.para.num_ent -side left -expand 1} - if {[eval concat $$var_iemgui_steady] >= 0} { - pack $id.para.dummy3 $id.para.stdy_jmp -side left -expand 1} - if { $snd != "nosndno" || $rcv != "norcvno" } { - label $id.space2 -text "---------------------------------" - pack $id.space2 -side top } - - frame $id.snd - pack $id.snd -side top - label $id.snd.dummy1 -text "" -width 2 - label $id.snd.lab -text "send-symbol:" -width 12 - entry $id.snd.ent -textvariable $var_iemgui_snd -width 20 - if { $snd != "nosndno" } { - pack $id.snd.dummy1 $id.snd.lab $id.snd.ent -side left} - - frame $id.rcv - pack $id.rcv -side top - label $id.rcv.lab -text "receive-symbol:" -width 15 - entry $id.rcv.ent -textvariable $var_iemgui_rcv -width 20 - if { $rcv != "norcvno" } { - pack $id.rcv.lab $id.rcv.ent -side left} - - frame $id.gnam - pack $id.gnam -side top - label $id.gnam.head -text "--------------label:---------------" - label $id.gnam.dummy1 -text "" -width 1 - label $id.gnam.lab -text "name:" -width 6 - entry $id.gnam.ent -textvariable $var_iemgui_gui_nam -width 29 - label $id.gnam.dummy2 -text "" -width 1 - pack $id.gnam.head -side top - pack $id.gnam.dummy1 $id.gnam.lab $id.gnam.ent $id.gnam.dummy2 -side left - - frame $id.gnxy - pack $id.gnxy -side top - label $id.gnxy.x_lab -text "x_off:" -width 6 - entry $id.gnxy.x_ent -textvariable $var_iemgui_gn_dx -width 5 - label $id.gnxy.dummy1 -text " " -width 10 - label $id.gnxy.y_lab -text "y_off:" -width 6 - entry $id.gnxy.y_ent -textvariable $var_iemgui_gn_dy -width 5 - pack $id.gnxy.x_lab $id.gnxy.x_ent $id.gnxy.dummy1 \ - $id.gnxy.y_lab $id.gnxy.y_ent -side left - - frame $id.gnfs - pack $id.gnfs -side top - label $id.gnfs.f_lab -text "font:" -width 6 - if {[eval concat $$var_iemgui_gn_f] == 0} { - button $id.gnfs.fb -text "courier" -font {courier 10 bold} -width 7 -command "iemgui_toggle_font $id" } - if {[eval concat $$var_iemgui_gn_f] == 1} { - button $id.gnfs.fb -text "helvetica" -font {helvetica 10 bold} -width 7 -command "iemgui_toggle_font $id" } - if {[eval concat $$var_iemgui_gn_f] == 2} { - button $id.gnfs.fb -text "times" -font {times 10 bold} -width 7 -command "iemgui_toggle_font $id" } - label $id.gnfs.dummy1 -text "" -width 1 - label $id.gnfs.fs_lab -text "fontsize:" -width 8 - entry $id.gnfs.fs_ent -textvariable $var_iemgui_gn_fs -width 5 - pack $id.gnfs.f_lab $id.gnfs.fb $id.gnfs.dummy1 \ - $id.gnfs.fs_lab $id.gnfs.fs_ent -side left - - label $id.col_head -text "--------------colors:--------------" - pack $id.col_head -side top - - frame $id.col_select - pack $id.col_select -side top - radiobutton $id.col_select.radio0 -value 0 -variable $var_iemgui_l2_f1_b0 \ - -text "backgd" -width 5 - radiobutton $id.col_select.radio1 -value 1 -variable $var_iemgui_l2_f1_b0 \ - -text "front" -width 5 - radiobutton $id.col_select.radio2 -value 2 -variable $var_iemgui_l2_f1_b0 \ - -text "label" -width 5 - if { [eval concat $$var_iemgui_fcol] >= 0 } { - pack $id.col_select.radio0 $id.col_select.radio1 $id.col_select.radio2 -side left - } else {pack $id.col_select.radio0 $id.col_select.radio2 -side left} - - frame $id.col_example_choose - pack $id.col_example_choose -side top - button $id.col_example_choose.but -text "compose color" -width 10 \ - -command "iemgui_choose_col_bkfrlb $id" - label $id.col_example_choose.dummy1 -text "" -width 1 - if { [eval concat $$var_iemgui_fcol] >= 0 } { - button $id.col_example_choose.fr_bk -text "o=||=o" -width 5 \ - -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -foreground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \ - -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] -pady 2 - } else { - button $id.col_example_choose.fr_bk -text "o=||=o" -width 5 \ - -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -foreground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] -pady 2} - button $id.col_example_choose.lb_bk -text "testlabel" -width 7 \ - -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \ - -foreground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \ - -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] -pady 2 - - pack $id.col_example_choose.but $id.col_example_choose.dummy1 \ - $id.col_example_choose.fr_bk $id.col_example_choose.lb_bk -side left - - label $id.space3 -text "------or click color preset:-------" - pack $id.space3 -side top - - frame $id.bcol - pack $id.bcol -side top - foreach i { 0 1 2 3 4 5 6 7 8 9 } hexcol { 16579836 14737632 12369084 \ - 16572640 16572608 16579784 14220504 14220540 14476540 16308476 } { - button $id.bcol.c$i -background [format "#%6.6x" $hexcol] \ - -activebackground [format "#%6.6x" $hexcol] \ - -font {courier 2 normal} -padx 7 -pady 6 \ - -command [format "iemgui_preset_col %s %d" $id $hexcol] } - pack $id.bcol.c0 $id.bcol.c1 $id.bcol.c2 $id.bcol.c3 $id.bcol.c4 \ - $id.bcol.c5 $id.bcol.c6 $id.bcol.c7 $id.bcol.c8 $id.bcol.c9 -side left - - frame $id.fcol - pack $id.fcol -side top - foreach i { 0 1 2 3 4 5 6 7 8 9 } hexcol { 10526880 8158332 6316128 \ - 16525352 16559172 15263784 1370132 2684148 3952892 16003312 } { - button $id.fcol.c$i -background [format "#%6.6x" $hexcol] \ - -activebackground [format "#%6.6x" $hexcol] \ - -font {courier 2 normal} -padx 7 -pady 6 \ - -command [format "iemgui_preset_col %s %d" $id $hexcol] } - pack $id.fcol.c0 $id.fcol.c1 $id.fcol.c2 $id.fcol.c3 $id.fcol.c4 \ - $id.fcol.c5 $id.fcol.c6 $id.fcol.c7 $id.fcol.c8 $id.fcol.c9 -side left - - frame $id.lcol - pack $id.lcol -side top - foreach i { 0 1 2 3 4 5 6 7 8 9 } hexcol { 4210752 2105376 0 \ - 9177096 5779456 7874580 2641940 17488 5256 5767248 } { - button $id.lcol.c$i -background [format "#%6.6x" $hexcol] \ - -activebackground [format "#%6.6x" $hexcol] \ - -font {courier 2 normal} -padx 7 -pady 6 \ - -command [format "iemgui_preset_col %s %d" $id $hexcol] } - pack $id.lcol.c0 $id.lcol.c1 $id.lcol.c2 $id.lcol.c3 $id.lcol.c4 \ - $id.lcol.c5 $id.lcol.c6 $id.lcol.c7 $id.lcol.c8 $id.lcol.c9 -side left - - - label $id.space4 -text "---------------------------------" - pack $id.space4 -side top - - frame $id.cao - pack $id.cao -side top - button $id.cao.cancel -text {Cancel} -width 6 \ - -command "iemgui_cancel $id" - label $id.cao.dummy1 -text "" -width 3 - button $id.cao.apply -text {Apply} -width 6 \ - -command "iemgui_apply $id" - label $id.cao.dummy2 -text "" -width 3 - button $id.cao.ok -text {OK} -width 6 \ - -command "iemgui_ok $id" - pack $id.cao.cancel $id.cao.dummy1 \ - $id.cao.apply $id.cao.dummy2 \ - $id.cao.ok -side left - - label $id.space5 -text "" - pack $id.space5 -side top - - bind $id.dim.w_ent <KeyPress-Return> [concat iemgui_ok $id] - bind $id.dim.h_ent <KeyPress-Return> [concat iemgui_ok $id] - bind $id.rng.min_ent <KeyPress-Return> [concat iemgui_ok $id] - bind $id.rng.max_ent <KeyPress-Return> [concat iemgui_ok $id] - bind $id.para.num_ent <KeyPress-Return> [concat iemgui_ok $id] - bind $id.snd.ent <KeyPress-Return> [concat iemgui_ok $id] - bind $id.rcv.ent <KeyPress-Return> [concat iemgui_ok $id] - bind $id.gnam.ent <KeyPress-Return> [concat iemgui_ok $id] - bind $id.gnxy.x_ent <KeyPress-Return> [concat iemgui_ok $id] - bind $id.gnxy.y_ent <KeyPress-Return> [concat iemgui_ok $id] - bind $id.gnfs.fs_ent <KeyPress-Return> [concat iemgui_ok $id] - bind $id.cao.ok <KeyPress-Return> [concat iemgui_ok $id] - - $id.dim.w_ent select from 0 - $id.dim.w_ent select adjust end - focus $id.dim.w_ent -} -# end of change "iemlib" - -############ pdtk_array_dialog -- dialog window for arrays ######### -proc array_apply {id} { -# strip "." from the TK id to make a variable name suffix - set vid [string trimleft $id .] -# for each variable, make a local variable to hold its name... - set var_array_name [concat array_name_$vid] - global $var_array_name - set var_array_n [concat array_n_$vid] - global $var_array_n - set var_array_saveit [concat array_saveit_$vid] - global $var_array_saveit - set var_array_otherflag [concat array_otherflag_$vid] - global $var_array_otherflag - set mofo [eval concat $$var_array_name] - if {[string index $mofo 0] == "$"} { - set mofo [string replace $mofo 0 0 #] } - - pd [concat $id arraydialog $mofo \ - [eval concat $$var_array_n] \ - [eval concat $$var_array_saveit] \ - [eval concat $$var_array_otherflag] \ - \;] -} - -proc array_cancel {id} { - set cmd [concat $id cancel \;] - pd $cmd -} - -proc array_ok {id} { - array_apply $id - array_cancel $id -} - -proc pdtk_array_dialog {id name n saveit newone} { - set vid [string trimleft $id .] - - set var_array_name [concat array_name_$vid] - global $var_array_name - set var_array_n [concat array_n_$vid] - global $var_array_n - set var_array_saveit [concat array_saveit_$vid] - global $var_array_saveit - set var_array_otherflag [concat array_otherflag_$vid] - global $var_array_otherflag - - set $var_array_name $name - set $var_array_n $n - set $var_array_saveit $saveit - set $var_array_otherflag 0 - - toplevel $id - wm title $id {array} - wm protocol $id WM_DELETE_WINDOW [concat array_cancel $id] - - frame $id.name - pack $id.name -side top - label $id.name.label -text "name" - entry $id.name.entry -textvariable $var_array_name - pack $id.name.label $id.name.entry -side left - - frame $id.n - pack $id.n -side top - label $id.n.label -text "size" - entry $id.n.entry -textvariable $var_array_n - pack $id.n.label $id.n.entry -side left - - checkbutton $id.saveme -text {save contents} -variable $var_array_saveit \ - -anchor w - pack $id.saveme -side top - - if {$newone != 0} { - frame $id.radio - pack $id.radio -side top - radiobutton $id.radio.radio0 -value 0 \ - -variable $var_array_otherflag \ - -text "in new graph" - radiobutton $id.radio.radio1 -value 1 \ - -variable $var_array_otherflag \ - -text "in last graph" - pack $id.radio.radio0 -side top -anchor w - pack $id.radio.radio1 -side top -anchor w - } else { - checkbutton $id.deleteme -text {delete me} \ - -variable $var_array_otherflag -anchor w - pack $id.deleteme -side top - } - frame $id.buttonframe - pack $id.buttonframe -side bottom -fill x -pady 2m - button $id.buttonframe.cancel -text {Cancel}\ - -command "array_cancel $id" - if {$newone == 0} {button $id.buttonframe.apply -text {Apply}\ - -command "array_apply $id"} - button $id.buttonframe.ok -text {OK}\ - -command "array_ok $id" - pack $id.buttonframe.cancel -side left -expand 1 - if {$newone == 0} {pack $id.buttonframe.apply -side left -expand 1} - pack $id.buttonframe.ok -side left -expand 1 - - bind $id.name.entry <KeyPress-Return> [concat array_ok $id] - bind $id.n.entry <KeyPress-Return> [concat array_ok $id] - $id.name.entry select from 0 - $id.name.entry select adjust end - focus $id.name.entry -} - -############ pdtk_canvas_dialog -- dialog window for canvass ######### -proc canvas_apply {id} { -# strip "." from the TK id to make a variable name suffix - set vid [string trimleft $id .] -# for each variable, make a local variable to hold its name... - set var_canvas_xscale [concat canvas_xscale_$vid] - global $var_canvas_xscale - set var_canvas_yscale [concat canvas_yscale_$vid] - global $var_canvas_yscale - set var_canvas_graphme [concat canvas_graphme_$vid] - global $var_canvas_graphme -# set var_canvas_stretch [concat canvas_stretch_$vid] -# global $var_canvas_stretch - pd [concat $id donecanvasdialog \ - [eval concat $$var_canvas_xscale] \ - [eval concat $$var_canvas_yscale] \ - [eval concat $$var_canvas_graphme] \ - \;] -} - -proc canvas_cancel {id} { - set cmd [concat $id cancel \;] - pd $cmd -} - -proc canvas_ok {id} { - canvas_apply $id - canvas_cancel $id -} - -proc pdtk_canvas_dialog {id xscale yscale graphme stretch} { - set vid [string trimleft $id .] - - set var_canvas_xscale [concat canvas_xscale_$vid] - global $var_canvas_xscale - set var_canvas_yscale [concat canvas_yscale_$vid] - global $var_canvas_yscale - set var_canvas_graphme [concat canvas_graphme_$vid] - global $var_canvas_graphme -# set var_canvas_stretch [concat canvas_stretch_$vid] -# global $var_canvas_stretch - - set $var_canvas_xscale $xscale - set $var_canvas_yscale $yscale - set $var_canvas_graphme $graphme -# set $var_canvas_stretch $stretch - - toplevel $id - wm title $id {canvas} - wm protocol $id WM_DELETE_WINDOW [concat canvas_cancel $id] - - frame $id.xscale - pack $id.xscale -side top - label $id.xscale.label -text "X units per pixel" - entry $id.xscale.entry -textvariable $var_canvas_xscale -width 10 - pack $id.xscale.label $id.xscale.entry -side left - - frame $id.yscale - pack $id.yscale -side top - label $id.yscale.label -text "Y units per pixel" - entry $id.yscale.entry -textvariable $var_canvas_yscale -width 10 - pack $id.yscale.label $id.yscale.entry -side left - - checkbutton $id.graphme -text {graph on parent} \ - -variable $var_canvas_graphme -anchor w - pack $id.graphme -side top - -# checkbutton $id.stretch -text {stretch on resize} \ -# -variable $var_canvas_stretch -anchor w -# pack $id.stretch -side top - - - frame $id.buttonframe - pack $id.buttonframe -side bottom -fill x -pady 2m - button $id.buttonframe.cancel -text {Cancel}\ - -command "canvas_cancel $id" - button $id.buttonframe.apply -text {Apply}\ - -command "canvas_apply $id" - button $id.buttonframe.ok -text {OK}\ - -command "canvas_ok $id" - pack $id.buttonframe.cancel -side left -expand 1 - pack $id.buttonframe.apply -side left -expand 1 - pack $id.buttonframe.ok -side left -expand 1 - - bind $id.xscale.entry <KeyPress-Return> [concat canvas_ok $id] - bind $id.yscale.entry <KeyPress-Return> [concat canvas_ok $id] - $id.xscale.entry select from 0 - $id.xscale.entry select adjust end - focus $id.xscale.entry -} - -############ pdtk_data_dialog -- run a data dialog ######### -proc dodata_send {name} { -# puts stderr [$name.text get 0.0 end] - - for {set i 1} {[$name.text compare [concat $i.0 + 3 chars] < end]} \ - {incr i 1} { -# puts stderr [concat it's [$name.text get $i.0 [expr $i + 1].0]] - set cmd [concat $name data [$name.text get $i.0 [expr $i + 1].0] \;] -# puts stderr $cmd - pd $cmd - } - set cmd [concat $name end \;] -# puts stderr $cmd - pd $cmd -} - -proc dodata_cancel {name} { - set cmd [concat $name cancel \;] -# puts stderr $cmd - pd $cmd -} - -proc dodata_ok {name} { - dodata_send $name - dodata_cancel $name -} - -proc pdtk_data_dialog {name stuff} { - - toplevel $name - wm title $name {Atom} - wm protocol $name WM_DELETE_WINDOW [concat dodata_cancel $name] - - frame $name.buttonframe - pack $name.buttonframe -side bottom -fill x -pady 2m - button $name.buttonframe.send -text {Send (Ctrl s)}\ - -command [concat dodata_send $name] - button $name.buttonframe.ok -text {OK (Ctrl t)}\ - -command [concat dodata_ok $name] - pack $name.buttonframe.send -side left -expand 1 - pack $name.buttonframe.ok -side left -expand 1 - - text $name.text -relief raised -bd 2 -height 40 -width 60 \ - -yscrollcommand "$name.scroll set" -font fixed - scrollbar $name.scroll -command "$name.text yview" - pack $name.scroll -side right -fill y - pack $name.text -side left -fill both -expand 1 - $name.text insert end $stuff - focus $name.text - bind $name.text <Control-t> [concat dodata_ok $name] - bind $name.text <Control-s> [concat dodata_send $name] -} - -############ check or uncheck the "edit" menu item ############## -#####################iemlib####################### -proc pdtk_canvas_editval {name value} { - if { $value } { - $name.m.edit.m entryconfigure "Edit mode" -indicatoron true - } else { - $name.m.edit.m entryconfigure "Edit mode" -indicatoron false - } -} - -proc pdtk_canvas_protectval {name value} { - if { $value } { - $name.m.edit.m entryconfigure "Protect" -indicatoron true - } else { - $name.m.edit.m entryconfigure "Protect" -indicatoron false - } -} -#####################iemlib####################### - -############ pdtk_text_new -- create a new text object #2########### -proc pdtk_text_new {canvasname myname x y text font color} { -# if {$font < 13} {set fontname [format fixed $font]} -# if {$font >= 13} {set fontname [format fixed $font]} - $canvasname create text $x $y \ - -font [format fixed $font] \ - -tags $myname -text $text -fill $color -anchor nw -# pd [concat $myname size [$canvasname bbox $myname] \;] -} - -################ pdtk_text_set -- change the text ################## -proc pdtk_text_set {canvasname myname text} { - $canvasname itemconfig $myname -text $text -# pd [concat $myname size [$canvasname bbox $myname] \;] -} - -############### event binding procedures for Pd window ################ - -proc pdtk_pd_ctrlkey {name key shift} { -# puts stderr [concat key $key shift $shift] -# .dummy itemconfig goo -text [concat ---> control-key event $key]; - if {$key == "n" || $key == "N"} {menu_new} - if {$key == "o" || $key == "O"} {menu_open} - if {$key == "m" || $key == "M"} {menu_send} - if {$key == "q" || $key == "Q"} { - if {$shift == 1} {menu_really_quit} else {menu_quit} - } - if {$key == "slash"} {menu_audio 1} - if {$key == "period"} {menu_audio 0} -} - -######### startup function. ############## -# Tell pd the current directory; this is used in case the command line -# asked pd to open something. Also, get character width and height for -# font sizes 8, 10, 12, 14, 16, and 24. - -proc pdtk_pd_startup {version} { - global pd_myversion - set pd_myversion $version - - set width1 [font measure fixed x] - set height1 [lindex [font metrics fixed] 5] - - set width2 [font measure fixed x] - set height2 [lindex [font metrics fixed] 5] - - set width3 [font measure fixed x] - set height3 [lindex [font metrics fixed] 5] - - set width4 [font measure fixed x] - set height4 [lindex [font metrics fixed] 5] - - set width5 [font measure fixed x] - set height5 [lindex [font metrics fixed] 5] - - set width6 [font measure fixed x] - set height6 [lindex [font metrics fixed] 5] - - set width7 [font measure fixed x] - set height7 [lindex [font metrics fixed] 5] - - pd [concat pd init [pdtk_enquote [pwd]] \ - 8 $width1 $height1 \ - 10 $width2 $height2 \ - 12 $width3 $height3 \ - 14 $width4 $height4 \ - 16 $width5 $height5 \ - 24 $width6 $height6 \ - 36 $width7 $height7 \ - \;]; -} - -##################### DSP ON/OFF, METERS, DIO ERROR ################### -proc pdtk_pd_dsp {value} { - global ctrls_audio_on - if {$value == "ON"} {set ctrls_audio_on 1} else {set ctrls_audio_on 0} -# puts stderr [concat its $ctrls_audio_on] -} - -proc pdtk_pd_meters {indb outdb inclip outclip} { -# puts stderr [concat meters $indb $outdb $inclip $outclip] - global ctrls_inlevel ctrls_outlevel - set ctrls_inlevel $indb - if {$inclip == 1} { - .controls.in.clip configure -background red - } else { - .controls.in.clip configure -background grey - } - set ctrls_outlevel $outdb - if {$outclip == 1} { - .controls.out.clip configure -background red - } else { - .controls.out.clip configure -background grey - } - -} - -proc pdtk_pd_dio {red} { -# puts stderr [concat dio $red] - if {$red == 1} { - .controls.dio configure -background red -activebackground red - } else { - .controls.dio configure -background grey -activebackground lightgrey - } - -} - -############# text editing from the "edit" menu ################### -set edit_number 1 - -proc texteditor_send {name} { - set topname [string trimright $name .text] - for {set i 0} \ - {[$name compare [concat 0.0 + [expr $i + 1] chars] < end]} \ - {incr i 1} { - set cha [$name get [concat 0.0 + $i chars]] - scan $cha %c keynum - pd [concat pd key 1 $keynum \;] - } -} - -proc texteditor_ok {name} { - set topname [string trimright $name .text] - texteditor_send $name - destroy $topname -} - - -proc pdtk_pd_texteditor {stuff} { - global edit_number - set name [format ".text%d" $edit_number] - set edit_number [expr $edit_number + 1] - - toplevel $name - wm title $name {TEXT} - - frame $name.buttons - pack $name.buttons -side bottom -fill x -pady 2m - button $name.buttons.send -text {Send (Ctrl s)}\ - -command "texteditor_send $name.text" - button $name.buttons.ok -text {OK (Ctrl t)}\ - -command "texteditor_ok $name.text" - pack $name.buttons.send -side left -expand 1 - pack $name.buttons.ok -side left -expand 1 - - text $name.text -relief raised -bd 2 -height 12 -width 60 \ - -yscrollcommand "$name.scroll set" -font fixed - scrollbar $name.scroll -command "$name.text yview" - pack $name.scroll -side right -fill y - pack $name.text -side left -fill both -expand 1 - $name.text insert end $stuff - focus $name.text - bind $name.text <Control-t> {texteditor_ok %W} - bind $name.text <Control-s> {texteditor_send %W} -} - -############# open and save dialogs for objects in Pd ########## - -proc pdtk_openpanel {target} { - global pd_opendir - global pd_nt - if {$pd_nt == 2} { - cd $pd_opendir - set filename [tk_getOpenFile ] - } else { - set filename [tk_getOpenFile \ - -initialdir $pd_opendir] - } - if {$filename != ""} { - set directory [string range $filename 0 \ - [expr [string last / $filename ] - 1]] - set pd_opendir $directory - - pd [concat $target symbol [pdtk_enquote $filename] \;] - } -} - -proc pdtk_savepanel {target} { - set filename [tk_getSaveFile] - if {$filename != ""} { - pd [concat $target symbol [pdtk_enquote $filename] \;] - } -} - -########################### comport hack ######################## - -set com1 0 -set com2 0 -set com3 0 -set com4 0 - -proc com1_open {} { - global com1 - set com1 [open com1 w] - .dummy itemconfig goo -text $com1 - fconfigure $com1 -buffering none - fconfigure $com1 -mode 19200,e,8,2 -} - -proc com1_send {str} { - global com1 - puts -nonewline $com1 $str -} - - -############# start a polling process to watch the socket ############## -# this is needed for nt, and presumably for Mac as well. -# in UNIX this is handled by a tcl callback (set up in t_tkcmd.c) - -if {$pd_nt == 1} { - proc polleofloop {} { - pd_pollsocket - after 20 polleofloop - } - - polleofloop -} - |