[PD-cvs] pd/src desire.tk,1.1.2.600.2.59,1.1.2.600.2.60

chunlee chunlee at users.sourceforge.net
Mon Dec 11 17:33:11 CET 2006


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

Modified Files:
      Tag: desiredata
	desire.tk 
Log Message:
NumBox is now a subclass of AtomBox


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.600.2.59
retrieving revision 1.1.2.600.2.60
diff -C2 -d -r1.1.2.600.2.59 -r1.1.2.600.2.60
*** desire.tk	11 Dec 2006 03:38:21 -0000	1.1.2.600.2.59
--- desire.tk	11 Dec 2006 16:33:05 -0000	1.1.2.600.2.60
***************
*** 1683,1687 ****
  		if {$l == 0 && $r == 1 && $t == 0 && $b == 1} {$self remove_scrollbars; return}
  	} else {
! 		if {$w > $w2 || $h > $h2} {$self init_scrollbars}
  	}
  }
--- 1683,1689 ----
  		if {$l == 0 && $r == 1 && $t == 0 && $b == 1} {$self remove_scrollbars; return}
  	} else {
! 		if {[$c bbox all] != ""} {
! 			if {$w > $w2 || $h > $h2} {$self init_scrollbars}
! 		}
  	}
  }
***************
*** 1832,1836 ****
  
  def Canvas new_object_callback {obj} {}
! def Canvas new_object_edit     {obj} {$obj edit}
  
  def Canvas insertxy {} {return [list $@insert_x $@insert_y]}
--- 1834,1841 ----
  
  def Canvas new_object_callback {obj} {}
! def Canvas new_object_edit     {obj} {
! 	if {[$obj class] == "NumBox"} {return}
! 	$obj edit
! }
  
  def Canvas insertxy {} {return [list $@insert_x $@insert_y]}
***************
*** 2150,2153 ****
--- 2155,2160 ----
  def TextBox update_size {} {
  	global font
+ 	if {[$self class] == "FloatBox"} {return};# floatbox's size is contant set by @w
+ 	if {[$self class] == "NumBox"} {return};# numbox's size is contant set by @w
  	if {[info exists @gop]} {if {$@gop} {set @xs $@pixwidth; set @ys $@pixheight; return}}
  	set l {};set nl 1
***************
*** 2263,2267 ****
  	set @text $text
  	set l {}
! 	foreach char [split $@text ""] {lappend l [scan $char %c]}
  	netsend [list .$@canvas text_setto $self $l] [list $@canvas new_object_callback]
  	$self changed
--- 2270,2274 ----
  	set @text $text
  	set l {}
! 	foreach char [split $@textn ""] {lappend l [scan $char %c]}
  	netsend [list .$@canvas text_setto $self $l] [list $@canvas new_object_callback]
  	$self changed
***************
*** 4798,4808 ****
  
  def ArrayPropertiesDialog init {of} {
- #    sprintf(cmdbuf, ((x->x_name->s_name[0] == '$') ?
- #        "pdtk_array_dialog %%s \\%s %d %d 0\n" :
- #        "pdtk_array_dialog %%s %s %d %d 0\n"),
- #            x->x_name->s_name, a->a_n, x->x_saveit + 
- #            2 * (int)(template_getfloat(template_findbyname(sc->sc_template),
- #            gensym("style"), x->x_scalar->sc_vec, 1)));
- 
  	super $of
  	foreach var {name n saveit} {set @$var $_($of:$var)}
--- 4805,4808 ----
***************
*** 4836,4844 ****
  	global font
  	super $mess
- 	set @clicking 0 ;#!@#$ get rid of this
  	set @val 0
  	set @old_val 0
  	set @clickpos {}
  	set @key_input 0
  }
  
--- 4836,4848 ----
  	global font
  	super $mess
  	set @val 0
  	set @old_val 0
  	set @clickpos {}
  	set @key_input 0
+ 	set padx [$self look fontpadx];set pady [$self look fontpady]
+ 	set width [font measure [$self look font] W]
+ 	set height [font metrics [$self look font] -linespace]
+ 	set @xs [expr $padx+$width*$@w]
+ 	set @ys [expr $pady+$height]
  }
  
***************
*** 4852,4856 ****
  }
  
! def FloatBox  apply_value {} {netsend [list .$self float  $@val]}
  def SymbolBox apply_value {} {netsend [list .$self symbol $@val]}
  
--- 4856,4860 ----
  }
  
