[PD-cvs] pd/src desire.tk,1.1.2.411,1.1.2.412

27 Aug 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6560
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
changed all @scale to @zoom and first implementation of patch scaling
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.411
retrieving revision 1.1.2.412
diff -C2 -d -r1.1.2.411 -r1.1.2.412
*** desire.tk	26 Aug 2006 18:40:03 -0000	1.1.2.411
--- desire.tk	27 Aug 2006 00:15:47 -0000	1.1.2.412
***************
*** 560,564 ****
  set look(Completion:selectfg) #ffffff
! set scale(canned) [list 25 33 50 75 100 125 150 200 250 300 400]
  #-----------------------------------------------------------------------------------#
  set key(Canvas:Object) "Ctrl+1"
--- 560,565 ----
  set look(Completion:selectfg) #ffffff
! set zoom(canned) [list 25 33 50 75 100 125 150 200 250 300 400]
! set scale(amount) 0.1
  #-----------------------------------------------------------------------------------#
  set key(Canvas:Object) "Ctrl+1"
***************
*** 618,621 ****
--- 619,624 ----
  set key(Canvas:incr_zoom) "Ctrl+equal"
  set key(Canvas:decr_zoom) "Ctrl+minus"
+ set key(Canvas:incr_scale) "Ctrl+PLUS"
+ set key(Canvas:decr_scale) "Ctrl+UNDERSCORE"
  set key(Canvas:send_message) "Ctrl+m"
  set key(Canvas:paths) ""
***************
*** 986,990 ****
  }
! def Menuable ctrlkey {key shift} {
      global accels
      set key [if {$shift} {string toupper $key} {string tolower $key}]
--- 989,993 ----
  }
