pd/src desire.tk,1.1.2.600.2.112,1.1.2.600.2.113 - Pd-cvs

19 Dec 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14810
Modified Files:
      Tag: desiredata
    desire.tk 
Log Message:
Sliders can be reconfigured from horizontal to vertical and back
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.600.2.112
retrieving revision 1.1.2.600.2.113
diff -C2 -d -r1.1.2.600.2.112 -r1.1.2.600.2.113
*** desire.tk	19 Dec 2006 15:01:23 -0000	1.1.2.600.2.112
--- desire.tk	19 Dec 2006 16:40:10 -0000	1.1.2.600.2.113
***************
*** 4588,4597 ****
  class_new IEMPropertiesDialog {PropertiesDialog}
! def IEMGUI properties_apply {args} {
    set orig [list $self properties_apply]
    foreach var [lrange $::fields($@class) 5 end] {lappend orig $@$var}
    [$@canvas history] add $orig
! 	foreach v $args {switch -- $v {{} {set v "empty"}}; lappend props $v}
    netsend [concat [list .$self reload] $props]
  }
--- 4588,4600 ----
  class_new IEMPropertiesDialog {PropertiesDialog}
! def IEMGUI properties_apply {list {orient -1}} {
    set orig [list $self properties_apply]
    foreach var [lrange $::fields($@class) 5 end] {lappend orig $@$var}
    [$@canvas history] add $orig
! 	foreach v $list {switch -- $v {{} {set v "empty"}}; lappend props $v}
    netsend [concat [list .$self reload] $props]
+ 	if {$orient >= 0} {
+ 		netsend [list .$self orient $orient]
+ 	}
  }
***************
*** 4605,4609 ****
    	lappend props $v
    }
! 	eval [concat [list $@of properties_apply] $props]
  }
--- 4608,4616 ----
    	lappend props $v
    }
! 	if {[[$@of class] <= Slider] || [[$@of class] <= Radio]} {
! 		$@of properties_apply $props $@orient
! 	} else {
! 		$@of properties_apply $props
! 	}
  }
***************
*** 4612,4619 ****
    super $of
