pd/src desire.tk,1.1.2.500,1.1.2.501 - Pd-cvs

14 Oct 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23788
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
fix on canvas scale and added scaling on selection only
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.500
retrieving revision 1.1.2.501
diff -C2 -d -r1.1.2.500 -r1.1.2.501
*** desire.tk	13 Oct 2006 21:27:36 -0000	1.1.2.500
--- desire.tk	13 Oct 2006 22:22:48 -0000	1.1.2.501
***************
*** 3050,3066 ****
  def Canvas incr_scale {} {$self scale "out"}
  def Canvas decr_scale {} {$self scale "in"}
  def Canvas scale {mode} {
    global scale
! 	foreach children $@children {
! 		puts "	[$children xy]"
! 		mset {x y} [$children xy]
! 		switch $mode {
! 		out {
! 		pd .$self object_moveto !$children [expr $x * (1+$scale(amount))] [expr $y * (1+$scale(amount))]
! 		}
! 		in {
! 		pd .$self object_moveto !$children [expr $x * (1-$scale(amount))] [expr $y * (1-$scale(amount))]
    	}
    	}
    }
  }
--- 3050,3100 ----
  def Canvas incr_scale {} {$self scale "out"}
  def Canvas decr_scale {} {$self scale "in"}
+ 
  def Canvas scale {mode} {
    global scale
! 	if {[llength $@selection]} {
! 		foreach children $@selection {
! 			mset {x y} [$children xy]
! 			switch $mode {
! 				out {
! 					set x1 [expr $x*(1+$scale(amount))]
! 					set y1 [expr $y*(1+$scale(amount))]
! 					$children position= [list $x1 $y1]
! 					$children changed
! 					pd .$self object_moveto !$children $x1 $y1
! 				}
! 				in {
! 					set x1 [expr $x*(1-$scale(amount))]
! 					set y1 [expr $y*(1-$scale(amount))]
! 					$children position= [list $x1 $y1]
! 					$children changed
! 					pd .$self object_moveto !$children $x1 $y1
! 				}
! 			}
    	}
+ 
+ 		foreach children $@selection { $self changed_wires}
+ 		
+ 	} else {
+ 		foreach children $@children {
+ 			mset {x y} [$children xy]
+ 			switch $mode {
+ 				out {
+ 					set x1 [expr $x*(1+$scale(amount))]
+ 					set y1 [expr $y*(1+$scale(amount))]
+ 					$children position= [list $x1 $y1]
+ 					$children changed
+ 					pd .$self object_moveto !$children $x1 $y1
+ 				}
+ 				in {
+ 					set x1 [expr $x*(1-$scale(amount))]
+ 					set y1 [expr $y*(1-$scale(amount))]
+ 					$children position= [list $x1 $y1]
+ 					$children changed
+ 					pd .$self object_moveto !$children $x1 $y1
+ 				}
+ 			}
    	}
+ 		foreach children $@children { $self changed_wires}
    }
  }
***************
*** 3221,3229 ****
  def Box connect_in {} {}
! def Box draw {} {
! 	#set text "[$@canvas index $self]: "
! 	#$self item ID text [$self xy] -fill [$self look fg] -anchor ne -text $text
! 	$self draw_box
! }
  def Box draw_box {} {}
  def Box edit {} {}
--- 3255,3259 ----
  def Box connect_in {} {}
! def Box draw {} {$self draw_box}
  def Box draw_box {} {}
  def Box edit {} {}
***************
*** 3386,3395 ****
    set zoom [$@canvas zoom]
    set c [$@canvas widget]
    set bbox1 [lmap / [$c bbox [join [list $@obj1 o $@port1] ""]] $zoom]
! 	set bbox2 [lmap / [$c bbox [join [list $@obj2 i $@port2] ""]] $zoom]
    if {[llength $bbox1] < 4} {puts stderr "wire_draw: crap outlet $@obj1 [$@obj1 deconstruct]"; return}
    if {[llength $bbox2] < 4} {puts stderr "wire_draw: crap inlet  $@obj2 [$@obj2 deconstruct]"; return}
! 	mset {x1 y1} [l/2 [l+ [lrange $bbox1 0 1] [lrange $bbox1 2 3]]]
! 	mset {x2 y2} [l/2 [l+ [lrange $bbox2 0 1] [lrange $bbox2 2 3]]]
    set xys [list $x1 $y1 $x2 $y2]
    set length [expr sqrt(pow($x2-$x1,2)+pow($y2-$y1,2))]
--- 3416,3434 ----
    set zoom [$@canvas zoom]
    set c [$@canvas widget]
+ 	#set bbox1 [list ]
    set bbox1 [lmap / [$c bbox [join [list $@obj1 o $@port1] ""]] $zoom]
!         set bbox2 [lmap / [$c bbox [join [list $@obj2 i $@port2] ""]] $zoom]
! 	set bbox1 [$@obj1 bbox]
    if {[llength $bbox1] < 4} {puts stderr "wire_draw: crap outlet $@obj1 [$@obj1 deconstruct]"; return}
    if {[llength $bbox2] < 4} {puts stderr "wire_draw: crap inlet  $@obj2 [$@obj2 deconstruct]"; return}
! 	set iowidth [$@obj1 look iowidth]
! 	mset {ox1 oy1 ox2 oy2} [$@obj1 bbox]
! 	set x1 [expr ($iowidth / 2) + ($iowidth * $@port1) + $ox1]
! 	set y1 [expr $oy1 + $_($@obj1:ys)]
! 	mset {ix1 iy1 ix2 iy2} [$@obj2 bbox]
! 	set x2 [expr ($iowidth / 2) + ($iowidth * $@port2) + $ix1]
! 	set y2 $iy1
! 	#mset {x1 y1} [l/2 [l+ [lrange $bbox1 0 1] [lrange $bbox1 2 3]]]
! 	#mset {x2 y2} [l/2 [l+ [lrange $bbox2 0 1] [lrange $bbox2 2 3]]]
    set xys [list $x1 $y1 $x2 $y2]
    set length [expr sqrt(pow($x2-$x1,2)+pow($y2-$y1,2))]