[PD-cvs] pd/src desire.tk,1.1.2.249,1.1.2.250

[Mathieu Bouchard]

Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8581

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
added class GAtomPropertiesDialog


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.249
retrieving revision 1.1.2.250
diff -C2 -d -r1.1.2.249 -r1.1.2.250
*** desire.tk	19 Jun 2006 05:43:14 -0000	1.1.2.249
--- desire.tk	19 Jun 2006 06:09:28 -0000	1.1.2.250
***************
*** 3115,3118 ****
--- 3115,3172 ----
  def* CanvasPropertiesDialog cancel {id} {pd ".$self cancel ;"}
  
+ 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}
+ 	wherelabel "show label on: "  side {}
+ 	symto      "send symbol: "    entry {-width 20}
+ 	symfrom    "receive symbol: " entry {-width 20}
+ }
+ 
+ proc gatom_escape {sym} {
+     if {[string length $sym] == 0} {
+     	return "-"
+     } else {
+     	if {[string equal -length 1 $sym "-"]} {
+ 	    return [string replace $sym 0 0 "--"]
+ 	} else {
+ 	    return $sym
+ 	}
+     }
+ }
+ 
+ proc gatom_unescape {sym} {
+     if {[string equal -length 1 $sym "-"]} {
+     	return [string replace $sym 0 0 ""]
+     } else {
+ 	return $sym
+     }
+ }
+ 
+ class_new GAtomPropertiesDialog {Dialog}
+ 
+ def GAtomPropertiesDialog apply {} {
+     pd ".$self param $@width $@lo $@hi [gatom_escape $@label] $@wherelabel \
+ 	[gatom_escape $@symfrom] [gatom_escape $@symto] ;"
+ }
+ 
+ def GAtomPropertiesDialog cancel {} {pd ".$self cancel ;"}
+ 
+ def GAtomPropertiesDialog init {of} {
+     super $of
+     foreach var {width lo hi wherelabel} {set @$var $_($of:$var)}
+     foreach var {label symfrom symto} {set @$var [gatom_unescape $_($of:$var)]}
+     wm title .$self "Atom"
+     global properties
+     properties_dialog $self .$self dogatom_ok $properties(gatom)
+     foreach name {hi lo width} {
+ 	bind .$self.$name.entry <KeyPress-Return> "$self ok"
+     }
+     .$self.width.entry select from 0
+     .$self.width.entry select adjust end
+     focus .$self.width.entry
+ }
+ 
  class_new NumBox {Labeled Box}
  def* NumBox init {args} {