pd/src u_main.tk,1.1.1.4.2.7.4.19,1.1.1.4.2.7.4.20 u_object.tk,1.1.2.10,1.1.2.11 - Pd-cvs

23 Mar 2004


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28436
Modified Files:
      Tag: impd_0_37
    u_main.tk u_object.tk 
Log Message:
bugfixes...
Index: u_object.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/u_object.tk,v
retrieving revision 1.1.2.10
retrieving revision 1.1.2.11
diff -C2 -d -r1.1.2.10 -r1.1.2.11
*** u_object.tk	19 Mar 2004 01:57:36 -0000	1.1.2.10
--- u_object.tk	23 Mar 2004 02:17:42 -0000	1.1.2.11
***************
*** 1,2 ****
--- 1,6 ----
+ # Copyright 2004 Mathieu Bouchard.
+ # For information on usage and redistribution, and for a DISCLAIMER OF ALL
+ # WARRANTIES, see the file, "LICENSE.txt," in this distribution.
+ 
  ############ colouring
***************
*** 33,37 ****
  # abstract classes
  set fields1 {foo bar x1 y1 class}
! set fields2 {snd rcv lab ldx ldy fstyle fs col0 col1 col2}
# real classes
--- 37,41 ----
  # abstract classes
  set fields1 {foo bar x1 y1 class}
! set fields2 {snd rcv lab ldx ldy fstyle fs bcol fcol lcol}
# real classes
***************
*** 45,49 ****
  set fields(hdl)    $fields(hradio)
  set fields(vdl)    $fields(hradio)
