[PD-cvs] pd/src desire.tk,1.1.2.600.2.112,1.1.2.600.2.113

Mathieu Bouchard matju at users.sourceforge.net
Tue Dec 19 17:40:14 CET 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"





More information about the Pd-cvs mailing list