pd/src desire.tk,1.1.2.296,1.1.2.297 - Pd-cvs

8 Aug 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2813
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
tidy up the wire code and add more tweaks and comments. also first commit the zoom methods
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.296
retrieving revision 1.1.2.297
diff -C2 -d -r1.1.2.296 -r1.1.2.297
*** desire.tk	7 Aug 2006 21:49:26 -0000	1.1.2.296
--- desire.tk	8 Aug 2006 10:26:39 -0000	1.1.2.297
***************
*** 461,465 ****
  set key(key_nav_right_shift) "Ctrl+RIGHT"
  set key(key_nav_left_shift) "Ctrl+LEFT"
! 
  set accels {}
  foreach k [array names key] {
--- 461,466 ----
  set key(key_nav_right_shift) "Ctrl+RIGHT"
  set key(key_nav_left_shift) "Ctrl+LEFT"
! set key(incr_fontsize) "Ctrl+equal"
! set key(decr_fontsize) "Ctrl+minus"
  set accels {}
  foreach k [array names key] {
***************
*** 2182,2195 ****
    set in_selection [expr [lsearch $@selection $id]>=0]
    
- 	#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
- 	#	set @wire_from [list $id $out]
- 	#	set @action wire
- 	#	return
- 	#}
    switch $type {
      object {
--- 2183,2186 ----
***************
*** 2200,2232 ****
         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 != ""} {
--- 2191,2207 ----
         set ins 0; set ins [$id ninlets]
         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]
! 		#click on a outlet with shift
! 		if {$f == 1} {if {![llength $@shift_wires]} {set @shift_wires $@wire_from; puts "store::::: $@shift_wires"}}
! 		set @action wire
! 		return
! 		} else {
         if {$y<$y1+2 && $ins} {
         	switch $f {
    	1 {
! 			#click on a inlet with shift 
    		mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"]
    		if {$id != ""} {
***************
*** 2238,2243 ****
      		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
--- 2213,2216 ----
***************
*** 2248,2263 ****
    	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
--- 2221,2250 ----
    	default {puts "do nothing....."}
    	}
! 	     } else {
         
! 	     # clcik on object
! 	     # if no previous selection, edit the clicked object
! 	     if {![llength $@selection]} {
! 	     	$id clickedit $x $y $b $f $in_selection $@selection
! 	     } else {
! 	     # otherwise do multiple object selection
! 	     	lappend @selection $id; $id selected?= 1
! 	     } 
! 	     
! 	     
! 	     }
! 	     }
         	 }
      wire   {
      	switch $f {
    	0 {
+ 			#click on a wire without shift
    		if {[lsearch $@selection_wire $id] < 0} {set @selection_wire $id}
    		$id selected?= 1
    	}
! 		1 {
! 			#clcik on a wire with shift
! 			#if clcik on the one already selected wire, reconnect it 
! 			if {[llength $@selection_wire] == 1 && $@selection_wire == $id} {
    		set wire [lindex $@wires_pair [expr [lsearch $@wires_pair $id]-1]]
    		$id delete
***************
*** 2273,2276 ****
--- 2260,2267 ----
    		if {![llength $@shift_wires]} {set @shift_wires $@wire_from; puts "store::::: $@shift_wires"}
    		set @action wire
+ 			} else {
+ 			#else selecting mltiple wires
+ 			if {[lsearch $@selection_wire $id] < 0} {lappend @selection_wire $id;$id selected?= 1}
+ 			}
    	}
    	default {
***************
*** 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 {
--- 2349,2368 ----
        }
        wire {
!       	# if making wire without shift key (delete the dash line)
!         if {!$f} {$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
    }
+       	}
        }
        edit {
***************
*** 2618,2621 ****
--- 2587,2613 ----
  }
+ def* Canvas incr_fontsize {} {$self zoom "in"}
+ def* Canvas decr_fontsize {} {$self zoom "out"}
+ def* Canvas zoom {mode} {
+ 	global font
+ 	switch $mode {
+ 	in {
+ 		incr font(size) 4 
+ 		set font(str) [format -*-courier-medium--normal--%d-* $font(size)]
+ 		set font(width)  [font measure $font(str) W]
+ 		set font(height) [font metrics $font(str) -linespace]
+ 		$self redraw
+ 	}
+ 	out {
+ 		incr font(size) -4 
+ 		set font(str) [format -*-courier-medium--normal--%d-* $font(size)]
+ 		set font(width)  [font measure $font(str) W]
+ 		set font(height) [font metrics $font(str) -linespace]
+ 		$self redraw
+ 	}
+ 	}
+ 
+ }
+ 
  #-----------------------------------------------------------------------------------#
  set lastcanvasconfigured ""