pd/src desire.tk,1.1.2.49,1.1.2.50 - Pd-cvs

14 Sep 2005


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16365
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
added method lookup with backtracking.
changed more _($self:...) to @...
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.49
retrieving revision 1.1.2.50
diff -C2 -d -r1.1.2.49 -r1.1.2.50
*** desire.tk	13 Sep 2005 21:58:20 -0000	1.1.2.49
--- desire.tk	14 Sep 2005 00:29:27 -0000	1.1.2.50
***************
*** 13,26 ****
  #   (thanks for taking time looking at this code)
  #-----------------------------------------------------------------------------------#
! # This section is matju's object system (the base class is called base because
! # there's already something else called class)
set nextid 0
! proc class_new {name} {
! 	proc ${name}_new {args} "
    	global nextid _
    	set self [format %08x $nextid]
    	incr nextid
! 		set _($self:_class) $name
    	eval [concat [list $self init] $args]
    "
--- 13,35 ----
  #   (thanks for taking time looking at this code)
  #-----------------------------------------------------------------------------------#
! 
! #-----------------------------------------------------------------------------------#
! # OBJECT ORIENTED PROGRAMMING IN TCL (by Mathieu Bouchard)
! # (please distinguish between what this is and what dataflow is)
! # note, the toplevel class is called "thing".
set nextid 0
! set _(class:_class) class
! set _(class:_super) {thing}
! 
! proc class_new {self {super {thing}}} {
! 	global _
! 	set _($self:_class) class
! 	set _($self:_super) $super
! 	proc ${self}_new {args} "
    	global nextid _
    	set self [format %08x $nextid]
    	incr nextid
! 		set _($self:_class) $self
    	eval [concat [list $self init] $args]
    "
***************
*** 32,35 ****
--- 41,52 ----
  }
+ proc lookup_method {class selector listvar} {
+ 	global _
+ 	upvar $listvar lv
+ 	set name ${class}_$selector
+ 	if {[info procs $name} {lappend lv $name}
+ 	foreach super $_($class:_super) {lookup_method $super $selector lv}
+ }
+ 
  rename unknown _original_unknown
  proc unknown {args} {
***************
*** 41,45 ****
    	return [uplevel 1 [linsert $args 0 _original_unknown]]
    }
! 	set name $_($self:_class)_$selector
    puts "proc name of $self $selector is $name"
    set r [uplevel 1 [concat [list $name $self] [lrange $args 2 end]]]
--- 58,65 ----
    	return [uplevel 1 [linsert $args 0 _original_unknown]]
    }
! 	set candidates {}
! 	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]]]
***************
*** 48,51 ****
--- 68,76 ----
  }
+ class_new thing
+ set _(thing:_super) {}
+ 
+ #-----------------------------------------------------------------------------------#
+ 
  # carmen's canvas
  source pd_base.tk
***************
*** 984,990 ****
        }
      }
!     bind $c <Key>        {canvas_key %W %x %y %K %A 0}
!     bind $c <Shift-Key>  {canvas_key %W %x %y %K %A 1}
!     bind $c <KeyRelease> {canvas_keyup %W %x %y %K %A 0}
      bind $c <Motion>     {canvas_motion %W %x %y 0 %s}
      bind $c <Alt-Motion> {canvas_motion %W %x %y 4 %s}
--- 1009,1015 ----
        }
      }
!     bind $c <Key>        {canvas_key [canvastosym %W] %x %y %K %A 0}
!     bind $c <Shift-Key>  {canvas_key [canvastosym %W] %x %y %K %A 1}
!     bind $c <KeyRelease> {canvas_keyup [canvastosym %W] %x %y %K %A 0}
      bind $c <Motion>     {canvas_motion %W %x %y 0 %s}
      bind $c <Alt-Motion> {canvas_motion %W %x %y 4 %s}
***************
*** 1011,1027 ****
      global _
      set self [canvastosym $name.c]
!     set _($self:action) none
!     set _($self:selection) {}
!     set _($self:selection_wire) {}
!     set _($self:focus) ""
!     set _($self:current_x) 30
!     set _($self:current_y) 30
!     #set _($self:editable) $editable
!      
      #if {$editable == 1} {
      #	puts "editable == 1"
!     #	set _($self:mode) "edit"
      #} else {
!     #	set _($self:mode) "run"
      #}
--- 1036,1051 ----
      global _
      set self [canvastosym $name.c]
!     set @action none
!     set @selection {}
!     set @selection_wire {}
!     set @focus ""
!     set @current_x 30
!     set @current_y 30
!     #set @editable $editable
      #if {$editable == 1} {
      #	puts "editable == 1"
!     #	set @mode "edit"
      #} else {
