[PD-cvs] pd/src desire.tk,1.1.2.51,1.1.2.52

Mathieu Bouchard matju at users.sourceforge.net
Wed Sep 14 06:39:43 CEST 2005


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

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
added proc super.
removed most def $foo erase
added class view (not to confuse with class vu)


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.51
retrieving revision 1.1.2.52
diff -C2 -d -r1.1.2.51 -r1.1.2.52
*** desire.tk	14 Sep 2005 01:10:36 -0000	1.1.2.51
--- desire.tk	14 Sep 2005 04:39:41 -0000	1.1.2.52
***************
*** 61,65 ****
  	lookup_method $_($self:_class) $selector candidates
  	puts "!!! candidates: $candidates"
! 	set name [lindex $candidates 0]
  	puts "proc name of $self $selector is $name"
  	set r [uplevel 1 [concat [list $name $self] [lrange $args 2 end]]]
--- 61,66 ----
  	lookup_method $_($self:_class) $selector candidates
  	puts "!!! candidates: $candidates"
! 	set i 0
! 	set name [lindex $candidates $i]
  	puts "proc name of $self $selector is $name"
  	set r [uplevel 1 [concat [list $name $self] [lrange $args 2 end]]]
***************
*** 68,71 ****
--- 69,81 ----
  }
  
+ proc super {args} {
+ 	upvar 2 candidates candidates self self
+ 	set i [expr 1+[uplevel 2 {list $i}]]
+ 	puts "!!! super #$i"
+ 	set name [lindex $candidates $i]
+ 	puts "proc name of $self $selector is $name"
+ 	set r [uplevel 1 [concat [list $name $self] $args]]
+ }
+ 
  class_new thing
  set _(thing:_super) {}
***************
*** 721,725 ****
  
  #-----------------------------------------------------------------------------------#
! 
  set font(size) 12
  set font(width) 0
--- 731,735 ----
  
  #-----------------------------------------------------------------------------------#
! # why didn't you use the font metrics function? --matju
  set font(size) 12
  set font(width) 0
***************
*** 746,761 ****
  set look(wirefg) #888888
  set look(wirefg2) #ee0000
- #set look(sliderbg) #bbe4ff
  set look(sliderbg) #ccebff
! #set look(sliderbg) #ddf2ff
  set look(inletfg) #ff0000
  set look(outletfg) #ff0000
! 
! # Tearoff is set to true by default:
! set pd_tearoff 1
  
  set current_x 0
  set current_y 0
- 
  set tooltip(mx) -1000
  set tooltip(my) -1000
--- 756,769 ----
  set look(wirefg) #888888
  set look(wirefg2) #ee0000
  set look(sliderbg) #ccebff
! #set look(sliderbg) #ffeedd
  set look(inletfg) #ff0000
  set look(outletfg) #ff0000
! set look(extrapix) [switch $OS {
!         osx     { set look(extrapix) 2 }
!         default { set look(extrapix) 1 }}]
  
  set current_x 0
  set current_y 0
  set tooltip(mx) -1000
  set tooltip(my) -1000
***************
*** 763,767 ****
  set tooltip(visible) 0
  set tooltip(text) ""
- 
  set dehighlight {}
  set wire_from {}
--- 771,774 ----
***************
*** 778,785 ****
  #-----------------------------------------------------------------------------------#
  
! proc menu_close {name} {pd "$name menuclose 0 ;"}
  proc menu_save   {name} {canvas_checkgeometry $name; pd "$name menusave ;"}
  proc menu_saveas {name} {canvas_checkgeometry $name; pd "$name menusaveas ;"}
