pd/src desire.tk,1.1.2.77,1.1.2.78 - Pd-cvs

23 Sep 2005


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31661
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
added new_as, super, view move, objectbox move, etc
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.77
retrieving revision 1.1.2.78
diff -C2 -d -r1.1.2.77 -r1.1.2.78
*** desire.tk	23 Sep 2005 12:36:59 -0000	1.1.2.77
--- desire.tk	23 Sep 2005 14:32:09 -0000	1.1.2.78
***************
*** 37,40 ****
--- 37,45 ----
    	eval [concat [list $self init] $args]
    "
+ 	proc ${self}_new_as {self args} "
+ 		global _
+ 		set _($self:_class) $self
+ 		eval [concat [list $self init] $args]
+ 	"
  }
***************
*** 86,90 ****
    set name [lindex $methods $i]
    #puts "proc name of $self $selector is $name"
! 	set r [uplevel 1 [concat [list $name $self] [lrange $args 2 end]]]
    #puts "!!! /unknown $args"
    return $r
--- 91,95 ----
    set name [lindex $methods $i]
    #puts "proc name of $self $selector is $name"
! 	set r [eval [concat [list $name $self] [lrange $args 2 end]]]
    #puts "!!! /unknown $args"
    return $r
***************
*** 93,97 ****
  # this one is broken (n'ajustez pas votre appareil)
  proc super {args} {
! 	upvar 2 methods methods self self i oi
    set i [expr 1+$oi]
    puts "!!! super #$i"
--- 98,106 ----
  # this one is broken (n'ajustez pas votre appareil)
  proc super {args} {
! 	uplevel 0 {catch {puts "0: [info locals]"}}
! 	uplevel 1 {catch {puts "1: [info locals]"}}
! 	uplevel 2 {catch {puts "2: [info locals]"}}
! 	uplevel 3 {catch {puts "3: [info locals]"}}
! 	upvar 2 methods methods self self selector selector i oi
    set i [expr 1+$oi]
    puts "!!! super #$i"
***************
*** 99,103 ****
    set name [lindex $methods $i]
    puts "proc name of $self $selector is $name"
! 	set r [uplevel 1 [concat [list $name $self] $args]]
  }
--- 108,112 ----
    set name [lindex $methods $i]
    puts "proc name of $self $selector is $name"
! 	set r [eval [concat [list $name $self] $args]]
  }
***************
*** 726,731 ****
    global _
    set self [c2self $name]
! 	set _($self:_class) canvas
! 	$self init $width $height $geometry $editable
  }
--- 735,739 ----
    global _
    set self [c2self $name]
! 	canvas_new_as $self $width $height $geometry $editable
  }
***************
*** 734,737 ****
--- 742,746 ----
      global pd_opendir pd_tearoff OS cmdline canvasmenu focus
      set name .x$self
+     set c .x$self.c
      set focus(canvas) $self
      set _(focus) $self
***************
*** 740,746 ****
      pack [make_button_bar $name.bbar $name] -side top -fill x -expand no
      pack [statusbar_new $self] -side bottom -fill x
!     pack [scrollbar $name.xscroll -command "$name.c xview" -orient horizontal] -side bottom -fill x
!     pack [scrollbar $name.yscroll -command "$name.c yview"] -side  right -fill y
!     pack [canvas $name.c -width $width -height $height -background white \
      	-yscrollcommand "$name.yscroll set" \
      	-xscrollcommand "$name.xscroll set" \
--- 749,755 ----
      pack [make_button_bar $name.bbar $name] -side top -fill x -expand no
      pack [statusbar_new $self] -side bottom -fill x
!     pack [scrollbar $name.xscroll -command "$c xview" -orient horizontal] -side bottom -fill x
!     pack [scrollbar $name.yscroll -command "$c yview"] -side  right -fill y
!     pack [canvas $c -width $width -height $height -background white \
      	-yscrollcommand "$name.yscroll set" \
      	-xscrollcommand "$name.xscroll set" \
***************
*** 751,761 ****
      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]} ""}
      }
      wm protocol $name WM_DELETE_WINDOW "menu_close $name"
      $self new_binds
!     focus $name.c
      $self editmode $editable
      set @action none
--- 760,770 ----
      menu $name.popup -tearoff false
      populate_menu $name.popup $name {
! 	{"Properties" {popup_properties [c2self %W]} ""}
! 	{"Open"       {popup_open       [c2self %W]} ""}
! 	{"Help"       {popup_help       [c2self %W]} ""}
      }
      wm protocol $name WM_DELETE_WINDOW "menu_close $name"
      $self new_binds
!     focus $c
      $self editmode $editable
      set @action none
***************
*** 770,773 ****
--- 779,783 ----
      set @wire_from {}
      set @wire_to {}
+     set @children {}
  }
***************
*** 1173,1178 ****
    after 1 "destroy $t"
    set l {}
! 	foreach c [split $@text ""] {lappend l [scan $c %c]}
    pd ".x$canvas text_setto !$self $l ;"
  }
--- 1183,1189 ----
    after 1 "destroy $t"
    set l {}
! 	foreach char [split $@text ""] {lappend l [scan $char %c]}
    pd ".x$canvas text_setto !$self $l ;"
+ 	eval "focus $c"
  }
