[PD-cvs] pd/src desire.tk,1.1.2.600.2.72,1.1.2.600.2.73

chunlee chunlee at users.sourceforge.net
Wed Dec 13 18:16:44 CET 2006


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

Modified Files:
      Tag: desiredata
	desire.tk 
Log Message:
adapting to the new changes regarding to wire stuff


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.600.2.72
retrieving revision 1.1.2.600.2.73
diff -C2 -d -r1.1.2.600.2.72 -r1.1.2.600.2.73
*** desire.tk	13 Dec 2006 07:23:13 -0000	1.1.2.600.2.72
--- desire.tk	13 Dec 2006 17:16:41 -0000	1.1.2.600.2.73
***************
*** 1211,1215 ****
  
  def View canvas  {}  {return $@canvas}
! def View canvas= {c} {set @canvas $c}
  
  def View visible {} {if {[info exists @inside_box]} {return $@inside_box} {return -1}}
--- 1211,1218 ----
  
  def View canvas  {}  {return $@canvas}
! def View canvas= {c} {
! 	set @canvas $c
! 	$self subscribe $c; $self changed
! }
  
  def View visible {} {if {[info exists @inside_box]} {return $@inside_box} {return -1}}
***************
*** 1848,1851 ****
--- 1851,1856 ----
  
  def Canvas new_object_callback {obj} {}
+ def Canvas new_object_select {obj} {$self selection+= $obj}
+ def Canvas new_wire_select {wire} {$self selection_wire+= $wire}
  def Canvas new_object_edit     {obj} {
  	if {[$obj class] == "NumBox"} {return}
***************
*** 2333,2357 ****
  	global paste
  	if {!$@mapped} {return}; set @folder $folder; $self update_title
- 	$self done_update
- }
- 
- def Canvas done_update {} {
- 	global paste subpatcherize
- 	if {$self == $paste(state)} {$self done_paste}
- 	if {$self == $subpatcherize(parent) && $subpatcherize(cut)} {
- 		set subpatcherize(cut) 0; set subpatcherize(insert) 1
- 		set construct "#X obj $subpatcherize(x) $subpatcherize(y) pd sub$subpatcherize(count)"
- 		netsend [list .$self object_insert [expr [llength $@children] - 1] $construct]
- 		return
- 	}
- 	if {$self != $subpatcherize(parent) && $subpatcherize(insert)} {
- 		set subpatcherize(sub) $self
- 	}
- 	if {$self == $subpatcherize(parent) && $subpatcherize(insert)} {
- 		if {$subpatcherize(sub) == "0"} {return}
- 		$subpatcherize(sub) paste
- 		set subpatcherize(insert) 0
- 		return
- 	}
  }
  
--- 2338,2341 ----
***************
*** 2455,2491 ****
  
  # should be only called from the server
! def Canvas wires= {wires2} {
! 	global clipboard
! 	set wires {}
! 	foreach x $wires2 {
! 	  mset {outobj outport inobj inport} $x
! 	  set obj1 [lindex $@children $outobj]
! 	  set obj2 [lindex $@children $inobj]
! 	  set find [lsearch $@wires_pair $x]
! 	  if {$find == -1} {# new wire!!!
! 	    lappend @wires_pair [list $outobj $outport $inobj $inport]
! 	    set new_wire [Wire_new $self $outobj $outport $inobj $inport]
! 	    lappend @wires_pair $new_wire
! 	    lappend wires $new_wire
! 	  } else {# wire already exists
! 	    lappend wires [lindex $@wires_pair [expr $find + 1]]
! 	  }
! 	}
! 	set born [lwithout $wires $@wires]
! 	set born_num [expr [llength $born] - 1]
! 	foreach x $born {
! 		$x subscribe $self
! 		$x changed
! 		$x canvas= $self
! 	}
  	set dead [lwithout $@wires $wires]
! 	foreach x $dead {
! 		$x delete
! 		set find [lsearch $@wires_pair $x]
! 		set @wires_pair [lreplace $@wires_pair [expr $find -1] $find]
! 		$x unsubscribe $self; $x delete
! 	}
  	set @wires $wires
- 	foreach x $@wires {$x outside_of_the_box}
  	$self changed
  }
--- 2439,2447 ----
  
  # should be only called from the server
! def Canvas wires= {wires} {
! 	set new  [lwithout $wires $@wires]
  	set dead [lwithout $@wires $wires]
! 	foreach x [lreverse $dead] {$x unsubscribe $self; $x erase} ;# should use delete instead?
  	set @wires $wires
  	$self changed
  }
***************
*** 2504,2511 ****
  	foreach obj $@selection {
  	    foreach wire $_($obj:wires2) {
! 		set find [lsearch $@wires_pair $wire]
! 		if {$find != -1} {
! 			$self disconnect [lindex $@wires_pair [expr $find - 1]]
! 		}
  		$wire delete
  	    }
--- 2460,2465 ----
  	foreach obj $@selection {
  	    foreach wire $_($obj:wires2) {
! 		set find [lsearch $@wires $wire]
! 		if {$find != -1} {$self disconnect $wire}
  		$wire delete
  	    }
***************
*** 2513,2520 ****
  	}
  	foreach x $@selection_wire {
! 	  set find [lsearch $@wires_pair $x]
! 	  if {$find != -1} {
! 	    $self disconnect [lindex $@wires_pair [expr $find - 1]]
! 	  }
  	  $x delete
  	}
--- 2467,2472 ----
  	}
  	foreach x $@selection_wire {
! 	  set find [lsearch $@wires $x]
! 	  if {$find != -1} {$self disconnect $x}
  	  $x delete
  	}
