[PD-cvs] pd/src desire.tk,1.1.2.203,1.1.2.204

chunlee chunlee at users.sourceforge.net
Mon May 15 03:51:48 CEST 2006


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

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
some fix to the open file bug


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.203
retrieving revision 1.1.2.204
diff -C2 -d -r1.1.2.203 -r1.1.2.204
*** desire.tk	14 May 2006 12:30:19 -0000	1.1.2.203
--- desire.tk	15 May 2006 01:51:11 -0000	1.1.2.204
***************
*** 1082,1085 ****
--- 1082,1086 ----
      set @wire_to {}
      set @children {}
+     set @unborn {}
      set @obj_in_edit {}
      set @dehighlight {}
***************
*** 1458,1462 ****
  class_new ObjectBox {TextBox}
  
! def ObjectBox init {args} {
  	super
  	global font look
--- 1459,1463 ----
  class_new ObjectBox {TextBox}
  
! def* ObjectBox init {args} {
  	super
  	global font look
***************
*** 1548,1552 ****
  	# think of the children!!!
  	set born [lwithout $children $@children]
! 	foreach x $born {$x   subscribe $self; $x changed; $x canvas= $self}
  	set dead [lwithout $@children $children]
  	foreach x $dead {$x unsubscribe $self; $x erase}
--- 1549,1561 ----
  	# think of the children!!!
  	set born [lwithout $children $@children]
! 	
! 	foreach x $born {
! 	if {[info exists _($x:valid)]} {
! 	$x subscribe $self; $x changed; $x canvas= $self	
! 	} else {
! 	puts "$x not been borned yet...."
! 	set @unborn [lappend @unborn $x]}
! 	}
! 	
  	set dead [lwithout $@children $children]
  	foreach x $dead {$x unsubscribe $self; $x erase}
***************
*** 1580,1587 ****
--- 1589,1598 ----
  	   if { $find == -1} {
  		# new wire!!!
+ 		if {[info exists _($outobj:valid)] & [info exists _($inobj:valid)]} {
  		lappend @wires_pair [list $outobj $outport $inobj $inport]
  		set new_wire [eval [list Wire_new $self $outobj $outport $inobj $inport]]
  		lappend @wires_pair $new_wire		
  		lappend wires $new_wire
+ 		} else {puts "$outobj or $inobj not been born yet....."; set @unborn_wire [lappend @unborn_wire $x]}
  	   } else {
  	    # wire already exist
***************
*** 2248,2251 ****
--- 2259,2263 ----
      # associate wires to its connected objects
      lappend _($@obj1:wires) $self
+ 	puts "_($@obj1:wires) is $_($@obj1:wires)"
      lappend _($@obj2:wires) $self
      # select_by is a hack to get wires remain hilited if selected by serect....
***************
*** 2396,2401 ****
  set classinfo(cnv)     {Cnv}
  
  proc update_object {x d} {
! 	global _ fields classinfo
  	set d [string trimright $d "\n"]
  	set d [string trimright $d ";"]
--- 2408,2417 ----
  set classinfo(cnv)     {Cnv}
  
+ #
+ # a hack to get around the file loading process
+ set canvas(current) ""
+ 
  proc update_object {x d} {
! 	global _ fields classinfo canvas
  	set d [string trimright $d "\n"]
  	set d [string trimright $d ";"]
***************
*** 2403,2409 ****
  	set class [lindex $d $i]
  	switch -- $class {
! 		canvas {set class canvas}
  		obj {set i 4; set class [lindex $d 4]}
  	}
  	if {![info exists _($x:_class)]} {
  		# new object
--- 2419,2426 ----
  	set class [lindex $d $i]
  	switch -- $class {
! 		canvas {set class $class; set canvas(current) $x}
  		obj {set i 4; set class [lindex $d 4]}
  	}
+ 	#puts "canvas -------- $canvas(current)"
  	if {![info exists _($x:_class)]} {
  		# new object
***************
*** 2414,2419 ****
  			set dlength [llength $d]
  			if {$dlength == 4} {
! 			set _($x:isnew) 1
! 			set _($x:text) {}
  			} else {
  			set _($x:isnew) 0
--- 2431,2436 ----
  			set dlength [llength $d]
  			if {$dlength == 4} {
! 				set _($x:isnew) 1
! 				set _($x:text) {}
  			} else {
  			set _($x:isnew) 0
***************
*** 2423,2454 ****
  			set _($x:_class) ObjectBox
  		}
- 		#puts "+++++++ class:$_($x:_class) ++++++"
  		$x init
- 		#puts "_($x:_class)=$_($x:_class)"
- 		#if {[info exists _($x:canvas)]} {
- 			# hack
- 		#	set canvas $_($x:canvas)
- 		#	if {![info exists _($canvas:action)]} {
- 		#	}
- 		#	if {![info exists _($x:cx)]} {
- 		#		set _($x:cx) [lindex $d 2]
- 		#		set _($x:cy) [lindex $d 3]
- 		#	}
- 		#	$x init
- 		#	set _($x:text) [lrange $d $i end]
- 		#	set _($x:valid) 0
- 		#	$x update_size
- 		#	$x draw
- 		#	if {[string length $_($x:text)]==0} {$x edit}
- 		#	set _($_($x:canvas):selection) $x
- 		#}
- 
- 	
- 
  	}
- 	#if {![info exists _($x:cx)]} {
- 	#	set _($x:cx) [lindex $d 2]
- 	#	set _($x:cy) [lindex $d 3]
- 	#}
  	switch -- _($x:_class) {
  	  ObjectBox {
--- 2440,2445 ----
***************
*** 2458,2467 ****
  	  }
  	}
- 	#	$x draw
- 	#	if {[string length $_($x:text)]==0} {$x edit}
- 	#	set _($_($x:canvas):selection) $x
  	if {![info exists fields($class)]} {set class obj}
- 	#puts "${class} $x = $d"
- 	#if {[llength $fields] != [llength $d]} {huh}
  	set i 0
  	foreach f $fields($class) {
--- 2449,2453 ----
***************
*** 2469,2473 ****
--- 2455,2470 ----
  		incr i
  	}
+ 	#-------------------------------------------------------------
+ 	set unborn_child [lsearch $_($canvas(current):unborn) $x]
+ 	if {$unborn_child > -1} {
+ 			$x subscribe $canvas(current)
+ 			$x canvas= $canvas(current)
+ 		if {$unborn_child == [expr [llength $_($canvas(current):unborn)] - 1]} {
+ 			puts "on to the last unborn child........................"
+ 		}
+ 	} 
+ 	#-------------------------------------------------------------
  	$x changed
+ 	
  }
  





More information about the Pd-cvs mailing list