***************
*** 1185,1203 ****
    for {set x 0} {$x<$@ninlets} {incr x} {
    	if {[info exists _($self:i:$x)]} {
! 			foreach wire_id $_($self:i:$x) {
! 				wire_update $wire_id $_($wire_id) 
! 				#set i [lsearch $@selection_wire $wire_id]
! 				#if {$i<0} {lappend @selection_wire $wire_id} 
! 			}
    	}
    }
    for {set x 0} {$x<$@noutlets} {incr x} {
    	if {[info exists _($self:o:$x)]} {
! 			foreach wire_id $_($self:o:$x) {
! 				wire_update $wire_id $_($wire_id) 
! 		    		#set i [lsearch $@selection_wire $wire_id]
! 				#if {$i<0} {lappend @selection_wire $wire_id} 
! 			}
! 		}	
    }
    text_new $canvas $self [expr $@cx+2] [expr $@cy+2] \
--- 1196,1206 ----
    for {set x 0} {$x<$@ninlets} {incr x} {
    	if {[info exists _($self:i:$x)]} {
! 			foreach wire_id $_($self:i:$x) {wire_update $wire_id $_($wire_id)}
    	}
    }
    for {set x 0} {$x<$@noutlets} {incr x} {
    	if {[info exists _($self:o:$x)]} {
! 			foreach wire_id $_($self:o:$x) {wire_update $wire_id $_($wire_id)}
! 		}
    }
    text_new $canvas $self [expr $@cx+2] [expr $@cy+2] \
***************
*** 1231,1240 ****
  #}
! #def objectbox move {args} {
! #	 set @cx [expr $@cx+[lindex $args 0]]
! #	 set @cy [expr $@cy+[lindex $args 1]]
! #	 $self draw $self $_($self:canvas)
! #	 $self draw $_($self:canvas)
! #}
#-----------------------------------------------------------------------------------#
--- 1234,1252 ----
  #}
! def objectbox draw_wires {canvas} {
! 	for {set x 0} {$x<$@ninlets} {incr x} {
! 		set v $self:i:$x
! 		if {[info exists _($v)]} {foreach wire $_($v) {$wire draw $self}}
! 	}
! 	for {set x 0} {$x<$@noutlets} {incr x} {
! 		set v $self:o:$x
! 		if {[info exists _($v)]} {foreach wire $_($v) {$wire draw $self}}
! 	}
! }
! 
! def objectbox move {canvas dx dy} {
! 	super $canvas $dx $dy
! 	$self draw_wires $canvas
! }
#-----------------------------------------------------------------------------------#
***************
*** 1260,1272 ****
    set @cy [expr $@cy+$dy]
    .x$@canvas.c move $self $dx $dy
- 	#$self draw
- 	for {set x 0} {$x<$@ninlets} {incr x} {
- 		set v $self:i:$x
- 		if {[info exists _($v)]} {foreach wire $_($v) {$wire draw $self}}
- 	}
- 	for {set x 0} {$x<$@noutlets} {incr x} {
- 		set v $self:o:$x
- 		if {[info exists _($v)]} {foreach wire $_($v) {$wire draw $self}}
- 	}
  }
--- 1272,1275 ----
***************
*** 1421,1433 ****
  }
#-----------------------------------------------------------------------------------#
  # this proc is too long, should be cut in several parts --matju
  # agree, but could i do this a bit later? --chun
- def objectbox bbox {} {
- 	list $@cx $@cy [expr $@cx+$@xs] [expr $@cy+$@ys]
- 	
- }
- 
  def* canvas click_on_object {x y b f id} {
    global look
--- 1424,1433 ----
  }
+ def objectbox bbox {} {list $@cx $@cy [expr $@cx+$@xs] [expr $@cy+$@ys]}
+ 
  #-----------------------------------------------------------------------------------#
  # this proc is too long, should be cut in several parts --matju
  # agree, but could i do this a bit later? --chun
def* canvas click_on_object {x y b f id} {
    global look
***************
*** 1544,1549 ****
    	focus $c
    	set @action rect
! 		$c create line $x $y $x $y $x $y $x $y $x $y -tags selrect
! 		$c itemconfigure selrect -dash {3 3 3 3}
    }
        }
--- 1544,1548 ----
    	focus $c
    	set @action rect
! 		$c create line $x $y $x $y $x $y $x $y $x $y -tags {selrect1 selrect} -fill black -dash {3 3 3 3} -dashoffset 3
    }
        }
***************
*** 1557,1570 ****
      set cy [$c canvasy $y]
      if {[llength $@wire_from]} {
!         if {[llength $wire_to]} {
! 		#puts "wire reachs inlet, draw proper wire!!"
    	set d $@wire_from
    	foreach item $wire_to {lappend d $item}
    	#add a last 0 for wire_update, not sure what's for....
    	lappend d 0 
- 		#my wire code --chun
- 		#$_($id:noutlets) -> number of outlets an object has
- 		#propose: _(obj_id:flag:port_number) -> list of connections an particular in/outlet has
- 	
    	#tmp only, generates id for wires
    	set wire_id l[format %x [expr 0x80f8ea8 - $offset_wire]]
--- 1556,1564 ----
      set cy [$c canvasy $y]
      if {[llength $@wire_from]} {
!         if {[llength $@wire_to]} {
    	set d $@wire_from
    	foreach item $wire_to {lappend d $item}
    	#add a last 0 for wire_update, not sure what's for....
    	lappend d 0 
    	#tmp only, generates id for wires
    	set wire_id l[format %x [expr 0x80f8ea8 - $offset_wire]]
***************
*** 1639,1644 ****
    	foreach obj $@selection {
    		for {set x 0} {$x<$_($obj:ninlets)} {incr x} {
- 				#if {[info exists]}
- 				#puts "check -> $obj"
    			if {[info exists _($obj:i:$x)]} {
    				foreach wire_id $_($obj:i:$x) {
--- 1633,1636 ----