! def* Menuable ctrlkey {key shift} {
      global accels
      set key [if {$shift} {string toupper $key} {string tolower $key}]
***************
*** 1135,1144 ****
    global font
    set c .$@canvas.c
! 	set scale [$@canvas scale]
! 	set coords [lmap * $coords $scale]
    #puts "coords::$coords"
    set find [lsearch $args "-width"]
    if {$find >= 0} {
! 		set new_width [format %.0f [expr [lindex $args [expr $find+1]] * $scale]]
    	set args [lreplace $args [expr $find + 1] [expr $find + 1] $new_width]
    }
--- 1138,1147 ----
    global font
    set c .$@canvas.c
! 	set zoom [$@canvas zoom]
! 	set coords [lmap * $coords $zoom]
    #puts "coords::$coords"
    set find [lsearch $args "-width"]
    if {$find >= 0} {
! 		set new_width [format %.0f [expr [lindex $args [expr $find+1]] * $zoom]]
    	set args [lreplace $args [expr $find + 1] [expr $find + 1] $new_width]
    }
***************
*** 1147,1152 ****
    	set find [lsearch $args "-font"]
    	if {$find >= 0} {
! 			#set new_size [format %.0f [expr $font(size)*$scale]]
! 			set new_size [format %.0f [expr [$self look fontsize]*$scale]]
    		#set s [format $font(str2) $new_size]
    		set s [format [$self look fontstr2] $new_size]
--- 1150,1155 ----
    	set find [lsearch $args "-font"]
    	if {$find >= 0} {
! 			#set new_size [format %.0f [expr $font(size)*$zoom]]
! 			set new_size [format %.0f [expr [$self look fontsize]*$zoom]]
    		#set s [format $font(str2) $new_size]
    		set s [format [$self look fontstr2] $new_size]
***************
*** 1351,1355 ****
      super {#X obj 666 666 pd} ;# bogus
      $self reinit $mess
!     set @scale 1.0 ;# must be a float, not int
      set @action none
      set @selection {}
--- 1354,1358 ----
      super {#X obj 666 666 pd} ;# bogus
      $self reinit $mess
!     set @zoom 1.0 ;# must be a float, not int
      set @action none
      set @selection {}
***************
*** 1532,1537 ****
    	# this should be changed so that we don't need to recompute x,y here.
    	set c .$self.c
! 		set x [expr [$c canvasx [expr [winfo pointerx $c] - [winfo rootx $c]]]/$@scale]
! 		set y [expr [$c canvasy [expr [winfo pointery $c] - [winfo rooty $c]]]/$@scale]
    	set target [$self identify_target $x $y 0]
    	$self show_crosshair $x $y $target
--- 1535,1540 ----
    	# this should be changed so that we don't need to recompute x,y here.
    	set c .$self.c
! 		set x [expr [$c canvasx [expr [winfo pointerx $c] - [winfo rootx $c]]]/$@zoom]
! 		set y [expr [$c canvasy [expr [winfo pointery $c] - [winfo rooty $c]]]/$@zoom]
    	set target [$self identify_target $x $y 0]
    	$self show_crosshair $x $y $target
***************
*** 1551,1556 ****
    $self editmode= 1
    mset {x y} $@curpos
! 	set x1 [expr $x/$@scale]
! 	set y1 [expr $y/$@scale]
    pd .$self $sel $x $y
  }
--- 1554,1559 ----
    $self editmode= 1
    mset {x y} $@curpos
! 	set x1 [expr $x/$@zoom]
! 	set y1 [expr $y/$@zoom]
    pd .$self $sel $x $y
  }
***************
*** 1714,1719 ****
    $self update_size
    #bind Text <Tab> "$self tab; continue"
! 	#set new_size [format %.0f [expr $font(size)*$_($@canvas:scale)]]
! 	set new_size [format %.0f [expr [$self look fontsize]*$_($@canvas:scale)]]
    #set font_str [format $font(str2) $new_size]
    set font_str [format [$self look fontstr2] $new_size]
--- 1717,1722 ----
    $self update_size
    #bind Text <Tab> "$self tab; continue"
! 	#set new_size [format %.0f [expr $font(size)*$_($@canvas:zoom)]]
! 	set new_size [format %.0f [expr [$self look fontsize]*$_($@canvas:zoom)]]
    #set font_str [format $font(str2) $new_size]
    set font_str [format [$self look fontstr2] $new_size]
***************
*** 1756,1760 ****
    if {[llength [.$@canvas.c gettags ${self}TEXT]]} {
    	mset {x1 y1 x2 y2} [.$@canvas.c bbox ${self}TEXT]
! 		set textwidth [expr (($x2 - $x1)/[$@canvas scale])+$padx]
    }
    #if {[llength [.$@canvas.c gettags ${self}text]]} {
--- 1759,1763 ----
    if {[llength [.$@canvas.c gettags ${self}TEXT]]} {
    	mset {x1 y1 x2 y2} [.$@canvas.c bbox ${self}TEXT]
! 		set textwidth [expr (($x2 - $x1)/[$@canvas zoom])+$padx]
    }
    #if {[llength [.$@canvas.c gettags ${self}text]]} {
***************
*** 1762,1766 ****
    	set n [expr [string length [.$@canvas.c.${self}text get 1.0 1.end]] -1]
    	mset {x1 y1 w h} [.$@canvas.c.${self}text bbox 1.$n]
! 		set textwidth [expr ($padx + $x1 + ($w * 2)+$padx+2) / [$@canvas scale]]	
    }
    #}
--- 1765,1769 ----
    	set n [expr [string length [.$@canvas.c.${self}text get 1.0 1.end]] -1]
    	mset {x1 y1 w h} [.$@canvas.c.${self}text bbox 1.$n]
! 		set textwidth [expr ($padx + $x1 + ($w * 2)+$padx+2) / [$@canvas zoom]]	
    }
    #}
***************
*** 1979,1984 ****
    set @x1 [expr $@x1+$dx]
    set @y1 [expr $@y1+$dy]
! 	set scale [$@canvas scale]
! 	#.$@canvas.c move $self [expr $dx*$scale] [expr $dy*$scale]
    $self changed ;# until we find a way to avoid rounding errors on .$@canvas.c move.
    $self draw_wires
--- 1982,1987 ----
    set @x1 [expr $@x1+$dx]
    set @y1 [expr $@y1+$dy]
! 	set zoom [$@canvas zoom]
! 	#.$@canvas.c move $self [expr $dx*$zoom] [expr $dy*$zoom]
    $self changed ;# until we find a way to avoid rounding errors on .$@canvas.c move.
    $self draw_wires
***************
*** 1992,1997 ****
  def Canvas motion_wrap {x y f} {
    set c .$self.c
! 	set x [expr [$c canvasx $x]/$@scale]
! 	set y [expr [$c canvasy $y]/$@scale]
    set target [$self identify_target $x $y $f]
    $self motion $x $y $f $target
--- 1995,2000 ----
  def Canvas motion_wrap {x y f} {
    set c .$self.c
! 	set x [expr [$c canvasx $x]/$@zoom]
! 	set y [expr [$c canvasy $y]/$@zoom]
    set target [$self identify_target $x $y $f]
    $self motion $x $y $f $target
***************
*** 1999,2004 ****
  def Canvas click_wrap {x y b f} {
    set c .$self.c
! 	set x [expr [$c canvasx $x]/$@scale]
! 	set y [expr [$c canvasy $y]/$@scale]
    set f [expr 1<<($b+7)|$f]
    set target [$self identify_target $x $y $f]
--- 2002,2007 ----
  def Canvas click_wrap {x y b f} {
    set c .$self.c
! 	set x [expr [$c canvasx $x]/$@zoom]
! 	set y [expr [$c canvasy $y]/$@zoom]
    set f [expr 1<<($b+7)|$f]
    set target [$self identify_target $x $y $f]
***************
*** 2007,2012 ****
  def Canvas unclick_wrap {x y b f} {
    set c .$self.c
! 	set x [expr [$c canvasx $x]/$@scale]
! 	set y [expr [$c canvasy $y]/$@scale]
    set f [expr 1<<($b+7)|$f]
    set target [$self identify_target $x $y $f]
--- 2010,2015 ----
  def Canvas unclick_wrap {x y b f} {
    set c .$self.c
! 	set x [expr [$c canvasx $x]/$@zoom]
! 	set y [expr [$c canvasy $y]/$@zoom]
    set f [expr 1<<($b+7)|$f]
    set target [$self identify_target $x $y $f]
***************
*** 2015,2023 ****
  def Canvas key_wrap {x y key iso shift} {
    set c .$self.c
! 	$self key [expr [$c canvasx $x]/$@scale] [expr [$c canvasy $y]/$@scale] $key $iso $shift
  }
  def Canvas keyup_wrap {x y key iso shift} {
    set c .$self.c
! 	$self keyup [expr [$c canvasx $x]/$@scale] [expr [$c canvasy $y]/$@scale] $key $iso $shift
  }
--- 2018,2026 ----
  def Canvas key_wrap {x y key iso shift} {
    set c .$self.c
! 	$self key [expr [$c canvasx $x]/$@zoom] [expr [$c canvasy $y]/$@zoom] $key $iso $shift
  }
  def Canvas keyup_wrap {x y key iso shift} {
    set c .$self.c
! 	$self keyup [expr [$c canvasx $x]/$@zoom] [expr [$c canvasy $y]/$@zoom] $key $iso $shift
  }
***************
*** 2111,2116 ****
  def Canvas identify_target {x y f} {
      set c .$self.c
!     set cx [expr $x*$@scale]
!     set cy [expr $y*$@scale]
      set stack [lreverse [$c find overlapping [expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]]]
      foreach tag $stack {
--- 2114,2119 ----
  def Canvas identify_target {x y f} {
      set c .$self.c
!     set cx [expr $x*$@zoom]
!     set cy [expr $y*$@zoom]
      set stack [lreverse [$c find overlapping [expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]]]
      foreach tag $stack {
***************
*** 2169,2173 ****
  def Canvas statusbar_draw {x y} {$@statusbar draw $x $y}
  def Canvas action {} {return $@action}
! def Canvas scale {} {return $@scale}
def StatusBar draw {x y} {
--- 2172,2176 ----
  def Canvas statusbar_draw {x y} {$@statusbar draw $x $y}
  def Canvas action {} {return $@action}
! def Canvas zoom {} {return $@zoom}
def StatusBar draw {x y} {
***************
*** 2175,2181 ****
      set c .$@canvas.c
      set f [$self widget]
!     set scale [$@canvas scale]
!     set x [expr [$c canvasx $x]/$scale]
!     set y [expr [$c canvasy $y]/$scale]
      set tags [$c gettags [lindex [$c find overlapping \
    [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]] end]]
--- 2178,2184 ----
      set c .$@canvas.c
      set f [$self widget]
!     set zoom [$@canvas zoom]
!     set x [expr [$c canvasx $x]/$zoom]
!     set y [expr [$c canvasy $y]/$zoom]
      set tags [$c gettags [lindex [$c find overlapping \
    [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]] end]]
***************
*** 2343,2347 ****
    	set @to ""
    	set @inlet ""
! 		mset {x1 y1 x2 y2} [lmap / [.$@canvas.c bbox ${from}o${port}] [$@canvas scale]]
    }
    inlet {
--- 2346,2350 ----
    	set @to ""
    	set @inlet ""
! 		mset {x1 y1 x2 y2} [lmap / [.$@canvas.c bbox ${from}o${port}] [$@canvas zoom]]
    }
    inlet {
***************
*** 2350,2357 ****
    	set @to $from
    	set @inlet $port
! 		mset {x1 y1 x2 y2} [lmap / [.$@canvas.c bbox ${from}i${port}] [$@canvas scale]]
    }
    }
! 	#mset {x1 y1 x2 y2} [lmap / [.$@canvas.c bbox ${from}o${outlet}] [$@canvas scale]]
    set @x1 [expr ($x1+$x2)/2]
    set @y1 [expr ($y1+$y2)/2]
--- 2353,2360 ----
    	set @to $from
    	set @inlet $port
! 		mset {x1 y1 x2 y2} [lmap / [.$@canvas.c bbox ${from}i${port}] [$@canvas zoom]]
    }
    }
! 	#mset {x1 y1 x2 y2} [lmap / [.$@canvas.c bbox ${from}o${outlet}] [$@canvas zoom]]
    set @x1 [expr ($x1+$x2)/2]
    set @y1 [expr ($y1+$y2)/2]
***************
*** 2408,2412 ****
    set sel {}
    set c .$@canvas.c
! 	mset {x1 y1 x2 y2} [lmap * [list $@x1 $@y1 $@x2 $@y2] [$@canvas scale]]
    set sel [$c find overlapping $x1 $y1 $x2 $y2]
    set selrect_index [lsearch $sel [$c find withtag selrect]]
--- 2411,2415 ----
    set sel {}
    set c .$@canvas.c
! 	mset {x1 y1 x2 y2} [lmap * [list $@x1 $@y1 $@x2 $@y2] [$@canvas zoom]]
    set sel [$c find overlapping $x1 $y1 $x2 $y2]
    set selrect_index [lsearch $sel [$c find withtag selrect]]
***************
*** 2473,2478 ****
    		set obj2 [lindex $@children [lindex $wire 2]]
    		set inlet [lindex $wire 3]
! 			mset {x1 y1 x2 y2} [lmap / [$c bbox ${obj1}o${outlet}] [$@canvas scale]]
! 			mset {x3 y3 x4 y4} [lmap / [$c bbox ${obj2}i${inlet}] [$@canvas scale]]
    		puts "	x3 $x3 y3 $y3 x4 $x4 y4 $y4"
    		set d_outlet [distance [list $x $y] [list [expr ($x1+$x2)/2] [expr ($y1+$y2)/2]]]
--- 2476,2481 ----
    		set obj2 [lindex $@children [lindex $wire 2]]
    		set inlet [lindex $wire 3]
! 			mset {x1 y1 x2 y2} [lmap / [$c bbox ${obj1}o${outlet}] [$@canvas zoom]]
! 			mset {x3 y3 x4 y4} [lmap / [$c bbox ${obj2}i${inlet}] [$@canvas zoom]]
    		puts "	x3 $x3 y3 $y3 x4 $x4 y4 $y4"
    		set d_outlet [distance [list $x $y] [list [expr ($x1+$x2)/2] [expr ($y1+$y2)/2]]]
***************
*** 2752,2756 ****
    	#set _($@selection:ioselect) [lindex $ports $@keynav_iocount]
    	set _($@selection:ioselect) [list [lindex $ports3 $@keynav_iocount] [lindex $ports2 $@keynav_iocount]]
! 		$obj hilite_io [lindex $ports2 $@keynav_iocount] [expr $x/$@scale] [expr $y/$@scale]
    	
    	incr @keynav_iocount
--- 2755,2759 ----
    	#set _($@selection:ioselect) [lindex $ports $@keynav_iocount]
    	set _($@selection:ioselect) [list [lindex $ports3 $@keynav_iocount] [lindex $ports2 $@keynav_iocount]]
! 		$obj hilite_io [lindex $ports2 $@keynav_iocount] [expr $x/$@zoom] [expr $y/$@zoom]
    	
    	incr @keynav_iocount
***************
*** 2775,2793 ****
  }
! def Canvas incr_zoom {} {$self zoom "in"}
! def Canvas decr_zoom {} {$self zoom "out"}
! def Canvas zoom {mode} {
! 	global scale bar
    set spinbox .$self.bbar.scale
    set val [string trimright [$spinbox get] %]
! 	set i [lsearch $scale(canned) $val]
! 	set end [expr [llength $scale(canned)] - 1]
    switch -regexp $mode {
       in|up   {if {$i<$end} {incr i +1}}
      out|down {if {$i>0}    {incr i -1}}
    }
! 	set per [lindex $scale(canned) $i]
    $spinbox set $per%
! 	set @scale [expr $per/100.0] ;# @scale must be float, not int
    $self redraw
  }
--- 2778,2814 ----
  }
! 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))]
! 		}
! 		}
! 	}
! }
! 
! def Canvas incr_zoom {} {$self zooming "in"}
! def Canvas decr_zoom {} {$self zooming "out"}
! def Canvas zooming {mode} {
! 	global zoom bar
    set spinbox .$self.bbar.scale
    set val [string trimright [$spinbox get] %]
! 	set i [lsearch $zoom(canned) $val]
! 	set end [expr [llength $zoom(canned)] - 1]
    switch -regexp $mode {
       in|up   {if {$i<$end} {incr i +1}}
      out|down {if {$i>0}    {incr i -1}}
    }
! 	set per [lindex $zoom(canned) $i]
    $spinbox set $per%
! 	set @zoom [expr $per/100.0] ;# @zoom must be float, not int
    $self redraw
  }
