pd/src desire.tk,1.1.2.294,1.1.2.295 - Pd-cvs

7 Aug 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12861
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
first commit for the new key bindings for reconneting a wire and multiple connecting from the same outlet to 
inlets. there is quite some repetition of the code here, just tried to get it going first, will test more 
and tidy it up later.
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.294
retrieving revision 1.1.2.295
diff -C2 -d -r1.1.2.294 -r1.1.2.295
*** desire.tk	7 Aug 2006 18:37:11 -0000	1.1.2.294
--- desire.tk	7 Aug 2006 21:42:23 -0000	1.1.2.295
***************
*** 1164,1167 ****
--- 1164,1168 ----
      set @keynav_current 0
      set @keynav_next 0
+     set @shift_wires {}
  }
***************
*** 1232,1236 ****
    $self bind <Shift-MouseWheel> scroll x [expr -abs(%D)/%D]
      }}
!     $self bind <ButtonRelease>     unclick %x %y %b
# keyboard
--- 1233,1238 ----
    $self bind <Shift-MouseWheel> scroll x [expr -abs(%D)/%D]
      }}
!     $self bind <ButtonRelease>     	 unclick %x %y %b 0
!     $self bind <Shift-ButtonRelease>     unclick %x %y %b 1
# keyboard
***************
*** 1252,1255 ****
--- 1254,1258 ----
      $self bind <Shift-Key>  key    %x %y %K %A 1
      $self bind <KeyRelease> keyup  %x %y %K %A 0
+     $self bind <Shift-KeyRelease>  keyup  %x %y %K %A 1
      $self bind <Motion>     motion %x %y 0 %s
      $self bind <Alt-Motion> motion %x %y 4 %s