! proc menu_print {name} {
      set filename [tk_getSaveFile -initialfile pd.ps -defaultextension .ps \
         -filetypes { {{postscript} {.ps}} }]
--- 785,792 ----
  #-----------------------------------------------------------------------------------#
  
! proc menu_close  {name} {pd "$name menuclose 0 ;"}
  proc menu_save   {name} {canvas_checkgeometry $name; pd "$name menusave ;"}
  proc menu_saveas {name} {canvas_checkgeometry $name; pd "$name menusaveas ;"}
! proc menu_print  {name} {
      set filename [tk_getSaveFile -initialfile pd.ps -defaultextension .ps \
         -filetypes { {{postscript} {.ps}} }]
***************
*** 930,946 ****
  	global _
  	regsub "\\.x" $name "" self
- 	puts "NEW CANVAS $self"
  	set _($self:_class) canvas
  	$self init $width $height $geometry $editable
  }
  class_new canvas
  def canvas init {width height geometry editable} {
-     set name .$self
-     #puts "canvas_new::: $name $width $height $geometry $editable"
      global pd_opendir pd_tearoff OS cmdline canvasmenu _
!     # my code begins --chun
      set _(focus) $name.c
-     # my code ends
-     
      toplevel $name -menu $name.m
      wm geometry $name $geometry
--- 937,950 ----
  	global _
  	regsub "\\.x" $name "" self
  	set _($self:_class) canvas
  	$self init $width $height $geometry $editable
  }
+ 
  class_new canvas
  def canvas init {width height geometry editable} {
      global pd_opendir pd_tearoff OS cmdline canvasmenu _
!     set name .$self
!     # focus should be set to either always a _ object or always a tk object. else we'll run into trouble. what do we do here? --matju
      set _(focus) $name.c
      toplevel $name -menu $name.m
      wm geometry $name $geometry
***************
*** 966,972 ****
      menu $name.popup -tearoff false
      populate_menu $name.popup $name {
! 	{"Properties" {popup_action %W 0} ""}
! 	{"Open"       {popup_action %W 1} ""}
! 	{"Help"       {popup_action %W 2} ""}
      }
  
--- 970,976 ----
      menu $name.popup -tearoff false
      populate_menu $name.popup $name {
! 	{"Properties" {popup_properties [canvastosym %W]} ""}
! 	{"Open"       {popup_open       [canvastosym %W]} ""}
! 	{"Help"       {popup_help       [canvastosym %W]} ""}
      }
  
***************
*** 981,985 ****
      bind $c <Alt-Control-Button>       {canvas_click %W %x %y %b 6}
      bind $c <Alt-Control-Shift-Button> {canvas_click %W %x %y %b 7}
-     global OS
      switch $OS {
        osx {
--- 985,988 ----
***************
*** 992,1004 ****
        }
      }
!     # change mac to right-click, not middle click -atl 2002.09.02
!     bind $c <ButtonRelease> {canvas_mouseup %W %x %y %b}
      bind $c <Control-Key>       {canvas_ctrlkey %W %K 0}
      bind $c <Control-Shift-Key> {canvas_ctrlkey %W %K 1}
!     bind $c <Alt-Key>           {canvas_altkey %W %K %A}
      switch $OS {
        unix {
! 	bind $c <Mod1-Key>          {canvas_altkey %W %K %A}
! 	bind $c <Mod4-Key>          {canvas_altkey %W %K %A}
        }
        osx {
--- 995,1006 ----
        }
      }
!     bind $c <ButtonRelease>     {canvas_mouseup %W %x %y %b}
      bind $c <Control-Key>       {canvas_ctrlkey %W %K 0}
      bind $c <Control-Shift-Key> {canvas_ctrlkey %W %K 1}
!     bind $c <Alt-Key>            {canvas_altkey %W %K %A}
      switch $OS {
        unix {
! 	bind $c <Mod1-Key>      {canvas_altkey %W %K %A}
! 	bind $c <Mod4-Key>      {canvas_altkey %W %K %A}
        }
        osx {
***************
*** 1017,1032 ****
      pdtk_canvas_editval $name $editable
      bind $c <Motion> "+statusbar_update $name %x %y"
- 
-     global OS
      switch $OS { unix {
! 	bind $c <Button-4>  "pdtk_canvas_scroll $name.c y -1"
!     	bind $c <Button-5>  "pdtk_canvas_scroll $name.c y +1"
! 	bind $c <Shift-Button-4>  "pdtk_canvas_scroll $name.c x -1"
!     	bind $c <Shift-Button-5>  "pdtk_canvas_scroll $name.c x +1"
      } default {
  	bind $c  <MouseWheel> \
! 	    "pdtk_canvas_scroll $name.c y \[expr -abs(%D)/%D\]"
  	bind $c  <Shift-MouseWheel> \
! 	    "pdtk_canvas_scroll $name.c x \[expr -abs(%D)/%D\]"
      }}
      #catch {image create photo mybackground -file "test2.gif"}
--- 1019,1032 ----
      pdtk_canvas_editval $name $editable
      bind $c <Motion> "+statusbar_update $name %x %y"
      switch $OS { unix {
! 	bind $c <Button-4>       "canvas_scroll $name.c y -1"
!     	bind $c <Button-5>       "canvas_scroll $name.c y +1"
! 	bind $c <Shift-Button-4> "canvas_scroll $name.c x -1"
!     	bind $c <Shift-Button-5> "canvas_scroll $name.c x +1"
      } default {
  	bind $c  <MouseWheel> \
! 	    "canvas_scroll $name.c y \[expr -abs(%D)/%D\]"
  	bind $c  <Shift-MouseWheel> \
! 	    "canvas_scroll $name.c x \[expr -abs(%D)/%D\]"
      }}
      #catch {image create photo mybackground -file "test2.gif"}
***************
*** 1278,1285 ****
  
  #-----------------------------------------------------------------------------------#
- switch $OS {
-         osx { set look(extrapix) 2 }
-         default { set look(extrapix) 1 }
- }
  
  #-----------------------------------------------------------------------------------#
--- 1278,1281 ----
***************
*** 1328,1331 ****
--- 1324,1329 ----
  #-----------------------------------------------------------------------------------#
  # create a new text object
+ class_new text {thing}
+ 
  proc text_new {canvas self x y text font color} {
      $canvas create text $x $y \
***************
*** 1335,1339 ****
  }
  
- #-----------------------------------------------------------------------------------#
  # change the text
  proc pdtk_text_set {canvas myname text} {text_set $canvas $myname $text}
--- 1333,1336 ----
***************
*** 1377,1385 ****
  }
  
- #-----------------------------------------------------------------------------------#
  def text key {canvas widget x y key iso shift} {
  	global font
  	set @text [$widget get 1.0 1.end]
- #	regexp {(\.x[0-9a-fA-F]+\.c)\.([0-9a-fA-F]+)text(.*)} $widget full canvas self
  	$widget configure -width [expr [llength $@text]+1]
  	$self update_size
--- 1374,1380 ----
***************
*** 1437,1441 ****
          $canvas delete ${self}text
  	$self erase $canvas 
! 	$self pdate_size
  	$self draw $canvas
  	for {set x 0} {$x<$@inlets} {incr x} {
--- 1432,1436 ----
          $canvas delete ${self}text
  	$self erase $canvas 
! 	$self update_size
  	$self draw $canvas
  	for {set x 0} {$x<$@inlets} {incr x} {
***************
*** 1770,1782 ****
      set mouse(b1down) 1
      foreach {type id} [identify_target $canvas $cx $cy $b $f "click"] {}
-     #puts "click on => $type:$id"
-     
      switch $type {
        object {
          set run [expr !$edit || ($f&2)]
- 	#pd "$self click-on-object x$id $cx $cy $b $f;"
  	if {[string length $@focus]} {set gid $@focus}
  	if {$f&8} {
- 	    #puts "RIGHTCLICK OBJECT"
  	    set rightclick_object $id
  	} else {
--- 1765,1773 ----
***************
*** 1887,1891 ****
  		}
  		if {[llength $@selection] > 0} {
- 			#puts "dehightlight all!!!!!"
  			foreach obj $@selection {
  				$canvas itemconfigure ${obj}BASE -outline $look(objectframe3)
--- 1878,1881 ----
***************
*** 1894,1898 ****
  		}
  		if {[llength $@selection_wire] > 0} {
- 			#puts "dehightlight all wires!!!!!"
  			foreach wire $@selection_wire {
  				$canvas itemconfigure $wire -fill $look(wirefg)
--- 1884,1887 ----
***************
*** 1904,1908 ****
  		set @action rect
  		$canvas create line $cx $cy $cx $cy $cx $cy $cx $cy $cx $cy -tags selrect
- 		global OS
  		switch $OS { osx {} default { $canvas itemconfigure selrect -dash {3 3 3 3}}}
  	}
--- 1893,1896 ----
***************
*** 2280,2299 ****
  #-----------------------------------------------------------------------------------#
  def wire draw {canvas thick x1 y1 x2 y2} {
- 	#puts "wire_draw:: $self $canvas $thick $x1 $y1 $x2 $y2"
- 
  	global look
  	set xys [list $x1 $y1 $x2 $y2]
  	set length [expr sqrt(pow($x2-$x1,2)+pow($y2-$y1,2))]
- #	set step [expr 1/floor(1+$length/4)]
- #	for {set i 0} {$i<=1.001} {set i [expr $i+$step]} {
- #		set r [expr (rand()-0.5)*$i*(1-$i)*150]
- #		set r [expr sin($i/$step)*$i*(1-$i)*100]
- #		set q [expr sin(1+$i/$step)*$i*(1-$i)*100]
- #		#lappend xys [expr $x1+($x2-$x1)*$i+$r*[expr ($y1-$y2)/$length]]
- #		#lappend xys [expr $y1+($y2-$y1)*$i+$q*[expr ($x2-$x1)/$length]]
- #		lappend xys [expr $x1+($x2-$x1)*$i+(rand()-0.5)*150*$i*(1-$i)]
- #		lappend xys [expr $y1+($y2-$y1)*$i+(rand()-0.5)*150*$i*(1-$i)]
- #	}
- 
  	set arrowsize [expr $length<100 ? $length/10 : 10]
  	if {$arrowsize < 5} {set arrow none} {set arrow last}
--- 2268,2274 ----
***************
*** 2305,2309 ****
  
  def wire draw2 {canvas} {
- 	#puts "wire_draw2:: $self $canvas"
  	set bbox1 [$canvas bbox [join [list "$@obj1" o "$@port1"] ""]]
  	set bbox2 [$canvas bbox [join [list "$@obj2" i "$@port2"] ""]]
--- 2280,2283 ----
***************
*** 2316,2320 ****
  
  def wire select {canvas flag} {
- 	#puts "wire_select:: $self $canvas $flag"
  	global look
  	if {$flag} {set colour #ff8000} {set colour $look(wirefg)}
--- 2290,2293 ----
***************
*** 2323,2333 ****
  
  def wire erase {canvas} {
- 	#puts "wire_erase:: $self $canvas"
- 
  	$canvas delete $self
  }
  
  def wire update {d} {
- 	#puts "wire_update:: $self $d"
  	foreach [list @obj1 @port1 @obj2 @port2] \
  		[lrange $d 0 3] {}
--- 2296,2303 ----
***************
*** 2336,2341 ****
  #def wire status {d} {
  #	puts "wire_update:: $self $d"
! #	foreach [list @obj1 @port1 @obj2 @port2] \
! #		[lrange $d 0 3] {}
  #}
  
--- 2306,2310 ----
  #def wire status {d} {
  #	puts "wire_update:: $self $d"
! #	foreach [list @obj1 @port1 @obj2 @port2] [lrange $d 0 3] {}
  #}
  
***************
*** 2449,2452 ****
--- 2418,2424 ----
  ############ rendering
  
+ class_new view {thing}
+ def view erase {canvas} {item_delete $self $canvas}
+ 
  proc item {self canvas suffix type coords args} {
  	if {![llength [$canvas gettags ${self}${suffix}]]} {
***************
*** 2472,2476 ****
  }
  
! def message draw {canvas xs ys ins outs} {
  	global look
  	foreach {x1 y1} [object_xy $self $canvas] {}
--- 2444,2449 ----
  }
  
! class_new messagebox {view}
! def messagebox draw {canvas xs ys ins outs} {
  	global look
  	foreach {x1 y1} [object_xy $self $canvas] {}
***************
*** 2486,2490 ****
  }
  
! def message bang {canvas flag} {
  	global look
  	$canvas itemconfigure ${self}BASE -fill \
--- 2459,2463 ----
  }
  
! def messagebox bang {canvas flag} {
  	global look
  	$canvas itemconfigure ${self}BASE -fill \
***************
*** 2492,2504 ****
  }
  
! def message erase {canvas} {
! 	$canvas delete ${self}BASE
! 	io_erase $self $canvas
! }
! 
! #def message click {canvas} {}
! #def message tick {canvas} {}
! 
! def atom draw {canvas xs ys ins outs} {
  	global look
  	foreach {x1 y1} [object_xy $self $canvas] {}
--- 2465,2470 ----
  }
  
! class_new atombox {view}
! def atombox draw {canvas xs ys ins outs} {
  	global look
  	foreach {x1 y1} [object_xy $self $canvas] {}
***************
*** 2517,2525 ****
  }
  
! def atom erase {canvas} {
! 	$canvas delete ${self}BASE
! 	io_erase $self $canvas
! }
! 
  def numbox draw {canvas} {
  	global look
--- 2483,2487 ----
  }
  
! class_new numbox {view}
  def numbox draw {canvas} {
  	global look
***************
*** 2576,2596 ****
  		# 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;}
  		}
  	}
--- 2538,2544 ----
  		# must shrink number
  		if {$is_exp} {
! 			#...
  		} {
! 			#...
  		}
  	}
***************
*** 2598,2607 ****
  }
  
- def numbox erase {canvas} {
- 	$canvas delete ${self}BASE ${self}NUMBER ${self}BASE4
- 	io_erase $self $canvas
- 	label_erase $self $canvas
- }
- 
  def numbox click {canvas x y b f} {
  	canvas_focus $canvas $self
--- 2546,2549 ----
***************
*** 2663,2666 ****
--- 2605,2609 ----
  }
  
+ class_new comment {view}
  def comment draw {canvas xs ys ins outs} {
  	if {[llength [$canvas gettags $self]] != 0} {}
***************
*** 2668,2673 ****
  }
  
- def comment erase {canvas} {}
- 
  def bluebox draw {canvas x1 y1 xs ys ins outs} {
  	global look
--- 2611,2614 ----
***************
*** 2687,2695 ****
  }
  
! def bluebox erase {canvas} {
! 	$canvas delete ${self}BASE ${self}BASE2 ${self}BASE3
! 	io_erase $self $canvas
! }
! 
  def radio orient {} {
  	switch $@class {
--- 2628,2632 ----
  }
  
! class_new radio {view}
  def radio orient {} {
  	switch $@class {
***************
*** 2732,2741 ****
  }
  
! def radio erase {canvas} {
! 	bluebox_erase $self $canvas
! 	$canvas delete ${self}BUT
! 	label_erase $self $canvas
! }
! 
  def radio click {canvas x y b f} {
  	set x [expr $x-$@x1]
--- 2669,2673 ----
  }
  
! class_new radio {view}
  def radio click {canvas x y b f} {
  	set x [expr $x-$@x1]
***************
*** 2752,2755 ****
--- 2684,2688 ----
  }
  
+ class_new slider {view}
  def slider orient {} {
  	switch $@class {
***************
*** 2818,2827 ****
  }
  
- def slider erase {canvas} {
- 	bluebox_erase $self $canvas
- 	label_erase $self $canvas
- 	$canvas delete ${self}KNOB
- }
- 
  def slider click {canvas x y b f} {
  	canvas_focus $canvas $self
--- 2751,2754 ----
***************
*** 2857,2860 ****
--- 2784,2788 ----
  }
  
+ #class_new label_new {view}
  def label draw {canvas} {
  	foreach {x1 y1} [object_xy $self $canvas] {}
***************
*** 2876,2880 ****
  #-----------------------------------------------------------------------------------#
  
! class_new bang
  def bang init {} {
  	global offset _
--- 2804,2808 ----
  #-----------------------------------------------------------------------------------#
  
! class_new bang {view}
  def bang init {} {
  	global offset _
***************
*** 2899,2903 ****
  }
  
- #-----------------------------------------------------------------------------------#
  def bang draw {canvas} {
  	foreach {x1 y1} [object_xy $self $canvas] {}
--- 2827,2830 ----
***************
*** 2918,2927 ****
  }
  
- def bang erase {canvas} {
- 	bluebox_erase $self $canvas
- 	io_erase $self $canvas
- 	$canvas delete ${self}BUT ${self}LABEL
- }
- 
  def bang click {canvas x y b f} {
  	pd "x$self click $x $y 0 0 0 ;"
--- 2845,2848 ----
***************
*** 2933,2936 ****
--- 2854,2858 ----
  }
  
+ class_new toggle {view}
  def toggle draw {canvas} {
  	foreach {x1 y1} [object_xy $self $canvas] {}
***************
*** 2963,2967 ****
  }
  
- 
  def toggle erase {canvas} {
  	bluebox_erase $self $canvas
--- 2885,2888 ----
***************
*** 2974,2977 ****
--- 2895,2900 ----
  }
  
+ class new vu {view}
+ 
  set vu_col {
      0 17 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 
***************
*** 3051,3060 ****
  }
  
- def vu erase {canvas} {
- 	bluebox_erase $self $canvas
- 	label_erase $self $canvas
- 	$canvas delete ${self}SCALE ${self}RMS ${self}MASK
- }
- 
  catch {
  	package require tkdnd
--- 2974,2977 ----
***************
*** 3062,3065 ****
--- 2979,2983 ----
  }
  
+ class_new dropper {view}
  def dropper draw {canvas} {	
      set isnew [expr [llength [$canvas gettags ${self}BASE]] == 0]
***************
*** 3083,3091 ****
  
  def dropper erase {canvas} {
- 	bluebox_erase $self $canvas
  	destroy $canvas.${self}DROP
! 	$canvas delete ${self}window
  }
  
  def cnv draw {canvas} {
  	foreach {x1 y1} [object_xy $self $canvas] {}
--- 3001,3009 ----
  
  def dropper erase {canvas} {
  	destroy $canvas.${self}DROP
! 	super $canvas
  }
  
+ class cnv {view}
  def cnv draw {canvas} {
  	foreach {x1 y1} [object_xy $self $canvas] {}
***************
*** 3097,3105 ****
  }
  
- def cnv erase {canvas} {
- 	label_erase $self $canvas
- 	$canvas delete ${self}BASE ${self}LABEL
- }
- 
  #####################################################################################
  ############ console
--- 3015,3018 ----





More information about the Pd-cvs mailing list