[PD-cvs] pd/src u_main.tk,1.1.1.4.2.7.4.12,1.1.1.4.2.7.4.13
matju at users.sourceforge.net
matju at users.sourceforge.net
Mon Mar 15 02:14:08 CET 2004
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
}
More information about the Pd-cvs
mailing list