[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