pd/src desire.tk,1.1.2.51,1.1.2.52 - Pd-cvs

14 Sep 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 ----