!     #	set @mode "run"
      #}
***************
*** 1200,1204 ****
  proc canvas_of {self} {
    global _
! 	return $_($self:canvas)
  }
--- 1224,1228 ----
  proc canvas_of {self} {
    global _
! 	return $@canvas
  }
***************
*** 1327,1337 ****
  #-----------------------------------------------------------------------------------#
  def text create {canvas font_size text} {
- 	#puts "text_create:: $self $canvas $font_size"
    global look font
! 	set name_len [string length $text]
! 	set xs [expr ($font(width) * ($name_len+1) + $font(padx))]
! 	set ys [expr $font(height) + $font(pady)]
! 	set @xs $xs
! 	set @ys $ys
    objectbox_draw $self $canvas
    set t $canvas.${self}text
--- 1351,1357 ----
  #-----------------------------------------------------------------------------------#
  def text create {canvas font_size text} {
    global look font
! 	set @name_len [string length $text]
! 	object_update_size $self
    objectbox_draw $self $canvas
    set t $canvas.${self}text
***************
*** 1374,1387 ****
  class_new objectbox
  def objectbox init {} {
! 	global offset
    #set canvas [canvastosym $_(focus)]
    set canvas $_(focus)
    set @class ""
    $self add $canvas
  }
- #-----------------------------------------------------------------------------------#
  def objectbox add {canvas} {
- 	#puts "object_add:: $self $canvas"
    global font look
    set canvas_id [canvastosym $canvas]
--- 1394,1412 ----
  class_new objectbox
  def objectbox init {} {
! 	set @isnew 1
    #set canvas [canvastosym $_(focus)]
    set canvas $_(focus)
    set @class ""
    $self add $canvas
+ 	set @name_len 0
+ }
+ 
+ def objectbox update_size {} {
+ 	global font
+ 	set @xs [expr $font(padx)+$font(width)*($@name_len+$@isnew)]
+ 	set @ys [expr $font(pady)+$font(height)]
  }
def objectbox add {canvas} {
    global font look
    set canvas_id [canvastosym $canvas]
***************
*** 1391,1395 ****
    			set object [lindex $_($canvas_id:selection) 0]
    			#puts "___ complete $object first ____"
! 				object_complete $object $canvas
    		}
    	}
--- 1416,1420 ----
    			set object [lindex $_($canvas_id:selection) 0]
    			#puts "___ complete $object first ____"
! 				objectbox_complete $object $canvas
    		}
    	}
***************
*** 1399,1420 ****
    	set _($canvas_id:selection) {}
    }
- 	set @isnew 1
    set canvas_id [canvastosym $canvas]
- 	#puts "canvas_id ==> $canvas_id"
    set _($canvas_id:obj_in_edit) 1
! 	#set _($canvas_id:obj_in_edit) $self
! 	set _($canvas_id:selection) {}	
    set _($canvas_id:selection) [linsert $_($canvas_id:selection) 0 $self]
! 	#puts "self:selection: [lindex $_($canvas_id:selection) 0]"
! 	#puts "set $self:isnew -> $@isnew"
! 	set @xs [expr $font(width) + $font(padx)]
! 	set @ys [expr $font(height) + $font(pady)]
! 	
    objectbox_draw $self $canvas
    text_create $self $canvas $font(size) ""
  }
! #-----------------------------------------------------------------------------------#
! def object complete {canvas} {
    global font
    set @isselected 0
--- 1424,1437 ----
    	set _($canvas_id:selection) {}
    }
    set canvas_id [canvastosym $canvas]
    set _($canvas_id:obj_in_edit) 1
! 	set _($canvas_id:selection) {}
    set _($canvas_id:selection) [linsert $_($canvas_id:selection) 0 $self]
! 	$self update_size
    objectbox_draw $self $canvas
    text_create $self $canvas $font(size) ""
  }
