[PD-cvs] pd/src desire.tk,1.1.2.113,1.1.2.114

chunlee chunlee at users.sourceforge.net
Tue Nov 8 17:16:01 CET 2005


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

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.113
retrieving revision 1.1.2.114
diff -C2 -d -r1.1.2.113 -r1.1.2.114
*** desire.tk	8 Nov 2005 13:17:53 -0000	1.1.2.113
--- desire.tk	8 Nov 2005 16:15:58 -0000	1.1.2.114
***************
*** 1317,1335 ****
  def objectbox unclickedit {args} {
  	puts "$self is being unclicked in edit mode $args"
- 	set x [lindex $args 0]
- 	set y [lindex $args 1]
- 	mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"]
- 	mset {x1 y1 x2 y2} [$id bbox]
- 	set ins 0; set ins [$id ninlets]
- 	if {abs($y1+3-$y)<=3 && $ins} {
- 		set in [expr int(($x-$x1)*$ins/($x2-$x1))]
- 		set @wire_to [list $id $in]
- 		
- 		#mset {x1 y1 x2 y2} [$c bbox ${id}o${out}]
- 		#$c create line  [expr ($x1+$x2)/2] [expr ($y1+$y2)/2] $x $y -dash {4 4 4 4} -tags lnew
- 		#set @wire_from [list $self $out]
- 		#set @action wire
- 		#return
- 	}
  }
  
--- 1317,1320 ----
***************
*** 1672,1787 ****
  }
  
