[PD-cvs] pd/src desire.tk,1.1.2.238,1.1.2.239
Mathieu Bouchard
matju at users.sourceforge.net
Tue Jun 13 18:53:05 CEST 2006
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16259
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
added IEM properties dialog (from impd)
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.238
retrieving revision 1.1.2.239
diff -C2 -d -r1.1.2.238 -r1.1.2.239
*** desire.tk 13 Jun 2006 16:04:53 -0000 1.1.2.238
--- desire.tk 13 Jun 2006 16:53:03 -0000 1.1.2.239
***************
*** 2953,2956 ****
--- 2953,3034 ----
}
+ def BlueBox popup_properties {} {IEMPropertiesDialog new $self}
+
+ class_new PropertiesDialog {Dialog}
+
+ def PropertiesDialog init {of} {
+ super
+ set @of $of
+ }
+
+ class_new IEMPropertiesDialog {PropertiesDialog}
+
+ def IEMPropertiesDialog init {of} {
+ global classinfo fields
+ super $of
+ foreach var {snd rcv lab} {
+ catch {set val $_($@of:$var); switch -- $val { empty {set val ""}}; set @$var $val}
+ }
+ foreach var {w h hold break ldx ldy fstyle fs is_log steady min max
+ on nonzero val change log_height hh isa} {
+ catch {set @$var $_($obj:$var)}
+ }
+ foreach var {bcol fcol lcol} {
+ catch {set @$var [parse_color $_($obj:$var)]}
+ }
+
+ # watch out. have to figure this one out.
+ catch {set @loadbang [expr $@isa & 1]}
+ catch {set @scale [expr $@isa>>20) & 1]}
+
+ set @class $_($of:class)
+ post %s "$self = IEMPropertiesDialog $of"
+ set id .$self
+ wm title $id "$classinfo($@class) Properties"
+ wm protocol $id WM_DELETE_WINDOW "iemgui_cancel $id"
+ set props {}
+
+ set fi $fields($@class)
+
+ if {[lsearch $fi w]>=0} {lappend props w "width(px): " integer {-width 7}}
+ if {[lsearch $fi h]>=0} {lappend props h "height(px): " integer {-width 7}}
+ if {[lsearch $fi hold]>=0} {lappend props hold "hold time(ms): " float {-width 9}}
+ if {[lsearch $fi break]>=0} {lappend props break "break time(ms): " float {-width 9}}
+
+ if {[lsearch $fi min]>=0} {lappend props min "minimum value: " float {-width 9}}
+ if {[lsearch $fi max]>=0} {lappend props max "maximum value: " float {-width 9}}
+ if {[lsearch $fi is_log]>=0} {lappend props is_log [list "Mode: " "linear" "logarithmic"] choice {}}
+ if {[lsearch $fi isa]>=0} {lappend props loadbang "init" toggle {}}
+ if {[lsearch $fi n]>=0} {lappend props n "n: " integer {-width 4}}
+ if {[lsearch $fi steady]>=0} {lappend props steady [list "Steadiness: " "jump on click" "steady on click"] choice {}}
+ properties_dialog $self .$self iemgui_ok $props
+ set props {}
+ if {[lsearch $fi snd]>=0} {lappend props snd "send-symbol: " entry {-width 20}}
+ if {[lsearch $fi rcv]>=0} {lappend props rcv "receive-symbol: " entry {-width 20}}
+ lappend props lab "label: " entry {-width 20}
+ lappend props ldx "label x offset: " entry {-width 5}
+ lappend props ldy "label y offset: " entry {-width 5}
+ lappend props fstyle {"Typeface: " "courier (typewriter)" "helvetica (sansserif)" "times (serif)"} choice {}
+ lappend props fs "font size: " fontsize {-width 5}
+ lappend props bcol "background color: " color {}
+ if {[lsearch $fi fcol]>=0} {lappend props fcol "foreground color: " color {}}
+ lappend props lcol "label color: " color {}
+ properties_dialog $self .$self iemgui_ok $props
+ cancel_apply_ok $self iemgui
+
+ if {[info tclversion] < 8.4} {
+ bind $id <Key-Tab> {tkTabToWindow [tk_focusNext %W]}
+ bind $id <<PrevWindow>> {tkTabToWindow [tk_focusPrev %W]}
+ } else {
+ bind $id <Key-Tab> {tk::TabToWindow [tk_focusNext %W]}
+ bind $id <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]}
+ }
+ catch {
+ $id.w.entry select from 0
+ $id.w.entry select adjust end
+ }
+ focus $id.w.entry
+ }
+
class_new NumBox {Labeled Box}
def* NumBox init {args} {
More information about the Pd-cvs
mailing list