! 	set class $_($of:class)
! 	wm title .$self "[$class] [say popup_properties]"
! 	if {![info exists fields($class)]} {set class obj}
! 	foreach var $fields($class) {
    	set val $_($of:$var)
    	switch -- $val { empty {set val ""}}
--- 4619,4626 ----
    super $of
! 	set @class $_($of:class)
! 	wm title .$self "[$@class] [say popup_properties]"
! 	if {![info exists fields($@class)]} {set class obj}
! 	foreach var $fields($@class) {
    	set val $_($of:$var)
    	switch -- $val { empty {set val ""}}
***************
*** 4621,4627 ****
    	set @$var $val
    }
! 	set @class $_($of:class)
! 	foreach prop [lrange $fields($class) 5 end] {
! 		set d [concat $prop [switch $prop {
    		w      {list integer -width 7}
    		h      {list integer -width 7}
--- 4628,4637 ----
    	set @$var $val
    }
! 	if {[[$of class] <= Slider] || [[$of class] <= Radio]} {
! 		set @orient $_($of:orient)
! 		$self add .$self [list orient choice -choices {horizontal vertical}]
! 	}
! 	foreach prop [lrange $fields($@class) 5 end] {
! 		set d [concat [list $prop] [switch $prop {
    		w      {list integer -width 7}
    		h      {list integer -width 7}
***************
*** 4654,4663 ****
    	}]]
    	$self add .$self $d
- 		set textvar ${prop}2; # used as textvariable
- 		set textops ${prop}list; # store the options for later
- 		if {$prop == "steady" || $prop == "is_log" || $prop == "isa" || $prop == "fstyle"} {
- 			set @$textops [lindex $d end]
- 			set @$textvar [say [lindex $@$textops $@$prop]]
- 		}
    }
  }
--- 4664,4667 ----
***************
*** 4665,4669 ****
  def IEMPropertiesDialog dropmenu_open {f name} {super $f}
  def IEMPropertiesDialog dropmenu_set {frame var part val} {
! 	set tmp ${var}list
    set textvar ${var}2
    set @$textvar [say [lindex $@$tmp $val]]
--- 4669,4673 ----
  def IEMPropertiesDialog dropmenu_open {f name} {super $f}
  def IEMPropertiesDialog dropmenu_set {frame var part val} {
! 	set tmp ${var}choices
    set textvar ${var}2
    set @$textvar [say [lindex $@$tmp $val]]
***************
*** 4970,4991 ****
  class_new Radio {BlueBox}
! def Radio orient {} {
! 	switch $@class {
! 		hradio {return 0} hdl {return 0}
! 		vradio {return 1} vdl {return 1}
! 		default {return 0}
    }
  }
def Radio bbox {} {
- 	set orient [$self orient]
    mset {x1 y1} [$self xy]
! 	set x2 [expr $x1+$@w*($orient?1:$@n)]
! 	set y2 [expr $y1+$@w*($orient?$@n:1)]
    list $x1 $y1 $x2 $y2
  }
def Radio draw {} {
- 	set orient [$self orient]
    mset {x1 y1 x2 y2} [$self bbox]
    set ins  [expr [string compare $@rcv empty]==0]
--- 4974,4994 ----
  class_new Radio {BlueBox}
! def Radio reinit {mess} {
! 	super $mess
! 	switch [lindex $mess 4] {
! 		hradio {set @orient 0} hdl {set @orient 0}
! 		vradio {set @orient 1} vdl {set @orient 1}
! 		default {set @orient 0}
    }
  }
def Radio bbox {} {
    mset {x1 y1} [$self xy]
! 	set x2 [expr $x1+$@w*($@orient ?1:$@n)]
! 	set y2 [expr $y1+$@w*($@orient ?$@n:1)]
    list $x1 $y1 $x2 $y2
  }
def Radio draw {} {
    mset {x1 y1 x2 y2} [$self bbox]
    set ins  [expr [string compare $@rcv empty]==0]
***************
*** 4996,5000 ****
    	    [list [expr $x1+3] [expr $y1+3] [expr $x1+$@w-3] [expr $y1+$@w-3]] \
    	    -fill #ffffff -outline #000000 
! 		if {$orient} {set y1 [expr $y1+$@w]} {set x1 [expr $x1+$@w]}
    }
    $self set $@on
--- 4999,5003 ----
    	    [list [expr $x1+3] [expr $y1+3] [expr $x1+$@w-3] [expr $y1+$@w-3]] \
    	    -fill #ffffff -outline #000000 
! 		if {$@orient} {set y1 [expr $y1+$@w]} {set x1 [expr $x1+$@w]}
    }
    $self set $@on
***************
*** 5010,5015 ****
    $@canvas focus= $self
    mset {x1 y1} [$self xy]
! 	set orient [$self orient]
! 	set i [expr {($orient?$y-$y1:$x-$x1)/$@w}]
    netsend [list .$self fout $i]
  }
--- 5013,5017 ----
    $@canvas focus= $self
    mset {x1 y1} [$self xy]
! 	set i [expr {($@orient ?$y-$y1:$x-$x1)/$@w}]
    netsend [list .$self fout $i]
  }
***************
*** 5018,5022 ****
class_new Slider {BlueBox}
! def Slider orient {} {switch $@class {vsl {return 1} default {return 0}}}
def Slider init {mess} {
--- 5020,5031 ----
class_new Slider {BlueBox}
! 
! def Slider reinit {mess} {
! 	super $mess
! 	switch [lindex $mess 4] {
! 		hsl {set @orient 0}
! 		vsl {set @orient 1}
! 	}
! }
def Slider init {mess} {
***************
*** 5032,5039 ****
  def Slider draw_knob {} {
    mset {x1 y1 x2 y2} [$self bbox]
! 	set l [expr [$self orient]?$@h:$@w]
    set span [expr $@max-$@min]
    set color [$self look bg]
! 	if {[$self orient]} {
    	set size $@w
    	set y1 [expr $y1+$@h-$@value*($l-1)/$span-2]
--- 5041,5048 ----
  def Slider draw_knob {} {
    mset {x1 y1 x2 y2} [$self bbox]
! 	set l [expr $@orient ?$@h:$@w]
    set span [expr $@max-$@min]
    set color [$self look bg]
! 	if {$@orient} {
    	set size $@w
    	set y1 [expr $y1+$@h-$@value*($l-1)/$span-2]
***************
*** 5055,5061 ****
    set xs $@w
    set ys $@h
! 	set orient [$self orient]
! 	if {$orient} {set y1 [expr $y1-2]} {set x1 [expr $x1-2]}
! 	if {$orient} {set ys [expr $ys+5]} {set xs [expr $xs+5]}
    set ins  [expr [string compare $@rcv empty]==0]
    set outs [expr [string compare $@snd empty]==0]
--- 5064,5069 ----
    set xs $@w
    set ys $@h
! 	if {$@orient} {set y1 [expr $y1-2]} {set x1 [expr $x1-2]}
! 	if {$@orient} {set ys [expr $ys+5]} {set xs [expr $xs+5]}
    set ins  [expr [string compare $@rcv empty]==0]
    set outs [expr [string compare $@snd empty]==0]
***************
*** 5069,5074 ****
  # not used
  def Slider draw_notches {} {
! 	set orient [$self orient]
! 	if {$orient} {
    	set thick [clip [expr $xs/3] 1 5]
    	set x3 [expr $x1+$xs-$thick/2-2]
--- 5077,5081 ----
  # not used
  def Slider draw_notches {} {
! 	if {$@orient} {
    	set thick [clip [expr $xs/3] 1 5]
    	set x3 [expr $x1+$xs-$thick/2-2]
***************
*** 5115,5122 ****
def Slider calc {x y x1 y1} {
- 	set orient [$self orient]
    set span [expr $@max-$@min]
! 	set l [expr {$orient?$@h:$@w}]
! 	set d [expr {($orient?$y1-$y:$x-$x1)*$span/($l+0.0)}]
    return $d
  }
--- 5122,5128 ----
def Slider calc {x y x1 y1} {
    set span [expr $@max-$@min]
! 	set l [expr {$@orient ?$@h:$@w}]
! 	set d [expr {($@orient ?$y1-$y:$x-$x1)*$span/($l+0.0)}]
    return $d
  }
***************
*** 6051,6055 ****
    }
    set trim_name [string trimleft $name "-"]
! 	set _($self:${name}2) [say $@$name]
    label $f.butt -textvariable _($self:${name}2) -relief raised -width 20
    balloon $f.butt "click to change setting"
--- 6057,6062 ----
    }
    set trim_name [string trimleft $name "-"]
! 	set _($self:${name}2) [say [lindex $choices $@$name]]
! 	set _($self:${name}choices) $choices
    label $f.butt -textvariable _($self:${name}2) -relief raised -width 20
    balloon $f.butt "click to change setting"