***************
*** 3002,3006 ****
    for {set n 0} {$n<$ports} {incr n} {
    	set tag $self$type$n
! 		set area [lmap / [.$@canvas.c bbox $self$type$n] [$@canvas scale]]
    	set center [expr ([lindex $area 2] + [lindex $area 0]) / 2 ]
    	set dist [expr abs($x - $center)]
--- 3023,3027 ----
    for {set n 0} {$n<$ports} {incr n} {
    	set tag $self$type$n
! 		set area [lmap / [.$@canvas.c bbox $self$type$n] [$@canvas zoom]]
    	set center [expr ([lindex $area 2] + [lindex $area 0]) / 2 ]
    	set dist [expr abs($x - $center)]
***************
*** 3012,3016 ****
    if {$port >= $ports} {set port [expr $ports-1]}
    set p $self$type$port
! 	set hilitebox [lmap * [list -3 -3 +3 +3] [$@canvas scale]]
    set outline [switch $type {i {concat [$self look outletfg]} o {concat [$self look inletfg]}}]
    $c create rectangle [l+ [$c coords $p] $hilitebox] -outline $outline -width 1 -tags ${p}b
--- 3033,3037 ----
    if {$port >= $ports} {set port [expr $ports-1]}
    set p $self$type$port
! 	set hilitebox [lmap * [list -3 -3 +3 +3] [$@canvas zoom]]
    set outline [switch $type {i {concat [$self look outletfg]} o {concat [$self look inletfg]}}]
    $c create rectangle [l+ [$c coords $p] $hilitebox] -outline $outline -width 1 -tags ${p}b
***************
*** 3052,3058 ****
    set port1 $@port1
    set port2 $@port2
! 	set scale [$@canvas scale]
! 	mset {x1 y1 x2 y2} [lmap / [.$@canvas.c bbox ${obj1}o${port1}] $scale]
! 	mset {x3 y3 x4 y4} [lmap / [.$@canvas.c bbox ${obj2}i${port2}] $scale]
    list [expr ($x1+$x2)/2)] [expr ($y1+$y2)/2)] \
         [expr ($x3+$x4)/2)] [expr ($y3+$y4)/2)]