! def objectbox complete {canvas} {
    global font
    set @isselected 0
***************
*** 1425,1430 ****
          $canvas delete ${self}text
    objectbox_erase $self $canvas 
! 	set @sx	[expr ($@name_len*$font(width)) + $font(padx)]
! 	set @sy [expr $font(height) + $font(pady)]
    objectbox_draw $self $canvas
    for {set x 0} {$x<$@inlets} {incr x} {
--- 1442,1446 ----
          $canvas delete ${self}text
    objectbox_erase $self $canvas 
! 	objectbox_update_size $self
    objectbox_draw $self $canvas
    for {set x 0} {$x<$@inlets} {incr x} {
***************
*** 1432,1436 ****
    		#puts "wires at inlet $x to select --> $_($self:0:$x)"
    		#wire_update $_()
- 			#wire_update:: l80f8ea8 81168ae 1 81168af 0 0
    		foreach wire_id $_($self:0:$x) {
    			wire_update $wire_id $_($wire_id) 
--- 1448,1451 ----
***************
*** 1457,1461 ****
#-----------------------------------------------------------------------------------#
! def object edit {canvas} {
    global font
    set canvas_id [canvastosym $canvas]
--- 1472,1476 ----
#-----------------------------------------------------------------------------------#
! def objectbox edit {canvas} {
    global font
    set canvas_id [canvastosym $canvas]
***************
*** 1492,1513 ****
  proc canvas_motion {canvas x y mods state} {
      #puts "canvas_motion::: $canvas $x $y $mods $state"
!     canvas_motion2 $canvas $x $y $mods $state
!     #statusbar_update [canvastosym $canvas] $x $y
  }
#-----------------------------------------------------------------------------------#
! proc canvas_motion2 {canvas x y mods state} {
!     #puts "canvas_motion2::: $x $y $mods $state"
! 
      global current_x current_y old_x old_y select_area mouse font
      global tooltip _ dehighlight look wire_from wire_to
!     set self [canvastosym $canvas]
!     set cx [$canvas canvasx $x]
!     set cy [$canvas canvasy $y]
!     
!     set _($self:current_x) $cx
!     set _($self:current_y) $cy
!     set edit 0; switch $_($self:mode) { edit { set edit 1 } }
      if {$tooltip(visible)} {
    #puts "cx=$cx cy=$cy tooltip=($tooltip(mx),$tooltip(my),$tooltip(canvas),$tooltip(visible)"
--- 1507,1524 ----
  proc canvas_motion {canvas x y mods state} {
      #puts "canvas_motion::: $canvas $x $y $mods $state"
!     canvas_motion2 [canvastosym $canvas] $x $y $mods $state
!     statusbar_update [canvastosym $canvas] $x $y
  }
#-----------------------------------------------------------------------------------#
! def canvas motion2 {x y mods state} {
      global current_x current_y old_x old_y select_area mouse font
      global tooltip _ dehighlight look wire_from wire_to
!     #puts "canvas_motion2::: $x $y $mods $state"
!     set canvas $self.c
!     set cx [$canvas canvasx $x]; set @current_x $cx
!     set cy [$canvas canvasy $y]; set @current_y $cy
!     set edit 0; switch $@mode { edit { set edit 1 } }
      if {$tooltip(visible)} {
    #puts "cx=$cx cy=$cy tooltip=($tooltip(mx),$tooltip(my),$tooltip(canvas),$tooltip(visible)"
***************
*** 1531,1540 ****
    $canvas coords lnew $l
      }
!     switch $_($self:action) {
        move {
          #pd "$self displace-selection [expr $cx-$old_x] [expr $cy-$old_y] ;\n"
          # my move object code begins --chun
          #puts "move objects by :: [expr $cx-$old_x] [expr $cy-$old_y]"
!         foreach obj $_($self:selection) {
          	#puts "___ move object $obj ___"
      		set _($obj:cx) [expr $_($obj:cx) + $cx-$old_x]
--- 1542,1551 ----
    $canvas coords lnew $l
      }
!     switch $@action {
        move {
          #pd "$self displace-selection [expr $cx-$old_x] [expr $cy-$old_y] ;\n"
          # my move object code begins --chun
          #puts "move objects by :: [expr $cx-$old_x] [expr $cy-$old_y]"
!         foreach obj $@selection {
          	#puts "___ move object $obj ___"
      		set _($obj:cx) [expr $_($obj:cx) + $cx-$old_x]
***************
*** 1549,1553 ****
    		set text_pos [list [expr $_($obj:cx)+1] [expr $_($obj:cy)+1]]
    		set text_pos2 [list [expr $_($obj:cx)+2] [expr $_($obj:cy)+2]]
! 			if {$_($self:obj_in_edit)} {$canvas coords ${obj}text $text_pos}
    		$canvas coords ${obj}TEXT $text_pos2
    	  }
--- 1560,1564 ----
    		set text_pos [list [expr $_($obj:cx)+1] [expr $_($obj:cy)+1]]
    		set text_pos2 [list [expr $_($obj:cx)+2] [expr $_($obj:cy)+2]]
! 			if {$@obj_in_edit} {$canvas coords ${obj}text $text_pos}
    		$canvas coords ${obj}TEXT $text_pos2
    	  }
***************
*** 1558,1563 ****
    	}
    	#----handles the wire update----
! 		#set _($self:inlets)  $ins
!     		#set _($self:outlets) $outs
    	for {set x 0} {$x<$_($obj:inlets)} {incr x} {
    		#if {[info exists]}
--- 1569,1574 ----
    	}
    	#----handles the wire update----
! 		#set @inlets  $ins
!     		#set @outlets $outs
    	for {set x 0} {$x<$_($obj:inlets)} {incr x} {
    		#if {[info exists]}
***************
*** 1596,1601 ****
      }
      set run [expr !$edit]
!     if {[string length $_($self:focus)]} {
! 	set id $_($self:focus)
    if {$run} {
    	event $id motionevent     $canvas $cx $cy $mods} {
--- 1607,1612 ----
      }
      set run [expr !$edit]
!     if {[string length $@focus]} {
! 	set id $@focus
    if {$run} {
    	event $id motionevent     $canvas $cx $cy $mods} {
***************
*** 1655,1659 ****
      }
    }
! 	#puts "search clicked object: [lsearch $_($self:selection) $id]"
    #puts "b1_down? $mouse(b1down)"
    #puts "arghhhhhhhh"
--- 1666,1670 ----
      }
    }
! 	#puts "search clicked object: [lsearch $@selection $id]"
    #puts "b1_down? $mouse(b1down)"
    #puts "arghhhhhhhh"
***************
*** 1829,1833 ****
    			set old_obj [lindex $@selection 0]
    			if {$@select_by == "click"} {
! 					object_complete $old_obj $canvas
    			}
    			set @obj_in_edit 0
--- 1840,1844 ----
    			set old_obj [lindex $@selection 0]
    			if {$@select_by == "click"} {
! 					objectbox_complete $old_obj $canvas
    			}
    			set @obj_in_edit 0
***************
*** 1877,1881 ****
    	if {[info exists @obj_in_edit]} {
    		if {$@obj_in_edit > 0} {
! 				object_complete [lindex $@selection 0] $canvas
    			set @obj_in_edit 0
    		}
--- 1888,1892 ----
    	if {[info exists @obj_in_edit]} {
    		if {$@obj_in_edit > 0} {
! 				objectbox_complete [lindex $@selection 0] $canvas
    			set @obj_in_edit 0
    		}
***************
*** 2088,2109 ****
      if {[llength $@selection]==1} {
      	#puts "___only one obj selected by click!!!"
-     
    #pd "$self gobj-activate x$@selection;"
    #puts "____ selected by ->$@select_by ____"
- 	
    if {$@select_by == "click"} {
- 	
    	switch $_($@selection:class) {
! 		
! 		objectbox {
! 		if {$@obj_in_edit == 0} {
! 			set @obj_in_edit 1
! 			object_edit [lindex $@selection 0] $canvas
!     		}
! 		}
! 		
    	}
    }
!     	#object_edit $@edit_object $canvas
      }
      set edit 0; switch $@mode { edit { set edit 1 } }
--- 2099,2115 ----
      if {[llength $@selection]==1} {
      	#puts "___only one obj selected by click!!!"
    #pd "$self gobj-activate x$@selection;"
    #puts "____ selected by ->$@select_by ____"
    if {$@select_by == "click"} {
    	switch $_($@selection:class) {
! 		  objectbox {
! 			if {$@obj_in_edit == 0} {
! 				set @obj_in_edit 1
! 				objectbox_edit [lindex $@selection 0] $canvas
! 			}
! 		  }
    	}
    }
!     	#objectbox_edit $@edit_object $canvas
      }
      set edit 0; switch $@mode { edit { set edit 1 } }
***************
*** 2190,2200 ****
  #-----------------------------------------------------------------------------------#
! proc canvas_key {canvas x y key iso shift} {
  #    .controls.switches.meterbutton configure -text $key
      #puts "canvas_key::: $canvas $x $y $key $iso $shift"
- 
-     global OS
-     global _
-     set self [canvastosym $canvas]
      #hide_canvas_tooltip $canvas
      switch $OS {
--- 2196,2204 ----
  #-----------------------------------------------------------------------------------#
! def canvas key {x y key iso shift} {
!     global OS
!     set canvas $self.c
  #    .controls.switches.meterbutton configure -text $key
      #puts "canvas_key::: $canvas $x $y $key $iso $shift"
      #hide_canvas_tooltip $canvas
      switch $OS {
***************
*** 2241,2245 ****
  #-----------------------------------------------------------------------------------#
! proc canvas_keyup {canvas x y key iso shift} {
      #puts "canvas_keyup::: $canvas $x $y $key $iso $shift"
--- 2245,2250 ----
  #-----------------------------------------------------------------------------------#
! def canvas keyup {x y key iso shift} {
!     set canvas $self.c
      #puts "canvas_keyup::: $canvas $x $y $key $iso $shift"