[PD-cvs] pd/src desire.tk,1.1.2.600.2.362,1.1.2.600.2.363

chunlee chunlee at users.sourceforge.net
Mon Aug 13 17:36:39 CEST 2007


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

Modified Files:
      Tag: desiredata
	desire.tk 
Log Message:
num/floatbox stuff


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.600.2.362
retrieving revision 1.1.2.600.2.363
diff -C2 -d -r1.1.2.600.2.362 -r1.1.2.600.2.363
*** desire.tk	13 Aug 2007 08:05:49 -0000	1.1.2.600.2.362
--- desire.tk	13 Aug 2007 15:36:35 -0000	1.1.2.600.2.363
***************
*** 1430,1439 ****
  	set canvas $@canvas
  	if {$canvas == ""} {return ""}
! 	while {![winfo exists [$canvas widget]]} {set canvas [$canvas canvas]}
! 	if {[regexp {x[0-9a-f]{6,8}} [focus] focus] && [$@canvas gop]} {
! 		set topcanvas1 [$focus get_topcanvas]
! 		set topcanvas2 [$canvas get_topcanvas]
! 		if {$focus != $canvas && $topcanvas1 == $topcanvas2} {set canvas $focus}
! 	}
  	return $canvas
  }
--- 1430,1434 ----
  	set canvas $@canvas
  	if {$canvas == ""} {return ""}
! 	#while {![$canvas havewindow]} {set canvas [$canvas canvas]}
  	return $canvas
  }
***************
*** 2830,2833 ****
--- 2825,2829 ----
  def Canvas mapped= {v} {set @mapped $v}
  
+ def Canvas havewindow {} {return $@havewindow}
  def Canvas havewindow= {flag} {
  	# race condition!
***************
*** 5793,5806 ****
  }
  
! def FloatBox  init {mess} {super $mess; set @text 0}
! def SymbolBox init {mess} {super $mess; set @text "symbol"}
  
! # why does this exist?
! # this exists because server sends this for floatbox: -> x806ac20 set 23.000000
! def AtomBox set {text} {
! 	set @text [string range $text 0 [expr $@w-1]]; #perhaps server should take care of this..
! 	$self changed
  }
  
  def AtomBox setto {text} {
  	[$@canvas widget] configure -cursor {}
--- 5789,5810 ----
  }
  
! def FloatBox  init {mess} {super $mess; set @text 0;}
  
! def FloatBox calc {x y x1 y1} {
! 	puts "$@min $@max"
! 	if {!$@min && !$@max} {
! 		set d [expr $@ovalue+($y1-$y)*$@rate]
! 	} else {
! 		set span [expr $@max-$@min]
! 		set l [expr $@max-$@min]
! 		set d [clip [expr $@ovalue+(($y1-$y)*$span/($l+0.0))*$@rate] $@min $@max]
! 	}
! 	return $d
  }
  
+ def SymbolBox init {mess} {super $mess; set @text "symbol"}
+ 
+ def AtomBox set {val} {set @text [format "%g" $val]; $self changed}
+ 
  def AtomBox setto {text} {
  	[$@canvas widget] configure -cursor {}
***************
*** 5811,5814 ****
--- 5815,5819 ----
  	}
  }
+ def SymbolBox set {text} {set @text $text}
  def SymbolBox setto {text} {
  	[$@canvas widget] configure -cursor {}
***************
*** 5856,5866 ****
  	if {$@edit} {return}
  	mset {clx cly} $@clickpos
! 	set d [$self calc $x $y $clx $cly]
! 	if {[$self class] == "NumBox"} {
! 		set t [expr $@is_log ? $@ovalue*exp($d*$@rate*[$self log_ratio]) : $@ovalue+$d*$@rate]
! 	} else {
! 		set t [expr $@ovalue+$d*$@rate]
! 	}
! 	set @text [clip $t $@min $@max]
  	netsend [list .$self float [expr {0+$@text}]]
  }
--- 5861,5865 ----
  	if {$@edit} {return}
  	mset {clx cly} $@clickpos
! 	set @text [$self calc $x $y $clx $cly]
  	netsend [list .$self float [expr {0+$@text}]]
  }
***************
*** 5871,5885 ****
  }
  
- def AtomBox calc {x y x1 y1} {
- 	set span [expr $@max-$@min]
- 	if {[$self class] == "NumBox"} {
- 		set l [expr $@is_log ? $@log_height : ($@max-$@min)]
- 	} else {set l [expr $@max-$@min]}
- 	if {!$l} {set l 127}
- 	set d [expr {($y1-$y)*$span/($l+0.0)}]
- 	return $d
- }
- 
- 
  def AtomBox key_incr {val1 val2} {
  	set @text [expr $@text - $val2]
--- 5870,5873 ----
***************
*** 5898,5901 ****
--- 5886,5899 ----
  }
  
+ def NumBox calc {x y x1 y1} {
+ 	set span [expr $@max-$@min]
+ 	set l [expr $@is_log ? $@log_height : ($@max-$@min)]
+ 	set d [expr {($y1-$y)*$span/($l+0.0)}]
+ 	set d [expr $@is_log ? $@ovalue*exp($d*$@rate*[$self log_ratio]) : $@ovalue+$d*$@rate]
+ 	set d [clip $d $@min $@max]
+ 	return $d
+ }
+ 
+ 
  def NumBox reinit {mess} {
  	super $mess





More information about the Pd-cvs mailing list