--- 3073,3079 ----
    set port1 $@port1
    set port2 $@port2
! 	set zoom [$@canvas zoom]
! 	mset {x1 y1 x2 y2} [lmap / [.$@canvas.c bbox ${obj1}o${port1}] $zoom]
! 	mset {x3 y3 x4 y4} [lmap / [.$@canvas.c bbox ${obj2}i${port2}] $zoom]
    list [expr ($x1+$x2)/2)] [expr ($y1+$y2)/2)] \
         [expr ($x3+$x4)/2)] [expr ($y3+$y4)/2)]
***************
*** 3067,3073 ****
def* Wire draw {} {
! 	set scale [$@canvas scale]
! 	set bbox1 [lmap / [.$@canvas.c bbox [join [list "$@obj1" o "$@port1"] ""]] $scale]
! 	set bbox2 [lmap / [.$@canvas.c bbox [join [list "$@obj2" i "$@port2"] ""]] $scale]
    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}
--- 3088,3094 ----
def* Wire draw {} {
! 	set zoom [$@canvas zoom]
! 	set bbox1 [lmap / [.$@canvas.c bbox [join [list "$@obj1" o "$@port1"] ""]] $zoom]
! 	set bbox2 [lmap / [.$@canvas.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}
***************
*** 4178,4182 ****
    		-fill [parse_color [lindex $vu_col $i]] -width 0
    }
! 	#if {!$@scale} {return}
    set lfont [list [lindex {courier helvetica times} $@fstyle] $@fs bold]
    set lcolor [parse_color $@lcol]
--- 4199,4203 ----
    		-fill [parse_color [lindex $vu_col $i]] -width 0
    }