! set fields(vu)     [eval list $fields1 w h rcv lab ldx ldy fstyle fs col0 col2 scale isa]
proc update_object {x d} {
--- 49,53 ----
  set fields(hdl)    $fields(hradio)
  set fields(vdl)    $fields(hradio)
! set fields(vu)     [eval list $fields1 w h rcv lab ldx ldy fstyle fs bcol lcol scale isa]
proc update_object {x d} {
***************
*** 51,55 ****
    global fields
    set class [lindex $d 4]
! 	#puts "CLASS=$class"
    #if {[llength $fields] != [llength $d]} {huh}
    set i 0
--- 55,59 ----
    global fields
    set class [lindex $d 4]
! 	#puts "${class} $x = $d"
    #if {[llength $fields] != [llength $d]} {huh}
    set i 0
***************
*** 245,252 ****
    set outs [expr [string compare $_($tag:snd) empty]==0]
    set points [list $x1 $y1 [expr $x2-4] $y1 $x2 [expr $y1+4] $x2 $y2 $x1 $y2]
! 	if {[llength [$canvas gettags ${tag}BASE]] != 0} {
! 		$canvas coords ${tag}BASE $points
    } {
! 		$canvas create polygon $points -tag ${tag}BASE -fill $look(objectbg) -outline $look(objectframe3)
    }
    io_draw $canvas $tag $x1 $y1 $xs $ys $ins $outs
--- 249,279 ----
    set outs [expr [string compare $_($tag:snd) empty]==0]
    set points [list $x1 $y1 [expr $x2-4] $y1 $x2 [expr $y1+4] $x2 $y2 $x1 $y2]
! 	set isnew [expr [llength [$canvas gettags ${tag}BASE]] == 0]
! 	set half [expr $ys/2]
! 	set d [expr 1+$xs/34]
! 	set font courier
! 	set xt [expr $x1+$half+2]
! 	set yt [expr $y1+$half+$d]
! 	#set color [format #%6.6x [expr $_($tag:fcol) & 0xffffff]]
! 	set color "#000000"
! 	#puts "numbox.color = $color"
! 	set points2 [list $x1 $y1 [expr $x1+$half] [expr $y1+$half] $x1 $y2]
! 	if {$isnew} {
! 		$canvas create polygon $points -tag ${tag}BASE \
! 			-fill $look(objectbg) -outline $look(objectframe3)
! 		$canvas create polygon $points2 -tag ${tag}BASE4 \
! 			-fill $look(objectbg) -outline $look(objectframe3)
! 		$canvas create text $xt $yt \
! 			-text [numbox_ftoa $tag] -anchor w \
! 			-font [list $font $_($tag:fs) bold] \
! 			-fill $color -tags ${tag}NUMBER
    } {
! 		$canvas coords ${tag}BASE $points
! 		$canvas coords ${tag}BASE4 $points2
! 		$canvas coords ${tag}NUMBER $xt $yt
! 		$canvas itemconfigure ${tag}NUMBER \
! 			-text [numbox_ftoa $tag] \
! 			-font [list $font $_($tag:fs) bold] \
! 			-fill $color
    }
    io_draw $canvas $tag $x1 $y1 $xs $ys $ins $outs
***************
*** 254,266 ****
  }
! proc numbox_select {canvas tag flag} {
    global look
! 	if {$flag} {set colour $look(objectframe4)} {set colour $look(objectframe3)}
    $canvas itemconfigure $tag -outline $colour
    label_select $tag $canvas
  }
proc numbox_erase {canvas tag} {
! 	$canvas delete $tag
    io_erase $canvas $tag
    label_erase $tag $canvas
--- 281,332 ----
  }
! proc numbox_select {tag canvas flag} {
    global look
! 	puts "numbox_select $tag $canvas $flag"
! 	if {$flag==1} {set colour $look(objectframe4)} {set colour $look(objectframe3)}
    $canvas itemconfigure $tag -outline $colour
+ 	if {$flag==2} {set colour #00ff00} {set colour $look(objectbg)}
+ 	$canvas itemconfigure ${tag}BASE4 -fill $colour
    label_select $tag $canvas
  }
+ proc numbox_ftoa {tag} {
+ 	global _
+ 	set f $_($tag:val)
+ 	set is_exp 0
+ 
+ 	set buf [format %g $f]
+ 	set bufsize [string length buf]
+ 	if {$bufsize >= 5} {
+ 		# exponential mode
+ 		set is_exp [regexp -nocase e]
+ 	}
+ 	if {$bufsize > $_($tag:w)} {
+ 		# must shrink number
+ 		if {$is_exp} {
+ 			#if(x->x_gui.x_w <= 5) {x->x_buf[0] = (f < 0.0 ? '-' : '+'); x->x_buf[1] = 0;}
+ 			#i = bufsize - 4;
+ 			#for(idecimal=0; idecimal < i; idecimal++) if(x->x_buf[idecimal] == '.') break;
+ 			#if(idecimal > (x->x_gui.x_w - 4)) {
+ 			#	x->x_buf[0]=f<0.0?'-':'+';x->x_buf[1] = 0;
+ 			#} {
+ 			#	int new_exp_index=x->x_gui.x_w-4, old_exp_index=bufsize-4;
+ 			#	for(i=0; i < 4; i++, new_exp_index++, old_exp_index++)
+ 			#       x->x_buf[new_exp_index] = x->x_buf[old_exp_index];
+ 			#       x->x_buf[x->x_gui.x_w] = 0;
+ 			#}
+ 		} {
+ 			#for(idecimal=0; idecimal < bufsize; idecimal++)
+ 			#if(x->x_buf[idecimal] == '.') break;
+ 			#if(idecimal > x->x_gui.x_w) {x->x_buf[0] = (f < 0.0 ? '-' : '+');
+ 			#	x->x_buf[1] = 0;
+ 			#} {x->x_buf[x->x_gui.x_w] = 0;}
+ 		}
+ 	}
+ 	return $buf
+ }
+ 
  proc numbox_erase {canvas tag} {
! 	$canvas delete $tag ${tag}NUMBER ${tag}BASE4
    io_erase $canvas $tag
    label_erase $tag $canvas
***************
*** 281,286 ****
    set xyc [list [expr $x2-1] [expr $y1+1] [expr $x2-1] [expr $y2-1] [expr $x1+1] [expr $y2-1]]
    set isnew [expr [llength [$canvas gettags ${tag}BASE]] == 0]
! 	#puts "bluebox: [parse_color $_($tag:col0)] [parse_color $_($tag:col1)] [parse_color $_($tag:col2)]"
! 	set color [bluify [parse_color $_($tag:col0)]]
    if {$isnew} {
    	$canvas create rectangle $xya -tag ${tag}BASE -fill $color
--- 347,352 ----
    set xyc [list [expr $x2-1] [expr $y1+1] [expr $x2-1] [expr $y2-1] [expr $x1+1] [expr $y2-1]]
    set isnew [expr [llength [$canvas gettags ${tag}BASE]] == 0]
! 	#puts "bluebox: [parse_color $_($tag:bcol)] [parse_color $_($tag:fcol)] [parse_color $_($tag:lcol)]"
! 	set color [bluify [parse_color $_($tag:bcol)]]
    if {$isnew} {
    	$canvas create rectangle $xya -tag ${tag}BASE -fill $color
***************
*** 328,332 ****
    set ins  [expr [string compare $_($tag:snd) empty]==0]
    set outs [expr [string compare $_($tag:snd) empty]==0]
! 	set colour [parse_color $_($tag:col0)]
    bluebox_draw $canvas ${tag} $x1 $y1 $xs $ys $ins $outs $colour
    if {$orient} {set size $ys} {set size $xs}
--- 394,398 ----
    set ins  [expr [string compare $_($tag:snd) empty]==0]
    set outs [expr [string compare $_($tag:snd) empty]==0]
! 	set colour [parse_color $_($tag:bcol)]
    bluebox_draw $canvas ${tag} $x1 $y1 $xs $ys $ins $outs $colour
    if {$orient} {set size $ys} {set size $xs}
***************
*** 368,372 ****
    set outs [expr [string compare $_($tag:snd) empty]==0]
    switch $_($tag:class) {hsl {set orient 0} vsl {set orient 1}}
! 	set colour [parse_color $_($tag:col0)]
    bluebox_draw $canvas $tag $x1 $y1 $xs $ys $ins $outs $colour
    if {$isnew} {
--- 434,438 ----
    set outs [expr [string compare $_($tag:snd) empty]==0]
    switch $_($tag:class) {hsl {set orient 0} vsl {set orient 1}}
! 	set colour [parse_color $_($tag:bcol)]
    bluebox_draw $canvas $tag $x1 $y1 $xs $ys $ins $outs $colour
    if {$isnew} {
***************
*** 416,424 ****
    set lx [expr $x1+$_($tag:ldx)]
    set ly [expr $y1+$_($tag:ldy)]
! 	set label $_($tag:lab); switch $label { empty { set label "" }}
    set lfont [list \
    	[lindex	{courier helvetica times} $_($tag:fstyle)] \
    	$_($tag:fs) bold]
! 	set lcolor [parse_color $_($tag:col2)]
    if {$isnew} {
    	$canvas create text $lx $ly -text $label -anchor w \
--- 482,490 ----
    set lx [expr $x1+$_($tag:ldx)]
    set ly [expr $y1+$_($tag:ldy)]
! 	set label $_($tag:lab); switch -- $label { empty { set label "" }}
    set lfont [list \
    	[lindex	{courier helvetica times} $_($tag:fstyle)] \
    	$_($tag:fs) bold]
! 	set lcolor [parse_color $_($tag:lcol)]
    if {$isnew} {
    	$canvas create text $lx $ly -text $label -anchor w \
***************
*** 445,449 ****
    set ins  [expr [string compare $_($tag:snd) empty]==0]
    set outs [expr [string compare $_($tag:snd) empty]==0]
! 	set colour [parse_color $_($tag:col0)]
    bluebox_draw $canvas $tag $x1 $y1 $xs $ys $ins $outs $colour
    io_draw $canvas $tag $x1 $y1 $xs $ys $ins $outs
--- 511,515 ----
    set ins  [expr [string compare $_($tag:snd) empty]==0]
    set outs [expr [string compare $_($tag:snd) empty]==0]
! 	set colour [parse_color $_($tag:bcol)]
    bluebox_draw $canvas $tag $x1 $y1 $xs $ys $ins $outs $colour
    io_draw $canvas $tag $x1 $y1 $xs $ys $ins $outs
***************
*** 480,484 ****
    set outs [expr [string compare $_($tag:snd) empty]==0]
    set isnew [expr [llength [$canvas gettags ${tag}BASE]] == 0]
! 	set colour [parse_color $_($tag:col0)]
    bluebox_draw $canvas ${tag} $x1 $y1 $xs $ys $ins $outs $colour
    io_draw $canvas $tag $x1 $y1 $xs $ys $ins $outs
--- 546,550 ----
    set outs [expr [string compare $_($tag:snd) empty]==0]
    set isnew [expr [llength [$canvas gettags ${tag}BASE]] == 0]
! 	set colour [parse_color $_($tag:bcol)]
    bluebox_draw $canvas ${tag} $x1 $y1 $xs $ys $ins $outs $colour
    io_draw $canvas $tag $x1 $y1 $xs $ys $ins $outs
***************
*** 529,533 ****
    set outs [expr [string compare $_($tag:snd) empty]==0]
    set isnew [expr [llength [$canvas gettags ${tag}BASE]] == 0]
! 	set colour [parse_color $_($tag:col0)]
    bluebox_draw $tag $canvas ${tag} $x1 $y1 $xs $ys $ins $outs $colour
  }
--- 595,599 ----
    set outs [expr [string compare $_($tag:snd) empty]==0]
    set isnew [expr [llength [$canvas gettags ${tag}BASE]] == 0]
! 	set colour [parse_color $_($tag:bcol)]
    bluebox_draw $tag $canvas ${tag} $x1 $y1 $xs $ys $ins $outs $colour
  }
Index: u_main.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/u_main.tk,v
retrieving revision 1.1.1.4.2.7.4.19
retrieving revision 1.1.1.4.2.7.4.20
diff -C2 -d -r1.1.1.4.2.7.4.19 -r1.1.1.4.2.7.4.20
*** u_main.tk	19 Mar 2004 20:47:11 -0000	1.1.1.4.2.7.4.19
--- u_main.tk	23 Mar 2004 02:17:42 -0000	1.1.1.4.2.7.4.20
***************
*** 4,22 ****
# Copyright (c) 1997-1999 Miller Puckette.
  # For information on usage and redistribution, and for a DISCLAIMER OF ALL
  # WARRANTIES, see the file, "LICENSE.txt," in this distribution.
- # changed by Thomas Musil 09.2001
- # between "pdtk_graph_dialog -- dialog window for graphs"
- # and "pdtk_array_dialog -- dialog window for arrays"
- # a new dialogbox was inserted, named:
- # "pdtk_iemgui_dialog -- dialog window for iem guis"
- #
- # all this changes are labeled with #######iemlib##########
- 
  #option add *background pink widgetDefault
  #option add *backgroundPixmap /usr/share/themes/BrushedMetalBlue/gtk/brushed-dark.xpm widgetDefault
  #option add *backgroundPixmap /home/matju/brushed-dark.gif widgetDefault
  option add *Button*borderWidth 1
# there are two palettes of 30 colours used in Pd
--- 4,19 ----
# Copyright (c) 1997-1999 Miller Puckette.
+ # Copyright 2004 Mathieu Bouchard.
  # For information on usage and redistribution, and for a DISCLAIMER OF ALL
  # WARRANTIES, see the file, "LICENSE.txt," in this distribution.
#option add *background pink widgetDefault
  #option add *backgroundPixmap /usr/share/themes/BrushedMetalBlue/gtk/brushed-dark.xpm widgetDefault
  #option add *backgroundPixmap /home/matju/brushed-dark.gif widgetDefault
  option add *Button*borderWidth 1
+ option add *Checkbutton*borderWidth 1
+ option add *Radiobutton*borderWidth 1
+ option add *Checkbutton*selectColor #dd3000
+ option add *Radiobutton*selectColor #dd3000
# there are two palettes of 30 colours used in Pd
***************
*** 98,108 ****
frame .controls.switches
! checkbutton .controls.switches.audiobutton -text {compute audio} \
      -variable ctrls_audio_on -anchor w \
!     -command {pd "pd dsp $ctrls_audio_on ;"]}
! checkbutton .controls.switches.meterbutton -text {peak meters} \
      -variable ctrls_meter_on -anchor w \
!     -command {pd "pd meters $ctrls_meter_on ;"]}
pack .controls.switches.meterbutton .controls.switches.audiobutton -side top
--- 95,105 ----
frame .controls.switches
! checkbutton .controls.switches.audiobutton -text "Compute Audio" \
      -variable ctrls_audio_on -anchor w \
!     -command {pd "pd dsp $ctrls_audio_on ;"}
! checkbutton .controls.switches.meterbutton -text "Peak Meters" \
      -variable ctrls_meter_on -anchor w \
!     -command {pd "pd meters $ctrls_meter_on ;"}
pack .controls.switches.meterbutton .controls.switches.audiobutton -side top
***************
*** 118,122 ****
  }
! button .controls.dio -text "DIO\nerrors" -command {pd "pd audiostatus ;"]}
#pack .controls.switches -side bottom -pady 12
--- 115,119 ----
  }
! button .controls.dio -text "DIO\nerrors" -command {pd "pd audiostatus ;"}
#pack .controls.switches -side bottom -pady 12
***************
*** 159,163 ****
  proc pdtk_check {x message} {
      set answer [tk_messageBox -message $x -type yesno -icon question]
!     switch $answer {
      	yes {pd $message} }
  #    	no {tk_messageBox -message "cancelled" -type ok}
--- 156,160 ----
  proc pdtk_check {x message} {
      set answer [tk_messageBox -message $x -type yesno -icon question]
!     switch -- $answer {
      	yes {pd $message} }
  #    	no {tk_messageBox -message "cancelled" -type ok}
***************
*** 321,325 ****
    global accels
    foreach e $list {
! 	    switch [llength $e] {
            0 {
    	    $menu add separator
--- 318,322 ----
    global accels
    foreach e $list {
! 	    switch -- [llength $e] {
            0 {
    	    $menu add separator
***************
*** 951,955 ****
      global _
      foreach {name label type options} $struct {
!         switch $type {
        entry {
    	frame .$self.$name
--- 948,952 ----
      global _
      foreach {name label type options} $struct {
!         switch -- $type {
        entry {
    	frame .$self.$name
***************
*** 1288,1294 ****
      set _($self:num) $num
      set _($self:steady) $steady
!     switch $snd { empty {set snd ""}}
!     switch $rcv { empty {set rcv ""}}
!     switch $gui_name { empty {set gui_name ""}}
      set _($self:snd) $snd
      set _($self:rcv) $rcv
--- 1285,1291 ----
      set _($self:num) $num
      set _($self:steady) $steady
!     switch -- $snd { empty {set snd ""}}
!     switch -- $rcv { empty {set rcv ""}}
!     switch -- $gui_name { empty {set gui_name ""}}
      set _($self:snd) $snd
      set _($self:rcv) $rcv