***************
*** 2959,2972 ****
  def Canvas do_paste {offset} {
  	global paste subpatcherize
- 	set @obj_count 0; set @wire_count 0
  	set in 0
! 	#foreach mess [pd_mess_split [$::clipboard value]] {
! 	#	set type [lindex $mess 1]
! 	#	switch $type {connect {} restore {} default {if {$type != ""} {incr paste(count)}}}
! 	#}
  	mset {vx1 vy1 vx2 vy2} [$self visible_rect]
  	mset {xcoords ycoords} [$self clipboard_coords $offset]
  	set visible [$self paste_visible? $vx1 $vy1 $vx2 $vy2 $offset]
- 
  	set ref [lsearch $ycoords [lindex [lsort -increasing $ycoords] 0]]
  	#pd .$self push
--- 2911,2919 ----
  def Canvas do_paste {offset} {
  	global paste subpatcherize
  	set in 0
! 	$self deselect_all
  	mset {vx1 vy1 vx2 vy2} [$self visible_rect]
  	mset {xcoords ycoords} [$self clipboard_coords $offset]
  	set visible [$self paste_visible? $vx1 $vy1 $vx2 $vy2 $offset]
  	set ref [lsearch $ycoords [lindex [lsort -increasing $ycoords] 0]]
  	#pd .$self push
***************
*** 2981,2985 ****
  				set count [llength $@children]
  				set mess2 [list #X connect [expr $from+$count] $outlet [expr $to+$count] $inlet]
! 				if {$in} {netsend $mess} else {netsend $mess2; incr @wire_count}
  			}
  			default {
--- 2928,2932 ----
  				set count [llength $@children]
  				set mess2 [list #X connect [expr $from+$count] $outlet [expr $to+$count] $inlet]
! 				if {$in} {netsend $mess} else {netsend $mess2 [list $self new_wire_select]}
  			}
  			default {
***************
*** 2997,3002 ****
  						set mess2 [lreplace $mess 2 3 $x2 $y2]
  					}
! 					netsend $mess2 [list $self new_object_callback]
! 					incr @obj_count
  				}
  			} 
--- 2944,2948 ----
  						set mess2 [lreplace $mess 2 3 $x2 $y2]
  					}
! 					netsend $mess2 [list $self new_object_select]
  				}
  			} 
***************
*** 3006,3017 ****
  }
  
- def Canvas done_paste {} {
- 	global paste subpatcherize
- 	$self deselect_all
- 	$self selection= [lrange $@children [expr [llength $@children] - $@obj_count] end]
- 	$self selection_wire= [lrange $@wires [expr [llength $@wires] - $@wire_count] end]
- 	set paste(state) 0
- }
- 
  def Canvas cut {} {
  	$@history atomically [list cut] {
--- 2952,2955 ----
***************
*** 3084,3089 ****
  	puts "$@wires_pair"
  	set @keynav_tab_sel "wire"
! 	$self selection_wire-= [lindex $@wires_pair [expr [lsearch $@wires_pair $wire]+1]]
! 	mset {from outlet to inlet} $wire
  	netsend [list .$self disconnect $from $outlet $to $inlet]
  	$@history add [list $self    connect $wire]
--- 3022,3028 ----
  	puts "$@wires_pair"
  	set @keynav_tab_sel "wire"
! 	#$self selection_wire-= [lindex $@wires_pair [expr [lsearch $@wires_pair $wire]+1]]
! 	#mset {from outlet to inlet} $wire
! 	mset {from outlet to inlet} [$wire connects]
  	netsend [list .$self disconnect $from $outlet $to $inlet]
  	$@history add [list $self    connect $wire]
***************
*** 4186,4202 ****
  class_new Wire {View}
  
! def Wire init {canvas from outlet to inlet} {
! 	super
! 	set @connects [list $from $outlet $to $inlet]
! 	set children $_($canvas:children)
  	set @obj1 [lindex $children $from]
  	set @obj2 [lindex $children $to]
- 	set @port1 $outlet
- 	set @port2 $inlet
- 	set @canvas $canvas
  	# associate wires to its connected objects
  	lappend _($@obj1:wires2) $self
  	lappend _($@obj2:wires2) $self
! 	#$self subscribe $canvas
  }
  
--- 4125,4150 ----
  class_new Wire {View}
  
! def Wire canvas= {c} {
! 	super $c
! 	mset {from outlet to inlet} $@connects
! 	set children [$c children]
  	set @obj1 [lindex $children $from]
  	set @obj2 [lindex $children $to]
  	# associate wires to its connected objects
  	lappend _($@obj1:wires2) $self
  	lappend _($@obj2:wires2) $self
! }
! 
! def Wire init {mess} {
! 	super
! 	$self reinit $mess
! }
! 
! def Wire reinit {mess} {
! 	mset {x msg from outlet to inlet canvas} $mess
! 	set @connects [list $from $outlet $to $inlet]
! 	set @port1 $outlet
! 	set @port2 $inlet
! 	$self outside_of_the_box
  }
  
***************
*** 4424,4428 ****
  				set _class [lindex $classinfo($class) 0]
  			} else {
! 				set _class ObjectBox
  			}
  			if {$isnew} {$_class new_as $self $mess} else {$self reinit $mess}
--- 4372,4380 ----
  				set _class [lindex $classinfo($class) 0]
  			} else {
! 				if {[lindex $mess 1] == "connect"} {
! 					set _class Wire
! 				} else {
! 					set _class ObjectBox
! 				}
  			}
  			if {$isnew} {$_class new_as $self $mess} else {$self reinit $mess}





More information about the Pd-cvs mailing list