! 	#if {!$@zoom} {return}
    set lfont [list [lindex {courier helvetica times} $@fstyle] $@fs bold]
    set lcolor [parse_color $@lcol]
***************
*** 4474,4479 ****
    }
    pack [entry $bb.name -font {courier 10} -width 10 -border 0] -side right
! 	pack [spinbox $bb.scale -width 6 -command "$canvas zoom %d" -state readonly] -side right
! 	$bb.scale set [format %d%% [expr int(100*[$@canvas scale])]]
    $bb.name insert 0 .$@canvas
  }
--- 4495,4500 ----
    }
    pack [entry $bb.name -font {courier 10} -width 10 -border 0] -side right
! 	pack [spinbox $bb.scale -width 6 -command "$canvas zooming %d" -state readonly] -side right
! 	$bb.scale set [format %d%% [expr int(100*[$@canvas zoom])]]
    $bb.name insert 0 .$@canvas
  }
***************
*** 4491,4507 ****
    global crosshair
    set c .$self.c
! 	set width  [expr [winfo  width $c]/$@scale]
! 	set height [expr [winfo height $c]/$@scale]
    mset {x1 y1 x2 y2} [$c cget -scrollregion]
! 	set x1 [expr $x1/$@scale]
! 	set y1 [expr $y1/$@scale]
    mset {vx1 vx2} [$c xview]
    mset {vy1 vy2} [$c yview]