! def AtomBox  apply_value {} {netsend [list .$self float  $@val]}
  def SymbolBox apply_value {} {netsend [list .$self symbol $@val]}
  
***************
*** 4886,4904 ****
  }
  
- def AtomBox update_size {} {
- 	global font
- 	if {!$@w} {set @w 5}
- 	set padx [$self look fontpadx];set pady [$self look fontpady]
- 	set width [font measure [$self look font] W]
- 	set height [font metrics [$self look font] -linespace]
- 	#set width [$self look fontwidth];set height [$self look fontheight]
- 	set textwidth [expr $padx+$width*$@w]
- 	set iowidth [$self look iowidth]
- 	set topwidth    [expr (2* $@ninlets-1) * $iowidth]
- 	set bottomwidth [expr (2*$@noutlets-1) * $iowidth]
- 	set @xs [max [$self look minobjwidth] [max $bottomwidth [max $topwidth $textwidth]]]
- 	set @ys [expr $pady+$height]
- }
- 
  def AtomBox click {x y f target} {
  	set @clickx $x; set @clicky $y
--- 4890,4893 ----
***************
*** 4910,4919 ****
  	$canvas focus= $self
  	set @rate [expr $f&1 ? 0.01 : 1.00]
- 	set @clicking 1
  }
  
  def AtomBox unclick {x y f target} {
! 	set @clicking 0
! 	if {$x == $@clickx && $y == $@clicky} {$self edit}
  }
  
--- 4899,4908 ----
  	$canvas focus= $self
  	set @rate [expr $f&1 ? 0.01 : 1.00]
  }
  
  def AtomBox unclick {x y f target} {
! 	set canvas [$self get_canvas]
! 	set c [$canvas widget]
! 	if {$x == $@clickx && $y == $@clicky} {$self edit} else {$canvas focus= ""}
  }
  
***************
*** 4921,4925 ****
  	if {!$@edit} {return}
  	set @edit 0
! 	set c [[$self get_canvas] widget]
  	set t $c.${self}text
  	set text [$t get 1.0 "end - 1 chars"]
--- 4910,4915 ----
  	if {!$@edit} {return}
  	set @edit 0
! 	set canvas [$self get_canvas]
! 	set c [$canvas widget]
  	set t $c.${self}text
  	set text [$t get 1.0 "end - 1 chars"]
***************
*** 4928,4936 ****
  	after 1 "destroy $t"
  	$self selected?= 0
  	focus $c
  }
  
! def FloatBox motion {x y f target} {
! 	if {!$@clicking || ![$self == [[$self get_canvas] focus]]} {return}
  	mset {ox oy} $@mouse
  	set @val [expr $@val-$@rate*($y-$oy)]
--- 4918,4926 ----
  	after 1 "destroy $t"
  	$self selected?= 0
+ 	$canvas focus= ""
  	focus $c
  }
  
! def AtomBox motion {x y f target} {
  	mset {ox oy} $@mouse
  	set @val [expr $@val-$@rate*($y-$oy)]
***************
*** 4939,4946 ****
  	set @mouse [list $x $y]
  	netsend [list .$self float $@val] ;# noserial
- 	$self changed
  }
  
! class_new NumBox {Labeled Box}
  def Box popup_properties {} {IEMPropertiesDialog new $self}
  
--- 4929,4936 ----
  	set @mouse [list $x $y]
  	netsend [list .$self float $@val] ;# noserial
  }
  
! #class_new NumBox {Labeled Box}
! class_new NumBox {Labeled AtomBox}
  def Box popup_properties {} {IEMPropertiesDialog new $self}
  
***************
*** 4954,4974 ****
  }
  
