Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7537
Modified Files: Tag: impd_0_37 u_main.tk Log Message: added an automatic dialog generator, proc properties_dialog
Index: u_main.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/u_main.tk,v retrieving revision 1.1.1.4.2.7.4.12 retrieving revision 1.1.1.4.2.7.4.13 diff -C2 -d -r1.1.1.4.2.7.4.12 -r1.1.1.4.2.7.4.13 *** u_main.tk 14 Mar 2004 22:33:54 -0000 1.1.1.4.2.7.4.12 --- u_main.tk 15 Mar 2004 01:14:05 -0000 1.1.1.4.2.7.4.13 *************** *** 68,75 **** frame .controls pack .controls .dummy -side top -fill x ! menu .mbar.file -tearoff $pd_tearoff ! .mbar add cascade -label "File" -menu .mbar.file ! menu .mbar.find -tearoff $pd_tearoff ! .mbar add cascade -label "Find" -menu .mbar.find menu .mbar.windows -postcommand [concat pdtk_fixwindowmenu] -tearoff $pd_tearoff menu .mbar.audio -tearoff $pd_tearoff --- 68,73 ---- frame .controls pack .controls .dummy -side top -fill x ! menu .mbar.file -tearoff $pd_tearoff; .mbar add cascade -label "File" -menu .mbar.file ! menu .mbar.find -tearoff $pd_tearoff; .mbar add cascade -label "Find" -menu .mbar.find menu .mbar.windows -postcommand [concat pdtk_fixwindowmenu] -tearoff $pd_tearoff menu .mbar.audio -tearoff $pd_tearoff *************** *** 92,102 **** 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 ;]}
--- 90,98 ---- 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 ;]}
*************** *** 356,368 **** }
############# routine to add audio and help menus ###############
proc menu_addstd {mbar} { global pd_apilist ! # the "Audio" menu ! $mbar.audio add command -label {audio ON} -accelerator [accel_munge "Ctrl+/"] \ ! -command {menu_audio 1} ! $mbar.audio add command -label {audio OFF} -accelerator [accel_munge "Ctrl+."] \ ! -command {menu_audio 0} for {set x 0} {$x<[llength $pd_apilist]} {incr x} { $mbar.audio add radiobutton -label [lindex [lindex $pd_apilist $x] 0] \ --- 352,379 ---- }
+ proc populate_menu {menu context list} { + foreach e $list { + switch [llength $e] { + 0 { + $menu add separator + } + 3 { + set cmd [lindex $e 1] + regsub %W $cmd $context cmd + $menu add command -label [lindex $e 0] -command $cmd \ + -accelerator [accel_munge [lindex $e 2]] + } + } + } + } + ############# routine to add audio and help menus ###############
proc menu_addstd {mbar} { global pd_apilist ! populate_menu $mbar.audio {} { ! {"audio ON" {menu_audio 1} "Ctrl+/"} ! {"audio OFF" {menu_audio 0} "Ctrl+."} ! } for {set x 0} {$x<[llength $pd_apilist]} {incr x} { $mbar.audio add radiobutton -label [lindex [lindex $pd_apilist $x] 0] \ *************** *** 610,629 **** }
- proc populate_menu {menu context list} { - foreach e $list { - switch [llength $e] { - 0 { - $menu add separator - } - 3 { - set cmd [lindex $e 1] - regsub %W $cmd $context cmd - $menu add command -label [lindex $e 0] -command $cmd \ - -accelerator [accel_munge [lindex $e 2]] - } - } - } - } - ############# pdtk_canvas_new -- create a new canvas ############### proc pdtk_canvas_new {name width height geometry editable} { --- 621,624 ---- *************** *** 1076,1088 ****
proc pdtk_canvas_dofont {name initsize} { ! ! global fontsize ! set fontsize $initsize ! ! global stretchval ! set stretchval 100 ! ! global whichstretch ! set whichstretch 1
toplevel $name --- 1071,1077 ----
proc pdtk_canvas_dofont {name initsize} { ! global fontsize; set fontsize $initsize ! global stretchval; set stretchval 100 ! global whichstretch; set whichstretch 1
toplevel $name *************** *** 1092,1102 **** 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 --- 1081,1086 ---- frame $name.buttonframe pack $name.buttonframe -side bottom -fill x -pady 2m ! button $name.buttonframe.cancel -text {Cancel} -command "dofont_cancel $name"; pack $name.buttonframe.cancel -side left -expand 1 ! button $name.buttonframe.ok -text {Do it} -command "dofont_apply $name"; pack $name.buttonframe.ok -side left -expand 1 frame $name.radiof pack $name.radiof -side left *************** *** 1111,1134 **** 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} { --- 1095,1152 ---- 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 + }
+ ############ properties_dialog ######### + + proc properties_dialog {self struct} { + foreach {name label type options} $struct { + frame .$self.$name + label .$self.$name.label -text $label + pack .$self.$name.label -side left + switch $type { + entry { + eval [concat entry .$self.$name.entry \ + -textvariable data($self:$name) $options] + pack .$self.$name.entry -side left + } + side { + frame .$self.$name.side -relief ridge -borderwidth 2 + pack .$self.$name.side -side top + foreach {i side} {0 left 1 right 2 top 3 bottom} { + radiobutton .$self.$name.side.$side -value $i \ + -variable data($self:wherelabel) -text $side + } + pack .$self.$name.side.left -side left -fill y + pack .$self.$name.side.right -side right -fill y + pack .$self.$name.side.top -side top + pack .$self.$name.side.bottom -side bottom + + } + } + pack .$self.$name -side top + } }
############ pdtk_gatom_dialog -- run a gatom dialog #########
! set properties(gatom) { ! width "width: " entry {-width 4} ! lo "lower limit: " entry {-width 8} ! hi "upper limit: " entry {-width 8} ! label "label: " entry {-width 20} ! whichlabel "show label on: " side {} ! symto "send symbol: " entry {-width 20} ! symfrom "receive symbol: " entry {-width 20} ! }
proc gatom_escape {sym} { *************** *** 1164,1299 **** 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.apply -text {Apply}\ ! -command "dogatom_apply $id" ! button $id.buttonframe.ok -text {OK}\ ! -command "dogatom_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.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 }
--- 1182,1232 ---- proc dogatom_apply {id} { set vid [string trimleft $id .] ! global data ! pd "$id param $data($vid:width) $data($vid:lo) $data($vid:hi) \ ! [gatom_escape $data($vid:label)] \ ! $data($vid:wherelabel) \ ! $data($vid:symfrom) \ ! [gatom_escape $data($vid:symto)] ;" }
! proc dogatom_cancel {name} {pd "$name cancel ;"} ! proc dogatom_ok {name} {dogatom_apply $name; dogatom_cancel $name}
! proc cancel_apply_ok {self procprefix} { ! frame .$self.buttonframe ! pack .$self.buttonframe -side bottom -fill x -pady 2m ! button .$self.buttonframe.cancel -text {Cancel} -command "${procprefix}_cancel .$self" ! button .$self.buttonframe.apply -text {Apply} -command "${procprefix}_apply .$self" ! button .$self.buttonframe.ok -text {OK} -command "${procprefix}_ok .$self" ! pack .$self.buttonframe.cancel -side left -expand 1 ! pack .$self.buttonframe.apply -side left -expand 1 ! pack .$self.buttonframe.ok -side left -expand 1 }
proc pdtk_gatom_dialog {id initwidth initlo inithi \ ! wherelabel label symfrom symto} { ! global data set vid [string trimleft $id .] ! set data($vid:width) $initwidth ! set data($vid:lo) $initlo ! set data($vid:gatomhi) $inithi ! set data($vid:wherelabel) $wherelabel ! set data($vid:label) [gatom_unescape $label] ! set data($vid:symfrom) [gatom_unescape $symfrom] ! set data($vid:symto) [gatom_unescape $symto]
toplevel $id wm title $id {Atom} wm protocol $id WM_DELETE_WINDOW [concat dogatom_cancel $id] + global properties + properties_dialog $vid $properties(gatom) + foreach name {hi lo width} { + bind $id.$name.entry <KeyPress-Return> [concat dogatom_ok $id] + } + $id.width.entry select from 0 + $id.width.entry select adjust end
! cancel_apply_ok $vid dogatom ! focus $id.width.entry }
*************** *** 1324,1336 **** ############ 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 --- 1257,1260 ---- *************** *** 1767,1775 **** 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 .] --- 1691,1695 ---- 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 .] *************** *** 1968,1972 **** set fontname [lindex {courier helvetica times} [eval concat $$var_iemgui_gn_f]] button $id.gnfs.fb -text $fontname -font [list $fontname 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 --- 1888,1892 ---- set fontname [lindex {courier helvetica times} [eval concat $$var_iemgui_gn_f]] button $id.gnfs.fb -text $fontname -font [list $fontname 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 *************** *** 2404,2416 **** set pd_apilist $apilist set font -*-courier-bold--normal- ! # set fontsizes {} ! set width1 [font measure $font-8-* x]; set height1 [lindex [font metrics $font-8-*] 5] ! set width2 [font measure $font-10-* x]; set height2 [lindex [font metrics $font-10-*] 5] ! set width3 [font measure $font-12-* x]; set height3 [lindex [font metrics $font-12-*] 5] ! set width4 [font measure $font-14-* x]; set height4 [lindex [font metrics $font-14-*] 5] ! set width5 [font measure $font-16-* x]; set height5 [lindex [font metrics $font-16-*] 5] ! set width6 [font measure $font-24-* x]; set height6 [lindex [font metrics $font-24-*] 5] ! set width7 [font measure $font-36-* x]; set height7 [lindex [font metrics $font-36-*] 5] ! set tclpatch [info patchlevel] if {$tclpatch == "8.3.0" || \ --- 2324,2333 ---- set pd_apilist $apilist set font -*-courier-bold--normal- ! set fontsizes {} ! foreach size {8 10 12 14 16 24 36} { ! lappend fontsizes $size ! lappend fontsizes [font measure $font-$size-* x] ! lappend fontsizes [lindex [font metrics $font-$size-*] 5] ! } set tclpatch [info patchlevel] if {$tclpatch == "8.3.0" || \ *************** *** 2422,2439 **** set oldtclversion 0 } ! 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 \ ! $oldtclversion ;]; ! # add the audio and help menus to the Pd window. We delayed this # so that we'd know the value of "apilist". menu_addstd .mbar - }
--- 2339,2346 ---- set oldtclversion 0 } ! pd [concat pd init [pdtk_enquote [pwd]] $fontsizes $oldtclversion ;]; # add the audio and help menus to the Pd window. We delayed this # so that we'd know the value of "apilist". menu_addstd .mbar }