! 	set xoff [expr ([winfo width $c] * $vx1)/$@scale]
! 	set yoff [expr ([winfo height $c] * $vy1)/$@scale]
! 	set vx1 [expr ($x1+($x2-$x1)*$vx1)/$@scale]
! 	set vy1 [expr ($y1+($y2-$y1)*$vy1)/$@scale]
! 	set vx2 [expr ($x1+($x2-$x1)*$vx2)/$@scale]
! 	set vy2 [expr ($y1+($y2-$y1)*$vy2)/$@scale]
    mset {type id detail} $target
    if {[$self look hairsnap]} {
--- 4512,4528 ----
    global crosshair
    set c .$self.c
! 	set width  [expr [winfo  width $c]/$@zoom]
! 	set height [expr [winfo height $c]/$@zoom]
    mset {x1 y1 x2 y2} [$c cget -scrollregion]
! 	set x1 [expr $x1/$@zoom]
! 	set y1 [expr $y1/$@zoom]
    mset {vx1 vx2} [$c xview]
    mset {vy1 vy2} [$c yview]
! 	set xoff [expr ([winfo width $c] * $vx1)/$@zoom]
! 	set yoff [expr ([winfo height $c] * $vy1)/$@zoom]
! 	set vx1 [expr ($x1+($x2-$x1)*$vx1)/$@zoom]
! 	set vy1 [expr ($y1+($y2-$y1)*$vy1)/$@zoom]
! 	set vx2 [expr ($x1+($x2-$x1)*$vx2)/$@zoom]
! 	set vy2 [expr ($y1+($y2-$y1)*$vy2)/$@zoom]
    mset {type id detail} $target
    if {[$self look hairsnap]} {
***************
*** 4529,4544 ****
    global crosshair
    set c .$self.c
! 	set width  [expr [winfo  width $c]/$@scale]
! 	set height [expr [winfo height $c]/$@scale]
    mset {x1 y1 x2 y2} [$c cget -scrollregion]
    
    mset {vx1 vx2} [$c xview]
    mset {vy1 vy2} [$c yview]
! 	#set xoff [expr ([winfo width $c] * $vx1)/$@scale]
! 	#set yoff [expr ([winfo height $c] * $vy1)/$@scale]
! 	set vx1 [expr ($x1+($x2-$x1)*$vx1)/$@scale]
! 	set vy1 [expr ($y1+($y2-$y1)*$vy1)/$@scale]
! 	set vx2 [expr ($x1+($x2-$x1)*$vx2)/$@scale]
! 	set vy2 [expr ($y1+($y2-$y1)*$vy2)/$@scale]
    mset {type id detail} $target
    if {[$self look hairsnap])} {
--- 4550,4565 ----
    global crosshair
    set c .$self.c
! 	set width  [expr [winfo  width $c]/$@zoom]
! 	set height [expr [winfo height $c]/$@zoom]
    mset {x1 y1 x2 y2} [$c cget -scrollregion]
    
    mset {vx1 vx2} [$c xview]
    mset {vy1 vy2} [$c yview]
! 	#set xoff [expr ([winfo width $c] * $vx1)/$@zoom]
! 	#set yoff [expr ([winfo height $c] * $vy1)/$@zoom]
! 	set vx1 [expr ($x1+($x2-$x1)*$vx1)/$@zoom]
! 	set vy1 [expr ($y1+($y2-$y1)*$vy1)/$@zoom]
! 	set vx2 [expr ($x1+($x2-$x1)*$vx2)/$@zoom]
! 	set vy2 [expr ($y1+($y2-$y1)*$vy2)/$@zoom]
    mset {type id detail} $target
    if {[$self look hairsnap])} {
***************
*** 4579,4583 ****
    set x [expr $x+$border+4] ;# huh, why add border twice?
    set c .$self.c
! 	mset {x y} [lmap * [list $x $y] $@scale]
    $c create text $x $y -text $text -anchor w -tags tooltip_fg
    mset {x1 y1 x2 y2} [$c bbox tooltip_fg]
--- 4600,4604 ----
    set x [expr $x+$border+4] ;# huh, why add border twice?
    set c .$self.c
! 	mset {x y} [lmap * [list $x $y] $@zoom]
    $c create text $x $y -text $text -anchor w -tags tooltip_fg
    mset {x1 y1 x2 y2} [$c bbox tooltip_fg]
***************
*** 4728,4732 ****
    }
    #mset {x1 y1 x2 y2} [$textself bbox]
! 	mset {x1 y1 x2 y2} [lmap * [$textself bbox] [$@name scale]]
    set x1 [format %0.f $x1];set y1 [format %0.f $y1]
    set x2 [format %0.f $x2];set y2 [format %0.f $y2]
--- 4749,4753 ----
    }
    #mset {x1 y1 x2 y2} [$textself bbox]
! 	mset {x1 y1 x2 y2} [lmap * [$textself bbox] [$@name zoom]]
    set x1 [format %0.f $x1];set y1 [format %0.f $y1]
    set x2 [format %0.f $x2];set y2 [format %0.f $y2]

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

[PD-cvs] pd/src desire.tk,1.1.2.411,1.1.2.412