pd/src desire.tk,1.1.2.253,1.1.2.254 - Pd-cvs

20 Jun 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31401
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
commited some codes for floatatom
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.253
retrieving revision 1.1.2.254
diff -C2 -d -r1.1.2.253 -r1.1.2.254
*** desire.tk	20 Jun 2006 04:07:31 -0000	1.1.2.253
--- desire.tk	20 Jun 2006 19:46:15 -0000	1.1.2.254
***************
*** 1425,1428 ****
--- 1425,1429 ----
      # confusing?;)
      # puts "metrics: [font metrics courier]"
+     #$self update_size
      global font look
      mset {x1 y1} [$self xy]
***************
*** 1528,1532 ****
  }
! def TextBox update_size {} {
    global font look
    set @textwidth [expr $font(padx)+$font(width)*([string length $@text]+$@edit)]
--- 1529,1533 ----
  }
! def* TextBox update_size {} {
    global font look
    set @textwidth [expr $font(padx)+$font(width)*([string length $@text]+$@edit)]
***************
*** 2307,2311 ****
def* Canvas unclickrun {x y b} {
! 	#if {[focus] != $self} {[$self focus] unclick $x $y $b}
  }
--- 2308,2312 ----
def* Canvas unclickrun {x y b} {
! 	if {[$self focus] != $self} {[$self focus] unclick $x $y $b}
  }
***************
*** 2688,2692 ****
  set fields(msg) {foo bar x1 y1}
  set fields(coords) {foo bar xfrom yfrom xto yto w h gop x1 y1}
!
#             @pdclass {@_class}
--- 2689,2693 ----
  set fields(msg) {foo bar x1 y1}
  set fields(coords) {foo bar xfrom yfrom xto yto w h gop x1 y1}
! set fields(floatatom) {foo bar x1 y1 w min max pos lab snd rcv}
#             @pdclass {@_class}
***************
*** 2706,2709 ****
--- 2707,2711 ----
  set classinfo(canvas)  {Canvas}
  set classinfo(cnv)     {Cnv}
+ set classinfo(floatatom)     {FloatAtom}
#
***************
*** 2937,2952 ****
  }
! class_new AtomBox {View}
! def AtomBox draw {} {
    global look
    mset {x1 y1} [$self xy]
! 	set x2 [expr $x1+$xs]
! 	set y2 [expr $y1+$ys]
    set points [list $x1 $y1 [expr $x2-4] $y1 $x2 [expr $y1+4] $x2 $y2 $x1 $y2]
! 	$@canvas canvasx $x1
! 	$self item BASE polygon $points -tag -fill $look(objectbg) -outline $look(objectframe3)
    io_draw $self
    if {[$self selected?]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
! 	$@canvas itemconfigure ${self}BASE -outline $frcol
  }
--- 2939,2955 ----
  }
! class_new AtomBox {View Box}
! def* AtomBox draw {} {
    global look
+ 	$self update_size
    mset {x1 y1} [$self xy]
! 	set x2 [expr $x1+$@xs]
! 	set y2 [expr $y1+$@ys]
    set points [list $x1 $y1 [expr $x2-4] $y1 $x2 [expr $y1+4] $x2 $y2 $x1 $y2]
! 	.$@canvas.c canvasx $x1
! 	$self item BASE polygon $points -fill $look(objectbg) -outline $look(objectframe3)
    io_draw $self
    if {[$self selected?]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
! 	.$@canvas.c itemconfigure ${self}BASE -outline $frcol
  }
***************
*** 3259,3262 ****
--- 3262,3355 ----
  }