! def canvas unclick {x y b} {
!     global font look offset_wire
      set c .$self.c
!     set cx [$c canvasx $x]
!     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]]
! 		set wire_id l$wire_id
! 		mset {from outlet_number} $@wire_from
! 		mset {to    inlet_number} $@wire_to
! 		if {[info exists _($from:o:$outlet_number)]} {lappend _($from:o:$outlet_number) $wire_id} else {set _($from:o:$outlet_number) $wire_id}
! 		if {[info exists _($to:i:$inlet_number)]} {lappend _($to:i:$inlet_number) $wire_id} else {set _($to:i:$inlet_number) $wire_id}
! 		#puts "d = $d"
! 		set offset_wire [expr $offset_wire + 1]
! 		#propose: _($wire_id) to store sire info
! 		#maybe don't need this
! 		set _($wire_id) $d
! 		wire_update $wire_id $d
! 		#pd $self add-wire x$@wire_from x$wire_to
! 		#puts "::::connect from $@wire_from to $wire_to"
! 		#::::connect from 81168af 2 to 81168ae 0
! 		#my wire code -end
! 	}
! 	#erase lnew in any case
! 	set @wire_from {}
! 	set @wire_to {}
! 	$c delete lnew
! 	#return
!     }
!     if {[llength [$c gettags selrect]] > 0} {
!         set coords [$c coords selrect]
! 	mset {x1 y1} $coords
! 	set x2 $cx
! 	set y2 $cy
! 	set selrect_id [$c find withtag selrect]
  	set selected_elements [$c find overlapping $x1 $y1 $x2 $y2]
!         set selrect_index [lsearch $selected_elements $selrect_id]
!         set selected_elements [lreplace $selected_elements $selrect_index $selrect_index]
!         if {[llength $selected_elements]} {
!         	set element_tags {}
!     		foreach item $selected_elements {
! 			eval lappend element_tags [$c gettags $item]
! 		}
! 		#puts "tags in selrect --> $element_tags"
!     		set ids {} 
! 		set wires {}
!     		foreach tag $element_tags {
! 			if {[regexp {^([a-f0-9]{6,8})} $tag id]} {lappend ids $id}
! 			# this would make things shorter		
! 			# if {[regexp {^l([a-f0-9]{6,8})} [$c gettags $tag] id]}
! 			#if {[regexp {^l([a-f0-9]{6,8})} $tag wire_id]} {lappend wires $wire_id}
!     		}
!     		set selected_objs [lsort -unique $ids]
! 		foreach obj $selected_objs {
!     			set i [lsearch $@selection $obj]
!     			if {$i<0} {lappend @selection $obj} 
!     		}
! 		#foreach wire $wires {
!     		#	set i [lsearch $@selection_wire $wire]
!     		#	if {$i<0} {lappend @selection_wire $wire} 
!     		#}
! 		
! 		set @selection_wire $wires
! 		
! 		foreach obj $@selection {
! 			for {set x 0} {$x<$_($obj:ninlets)} {incr x} {
! 				if {[info exists _($obj:i:$x)]} {
! 					foreach wire_id $_($obj: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<$_($obj:noutlets)} {incr x} {
! 				if {[info exists _($obj:o:$x)]} {
! 					foreach wire_id $_($obj:o:$x) {
! 						#wire_update $wire_id $_($wire_id) 
! 						set i [lsearch $@selection_wire $wire_id]
! 						if {$i<0} {lappend @selection_wire $wire_id} 
! 					}
! 				}
! 			}
! 		}
!     		foreach obj  $@selection      {$c itemconfigure ${obj}BASE -outline $look(objectframe4)}
! 		foreach wire $@selection_wire {$c itemconfigure $wire -fill $look(wirefg2)}
!     		set @select_by "selrect"
! 	} {
!       		#foreach obj $@selection {$c itemconfigure ${obj}BASE -outline $look(objectframe3)}
!       		#set @selection {}
! 	}
  	$c delete selrect
!     }
!     if {[string length $@focus]} {
! 	set id $@focus
!         if {$@editmode} {set event unclickedit} {set event unclick}
! 	$id $event $cx $cy
!     }
!     foreach {type id} [$self identify_target $cx $cy -1 -1 "blah "] {}
!     switch $@action { edit {set @obj_in_edit $id; $id edit}}
!     switch $type {
!       object {
!         if {$@editmode} {set event unclickedit} {set event unclick}
! 	$id $event $cx $cy
        }
      }
      $self adjust_scrollbars
      $self checkgeometry
--- 1657,1815 ----
  }
  
! def* canvas unclickedit {x y b} {
      set c .$self.c
!     switch $@action {
!       rect {
!         puts "sel rect handling code here"
! 	mset {x1 y1 x2 y2} [$c bbox selrect]
! 	#if selrect is always at the last stack order, then we don't need to do this
! 	set selrect_order [$c find withtag selrect]
  	set selected_elements [$c find overlapping $x1 $y1 $x2 $y2]
! 	set selrect_index [lsearch $selected_elements $selrect_order]
! 	set selected_elements [lreplace $selected_elements $selrect_index $selrect_index]
! 	puts "items:$selected_elements"
  	$c delete selrect
!       }
!       wire {
!         $c delete lnew
!         mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"]
!         mset {x1 y1 x2 y2} [$id bbox]
!         set ins 0; set ins [$id ninlets]
!         if {abs($y1+3-$y)<=3 && $ins} {
! 	  set in [expr int(($x-$x1)*$ins/($x2-$x1))]
! 	  set @wire_to [list $id $in]
! 	  }
! 	puts "connect $@wire_from $@wire_to"
!       }
!       edit {
!         #foreach {type id} [$self identify_target $cx $cy -1 -1 "blah "] {}
!         mset {type id} [$self identify_target $x $y [expr $x-1] [expr $y-1] "unclick"]
!         puts "type:$type id:$id"
!         set @obj_in_edit $id
!         $id edit
!       
        }
      }
+ 
+ }
+ 
+ def* canvas unclickrun {x y b} {
+ 
+ }
+ 
+ def* canvas unclick {x y b} {
+     if {$@editmode} {$self unclickedit $x $y %b} {$self unclickrun $x $y %b}
+     global font look offset_wire
+     set c .$self.c
+     set cx [$c canvasx $x]
+     set cy [$c canvasy $y]
+ # don't remove these codes just yet, thx -chun
+ #    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]]
+ #		set wire_id l$wire_id
+ #		mset {from outlet_number} $@wire_from
+ #		mset {to    inlet_number} $@wire_to
+ #		if {[info exists _($from:o:$outlet_number)]} {lappend _($from:o:$outlet_number) $wire_id} else {set _($from:o:$outlet_number) $wire_id}
+ #		if {[info exists _($to:i:$inlet_number)]} {lappend _($to:i:$inlet_number) $wire_id} else {set _($to:i:$inlet_number) $wire_id}
+ #		#puts "d = $d"
+ #		set offset_wire [expr $offset_wire + 1]
+ #		#propose: _($wire_id) to store sire info
+ #		#maybe don't need this
+ #		set _($wire_id) $d
+ #		wire_update $wire_id $d
+ #		#pd $self add-wire x$@wire_from x$wire_to
+ #		#puts "::::connect from $@wire_from to $wire_to"
+ #		#::::connect from 81168af 2 to 81168ae 0
+ #		#my wire code -end
+ #	}
+ #	#erase lnew in any case
+ #	set @wire_from {}
+ #	set @wire_to {}
+ #	$c delete lnew
+ #	#return
+ #   }
+ #    if {[llength [$c gettags selrect]] > 0} {
+ #        set coords [$c coords selrect]
+ #	mset {x1 y1} $coords
+ #	set x2 $cx
+ #	set y2 $cy
+ #	set selrect_id [$c find withtag selrect]
+ #	set selected_elements [$c find overlapping $x1 $y1 $x2 $y2]
+ #        set selrect_index [lsearch $selected_elements $selrect_id]
+ #        set selected_elements [lreplace $selected_elements $selrect_index $selrect_index]
+ #        if {[llength $selected_elements]} {
+ #        	set element_tags {}
+ #    		foreach item $selected_elements {
+ #			eval lappend element_tags [$c gettags $item]
+ #		}
+ #		#puts "tags in selrect --> $element_tags"
+ #    		set ids {} 
+ #		set wires {}
+ #    		foreach tag $element_tags {
+ #			if {[regexp {^([a-f0-9]{6,8})} $tag id]} {lappend ids $id}
+ #			# this would make things shorter		
+ #			# if {[regexp {^l([a-f0-9]{6,8})} [$c gettags $tag] id]}
+ #			#if {[regexp {^l([a-f0-9]{6,8})} $tag wire_id]} {lappend wires $wire_id}
+ #    		}
+ #    		set selected_objs [lsort -unique $ids]
+ #		foreach obj $selected_objs {
+ #    			set i [lsearch $@selection $obj]
+ #    			if {$i<0} {lappend @selection $obj} 
+ #    		}
+ #		#foreach wire $wires {
+ #    		#	set i [lsearch $@selection_wire $wire]
+ #    		#	if {$i<0} {lappend @selection_wire $wire} 
+ #    		#}
+ #		
+ #		set @selection_wire $wires
+ #		
+ #		foreach obj $@selection {
+ #			for {set x 0} {$x<$_($obj:ninlets)} {incr x} {
+ #				if {[info exists _($obj:i:$x)]} {
+ #					foreach wire_id $_($obj: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<$_($obj:noutlets)} {incr x} {
+ #				if {[info exists _($obj:o:$x)]} {
+ #					foreach wire_id $_($obj:o:$x) {
+ #						#wire_update $wire_id $_($wire_id) 
+ #						set i [lsearch $@selection_wire $wire_id]
+ #						if {$i<0} {lappend @selection_wire $wire_id} 
+ #					}
+ #				}
+ #			}
+ #		}
+ #    		foreach obj  $@selection      {$c itemconfigure ${obj}BASE -outline $look(objectframe4)}
+ #		foreach wire $@selection_wire {$c itemconfigure $wire -fill $look(wirefg2)}
+ #    		set @select_by "selrect"
+ #	} {
+ #      		#foreach obj $@selection {$c itemconfigure ${obj}BASE -outline $look(objectframe3)}
+ #      		#set @selection {}
+ #	}
+ #	$c delete selrect
+ #    }
+ #    if {[string length $@focus]} {
+ #	set id $@focus
+ #        if {$@editmode} {set event unclickedit} {set event unclick}
+ #	$id $event $cx $cy
+ #    }
+ #    foreach {type id} [$self identify_target $cx $cy -1 -1 "blah "] {}
+ #    switch $@action { edit {set @obj_in_edit $id; $id edit}}
+ #    switch $type {
+ #      object {
+ #        if {$@editmode} {set event unclickedit} {set event unclick}
+ #	$id $event $cx $cy
+ #      }
+ #    }
      $self adjust_scrollbars
      $self checkgeometry





More information about the Pd-cvs mailing list