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} {