- def NumBox update_size {} {
- 	global font
- 	set padx [$self look fontpadx];set pady [$self look fontpady]
- 	set width [font measure [$self look font] W]
- 	set height [font metrics [$self look font] -linespace]
- 	#set width [$self look fontwidth];set height [$self look fontheight]
- 	set textwidth [expr $padx+$width*[string length $@buf]]
- 	set iowidth [$self look iowidth]
- 	set topwidth    [expr (2* $@ninlets-1) * $iowidth]
- 	set bottomwidth [expr (2*$@noutlets-1) * $iowidth]
- 	set @xs [max [$self look minobjwidth] [max $bottomwidth [max $topwidth $textwidth]]]
- 	set @ys  [expr $pady+$height]
- }
- 
  def NumBox draw {} {
- 	$self update_size
  	global font
  	mset {x1 y1} [$self xy]
  	set xs [expr 4+10*$@w]
--- 4944,4950 ----
  }
  
  def NumBox draw {} {
  	global font
+ 	super
  	mset {x1 y1} [$self xy]
  	set xs [expr 4+10*$@w]
***************
*** 4985,5001 ****
  	set focused [$self == [$@canvas focus]]
  	if {$focused} {set color4 #00ff00} {set color4 [$self look bg]}
- 	$self item BASE   polygon $points  -outline [$self look frame3] -fill [parse_color $@bcol]
  	$self item BASE4  polygon $points2 -outline [$self look frame3] -fill $color4
  	if {!$focused} {set @text $@val}
- 	$self item NUMBER text [list $xt $yt] -anchor w -text $@text \
- 	    -font [$self look font] -fill [parse_color $@fcol]
- 	$c delete ${self}CURS
- 	if {[string length $@buf]>0} {
- 		mset {blah blah x3 blah} [$c bbox ${self}NUMBER]
- 		$c create line $x3 $y1 $x3 $y2 -tags ${self}CURS -fill red
- 	}
- 	$self draw_io
- 	if {[$self selected?]} {set frcol [$self look selectframe]} {set frcol [$self look frame3]}
- 	$c itemconfigure ${self}BASE -outline $frcol
  }
  
--- 4961,4966 ----
***************
*** 5021,5107 ****
  }
  
- def NumBox click {x y f target} {
- 	$@canvas focus= $self
- 	[$@canvas widget] itemconfigure ${self}BASE4 -fill #00ff00
- 	set @clickpos [list $x $y]
- 	set @mouse [list $x $y]
- 	set @oval $@val
- 	set @clicking 1
- 	set @rate [expr $f&1 ? 0.01 : 1.00]
- }
- 
- def NumBox motion {x y f target} {
- 	if {!$@clicking || ![$self == [[$self get_canvas] focus]]} {return}
- 	mset {ox oy} $@mouse
- 	set @val [expr {$@val-$@rate*($y-$oy)}]
- 	set @old_val $@val
- 	set @text $@val
- 	set @mouse [list $x $y]
- 	netsend [list .$self float $@val]
- }
- 
  def NumBox unfocus {} {set @buf ""; $self changed}
  
- def NumBox unclick {x y f target} {
- 	set @clicking 0
- 	set c [$@canvas widget]
- 	#if {$@oval!=$@val} {
- 	#	$@canvas focus= ""
- 	#	$c itemconfigure ${self}BASE4 -fill [$self look bg]
- 	#	pd .$self float $@val
- 	#}
- 	if {[lindex $@clickpos 0] == $x && [lindex $@clickpos 1] == $y} {
- 		$@canvas focus= $self
- 		set @clicking 0
- 		set @val ""
- 		set @key_input 1
- 	} {
- 		$@canvas focus= ""
- 		$c itemconfigure ${self}BASE4 -fill [$self look bg]
- 		if {$@key_input} {set @val $@old_val; set @key_input 0; set @text $@val}
- 	}
- 	
- }
- 
- def NumBox key {key shift} {
- 	switch -regexp -- $key {
- 		^\[\\d]\$ {
- 			if {[string length $@val] < $@w} {
- 				#set @buf "$@buf$key"
- 				set @val "$@val$key"
- 				set @text $@val
- 				$self changed
- 			}
- 		}
- 	^Return\$ {
- 		#catch {set @val [expr $@buf]}
- 		$@canvas focus= ""
- 		set @old_val $@val
- 		pd .$self float $@val
- 		pd .$self bang
- 		set @buf ""
- 		set @text $@val
- 		set @key_input 0
- 		$self changed
- 	}
- 	^period\$ {if {[string length $@val] < $@w} {append @val ".";set @text $@val; $self changed} }
- 	^minus\$ {append @val "-";set @text $@val; $self changed}
- 	^BackSpace|Delete\$ {
- 		if {[string length $@buf] >= 0} {
- 			set @val [string range $@val 0 end-1]
- 			set @text $@val
- 		}
- 		$self changed
- 	}
- 	^Escape\$ {
- 		set @val $@oval
- 		$@canvas unfocus
- 	}
- 	default {
- 		puts "NumBox_key $key"
- 	}
- }
- }
- 
  class_new Radio {BlueBox}
  
--- 4986,4991 ----





More information about the Pd-cvs mailing list