***************
*** 2191,2214 ****
    switch $type {
      object {
         # handles the dash wire drawing
         mset {x1 y1 x2 y2} [$id bbox]
         set outs 0; set outs [$id noutlets]
         if {$y>=$y2-6 && $outs} {
! 		set out [expr int(($x-$x1)*$outs/($x2-$x1))]
! 		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 -fill [look wiredash]
! 		set @wire_from [list $id $out]
! 		set @action wire
! 		return
    	}
         # clcik on object	
         $id clickedit $x $y $b $f $in_selection $@selection
         	 }
      wire   {
! 	  	#if {$@selection_wire != ""} {$@selection_wire select 0}
! 	  	#set @wire_hilite $id
! 		if {[lsearch $@selection_wire $id] < 0} {set @selection_wire $id}
! 		$id selected?= 1
! 	  	#$id select 1
    	}
      default {error BORK}
--- 2194,2281 ----
    switch $type {
      object {
+ 	     puts "clicked on a object........."
         # handles the dash wire drawing
         mset {x1 y1 x2 y2} [$id bbox]
         set outs 0; set outs [$id noutlets]
+ 	     set ins 0; set ins [$id ninlets]
         if {$y>=$y2-6 && $outs} {
! 	        switch $f {
! 		0 {
! 			set out [expr int(($x-$x1)*$outs/($x2-$x1))]
! 			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 -fill [look wiredash]
! 			set @wire_from [list $id $out]
! 			set @action wire
! 			return
    	}
+ 		1 {
+ 			puts "------------here------------"
+ 			set out [expr int(($x-$x1)*$outs/($x2-$x1))]
+ 			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 -fill [look wiredash]
+ 			set @wire_from [list $id $out]
+ 			if {![llength $@shift_wires]} {set @shift_wires $@wire_from; puts "store::::: $@shift_wires"}
+ 			#set @shift_wires $@wire_from; puts "store::::: $@shift_wires"
+ 			set @action wire
+ 			return
+ 		}
+ 		default {
+ 			puts "......do nothing........"
+ 		}
+ 		}
+ 		}
+ 	     if {$y<$y1+2 && $ins} {
+ 	     	switch $f {
+ 		1 {
+ 			puts "$@shift_wires"
+ 			mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"]
+ 			if {$id != ""} {
+         		mset {x1 y1 x2 y2} [$id bbox]
+         		set ins 0; set ins [$id ninlets]
+         		if {$y<$y1+6 && $ins} {
+ 	  		set in [expr int(($x-$x1)*$ins/($x2-$x1))]
+ 	  		set @wire_to [list $id $in]
+ 	  		mset {from outlet} $@shift_wires
+ 	  		mset {to    inlet} $@wire_to
+ 			puts "shift_wires::: $@shift_wires"
+ 			puts "from::$from outlet::$outlet to::$to inlet::$inlet"
+ 	  		pd .$self connect [lsearch $@children $from] $outlet \
+ 			    [lsearch $@children $to]  $inlet
+ 			}
+ 			return
+ 		}
+ 		}
+ 		default {puts "do nothing....."}
+ 		}
+ 	     }
+ 	     
         # clcik on object	
         $id clickedit $x $y $b $f $in_selection $@selection
         	 }
      wire   {
! 	  	switch $f {
! 		0 {
! 			if {[lsearch $@selection_wire $id] < 0} {set @selection_wire $id}
! 			$id selected?= 1
! 		}
! 		1 {	
! 			set wire [lindex $@wires_pair [expr [lsearch $@wires_pair $id]-1]]
! 			$id delete
! 			pd .$self disconnect $wire
! 			set @wires_pair [lreplace $@wires_pair [lsearch $@wires_pair $id] [lsearch $@wires_pair $id]]
! 		  	set @wires_pair [lreplace $@wires_pair [lsearch $@wires_pair $wire] [lsearch $@wires_pair $wire]]
! 			set obj1 [lindex $@children [lindex $wire 0]]
! 			set outlet [lindex $wire 1]
! 			mset {x1 y1 x2 y2} [$obj1 bbox]
! 			mset {x1 y1 x2 y2} [$c bbox ${obj1}o${outlet}]
! 			$c create line  [expr ($x1+$x2)/2] [expr ($y1+$y2)/2] $x $y -dash {4 4 4 4} -tags lnew -fill [look wiredash]
! 			set @wire_from [list $obj1 $outlet]
! 			if {![llength $@shift_wires]} {set @shift_wires $@wire_from; puts "store::::: $@shift_wires"}s
! 			set @action wire
! 		}
! 		default {
! 			puts "nothing......."
! 		}
! 		}
    	}
      default {error BORK}
***************
*** 2230,2233 ****
--- 2297,2301 ----
      set @click_at [list $x $y]
      if {$@editmode && !($f&2)} {$self clickedit $x $y $b $f; return}
+     #if {$@editmode} {$self clickedit $x $y $b $f; return}
      mset {type id} [$self identify_target $x $y $b $f "click"]
      if {![llength $id]} {return}
***************
*** 2239,2243 ****
  }
! def* Canvas unclickedit {x y b} {
      set c .$self.c
      puts "_____ unclickedit action:$@action "
--- 2307,2311 ----
  }
! def* Canvas unclickedit {x y b f} {
      set c .$self.c
      puts "_____ unclickedit action:$@action "
***************
*** 2290,2309 ****
        }
        wire {
!         $c delete lnew
!         mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"]
! 	if {$id != ""} {
!         mset {x1 y1 x2 y2} [$id bbox]
!         set ins 0; set ins [$id ninlets]
!         if {$y<$y1+6 && $ins} {
! 	  set in [expr int(($x-$x1)*$ins/($x2-$x1))]
! 	  set @wire_to [list $id $in]
! 	  post "wire_from=%s wire_to=%s" $@wire_from $@wire_to
! 	  mset {from outlet} $@wire_from
! 	  mset {to    inlet} $@wire_to
! 	  pd .$self connect [lsearch $@children $from] $outlet \
    		    [lsearch $@children $to]  $inlet
    }
    puts "connect $@wire_from $@wire_to"
    }
        }
        edit {
--- 2358,2399 ----
        }
        wire {
!         switch $f {
! 	0 {
!         	$c delete lnew
!         	mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"]
! 		if {$id != ""} {
!         	mset {x1 y1 x2 y2} [$id bbox]
!         	set ins 0; set ins [$id ninlets]
!         	if {$y<$y1+6 && $ins} {
! 	  	set in [expr int(($x-$x1)*$ins/($x2-$x1))]
! 	  	set @wire_to [list $id $in]
! 	  	post "wire_from=%s wire_to=%s" $@wire_from $@wire_to
! 	  	mset {from outlet} $@wire_from
! 	  	mset {to    inlet} $@wire_to
! 	  	pd .$self connect [lsearch $@children $from] $outlet \
    		    [lsearch $@children $to]  $inlet
    }
    puts "connect $@wire_from $@wire_to"
    }
+ 	}
+ 	1 {
+ 		mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"]
+ 		if {$id != ""} {
+         	mset {x1 y1 x2 y2} [$id bbox]
+         	set ins 0; set ins [$id ninlets]
+         	if {$y<$y1+6 && $ins} {
+ 	  	set in [expr int(($x-$x1)*$ins/($x2-$x1))]
+ 	  	set @wire_to [list $id $in]
+ 	  	post "wire_from=%s wire_to=%s" $@wire_from $@wire_to
+ 	  	mset {from outlet} $@wire_from
+ 	  	mset {to    inlet} $@wire_to
+ 	  	pd .$self connect [lsearch $@children $from] $outlet \
+ 			    [lsearch $@children $to]  $inlet
+ 	}
+ 	puts "connect $@wire_from $@wire_to"
+ 	}
+ 	}
+ 	default {puts "..nothing yet.."}
+ 	}
        }
        edit {
***************
*** 2334,2342 ****
  }
! def* Canvas unclick {x y b} {
      set c .$self.c
      set x [$c canvasx $x]
      set y [$c canvasy $y]
!     if {$@editmode} {$self unclickedit $x $y %b} {$self unclickrun $x $y %b}
      $self adjust_scrollbars
      $self checkgeometry
--- 2424,2432 ----
  }
! def* Canvas unclick {x y b f} {
      set c .$self.c
      set x [$c canvasx $x]
      set y [$c canvasy $y]
!     if {$@editmode} {$self unclickedit $x $y $b $f} {$self unclickrun $x $y %b}
      $self adjust_scrollbars
      $self checkgeometry
***************
*** 2610,2615 ****
  #-----------------------------------------------------------------------------------#
! def Canvas keyup {x y key iso shift} {
      set canvas .$self.c
      if {$iso != ""} {scan $iso %c key}
  #    if {[string length $@focus] > 0} {
--- 2700,2709 ----
  #-----------------------------------------------------------------------------------#
! def* Canvas keyup {x y key iso shift} {
      set canvas .$self.c
+     if {$shift} {
+     if {[llength $@shift_wires]} {set @shift_wires {}; $canvas delete lnew}
+     #$canvas delete lnew
+     }
      if {$iso != ""} {scan $iso %c key}
  #    if {[string length $@focus] > 0} {