[PD-cvs] pd/src desire.tk,1.1.2.411,1.1.2.412
chunlee
chunlee at users.sourceforge.net
Sun Aug 27 02:15:49 CEST 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]
More information about the Pd-cvs
mailing list