+ class_new FloatAtom {AtomBox}
+ def* FloatAtom init {args} {
+ 	global font look
+ 	eval [concat [list super] $args]
+ 	set @clicking 0
+ 	set @buf 0
+ 	set @valid 0
+ 	set @text 0
+ 	set @edit 0
+ 	set @isnew 1
+ 	
+ }
+ 
+ 
+ def* FloatAtom draw {} {
+ 	global font look
+ 	super
+ 	mset {x1 y1} [$self xy]
+ 	set xs [expr 4+10*$@w]
+ 	set ys $font(height)
+ 	set xt [expr $x1+$ys/2+2]
+ 	set yt [expr $y1+$ys/2+1+$xs/34]
+ 	$self item TEXT text [list $xt $yt] -anchor w -text $@buf \
+ 		-font $font(str) -fill #000000
+ 	set t .$@canvas.c.${self}TEXT
+ 	if {$@isnew} {
+ 	bind $t <Key> "$self key %W %x %y %K %A 0"
+ 	set @isnew 0
+ 	#focus .$@canvas.c.${self}TEXT
+ 	}
+ 	
+ }
+ 
+ def* FloatAtom key {x y key iso shift} {
+ 
+ }
+ 
+ def* FloatAtom ftoa {} {
+ 	set f $@val
+ 	set is_exp 0
+ 	if {[string length $@buf]>0} {return $@buf}
+ 	set buf [format %g $f]
+ 	set bufsize [string length buf]
+ 	if {$bufsize >= 5} {
+ 		# exponential mode
+ 		set is_exp [regexp -nocase e]
+ 	}
+ 	if {$bufsize > $@w} {
+ 		# must shrink number
+ 		if {$is_exp} {
+ 			#...
+ 		} {
+ 			#...
+ 		}
+ 	}
+ 	return $buf
+ }
+ 
+ def FloatAtom update_size {} {
+ 	global font look
+ 	set @textwidth [expr $font(padx)+$font(width)*[string length $@buf]]
+ 	set @topwidth [expr ($@ninlets + ($@ninlets - 1)) * $look(iowidth)]
+ 	set @bottomwidth [expr ($@noutlets + ($@noutlets - 1)) * $look(iowidth)]
+ 	set @xs [max $look(minobjwidth) [max $@bottomwidth [max $@topwidth $@textwidth]]]
+ 	
+ 	set @ys  [expr $font(pady)+$font(height)]
+ }
+ 
+ def* FloatAtom click {args} {
+ 	#$self edit
+ 	set t .$@canvas.c.${self}text
+ 	puts ".$@canvas.c itemconfigure $t -state disabled"
+ 	.$@canvas.c itemconfigure $t -state disabled
+ 	$@canvas focus= $self
+ 	.$@canvas.c itemconfigure ${self}BASE4 -fill #00ff00
+ 	#set @mouse [list $x $y]
+ 	#set @oval $@val
+ 	#set @clicking 1
+ 	#set @rate [expr $f&1 ? 0.01 : 1.00]
+ }
+ 
+ def* FloatAtom unclick {args} {
+ 	global look
+ 	set @clicking 0
+ 	$@canvas focus= $@canvas
+ 	.$@canvas.c itemconfigure ${self}BASE4 -fill $look(objectbg)
+ }
+ 
+ def* FloatAtom motion {args} {}
+ 
  class_new NumBox {Labeled Box}
  def* NumBox init {args} {
***************
*** 3267,3270 ****
--- 3360,3372 ----
  }
+ def* NumBox update_size {} {
+ 	global font look
+ 	set @textwidth [expr $font(padx)+$font(width)*[string length $@buf]]
+ 	set @topwidth [expr ($@ninlets + ($@ninlets - 1)) * $look(iowidth)]
+ 	set @bottomwidth [expr ($@noutlets + ($@noutlets - 1)) * $look(iowidth)]
+ 	set @xs [max $look(minobjwidth) [max $@bottomwidth [max $@topwidth $@textwidth]]]
+ 	set @ys  [expr $font(pady)+$font(height)]
+ }
+ 
  def* NumBox draw {} {
    $self update_size
***************
*** 3301,3313 ****
  }
- def* NumBox update_size {} {
- 	global font look
- 	set @textwidth [expr $font(padx)+$font(width)*[string length $@buf]]
- 	set @topwidth [expr ($@ninlets + ($@ninlets - 1)) * $look(iowidth)]
- 	set @bottomwidth [expr ($@noutlets + ($@noutlets - 1)) * $look(iowidth)]
- 	set @xs [max $look(minobjwidth) [max $@bottomwidth [max $@topwidth $@textwidth]]]
- 	
- 	set @ys  [expr $font(pady)+$font(height)]
- }
--- 3403,3406 ----