Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8032
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
basic zooming works now, still need some tweaking.....
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.308
retrieving revision 1.1.2.309
diff -C2 -d -r1.1.2.308 -r1.1.2.309
*** desire.tk 9 Aug 2006 14:43:45 -0000 1.1.2.308
--- desire.tk 10 Aug 2006 01:38:24 -0000 1.1.2.309
***************
*** 187,191 ****
# but really, we should look at "man 3tcl trace" instead.
! class new Variable {Observable Thing}
def Variable init {value} {super; set @value $value; $self changed}
--- 187,191 ----
# but really, we should look at "man 3tcl trace" instead.
! class_new Variable {Observable Thing}
def Variable init {value} {super; set @value $value; $self changed}
***************
*** 826,829 ****
--- 826,830 ----
#-----------------------------------------------------------------------------------#
set font(size) 12
+ set font(str2) "-*-courier-medium--normal--%d-*"
set font(str) [format -*-courier-medium--normal--%d-* $font(size)]
set font(width) [font measure $font(str) W]
***************
*** 924,932 ****
def* View item {suffix type coords args} {
set c .$(a)canvas.c
set ss $self$suffix
if {![llength [$c gettags $ss]]} {
eval [concat [list $c create $type $coords -tags "$ss $self"] $args]
- #eval [concat [list $c create $type $coords -tags $ss] $args]
} {
eval [concat [list $c itemconfigure $ss] $args]
--- 925,956 ----
def* View item {suffix type coords args} {
+ global font
set c .$(a)canvas.c
set ss $self$suffix
+
+ if {$suffix != "WIRE"} {
+ for {set i 0} {$i < [llength $coords]} {incr i} {
+ set val [expr [lindex $coords $i]*$_($@canvas:scale)]
+ set coords [lreplace $coords $i $i $val]
+ }
+ }
+
+
+ #if {$suffix != "WIRE"} {
+ set find [lsearch $args "-width"]
+ if {$find >= 0} {
+ set new_width [format %.0f [expr [lindex $args [expr $find+1]] * $_($@canvas:scale)]]
+ set args [lreplace $args [expr $find + 1] [expr $find + 1] $new_width]
+ }
+ #}
+
+ if {$type == "text"} {
+ set find [lsearch $args "-font"]
+ set new_size [format %.0f [expr $font(size)*$_($@canvas:scale)]]
+ set args [lreplace $args [expr $find + 1] [expr $find + 1] [format $font(str2) $new_size]]
+ }
+
if {![llength [$c gettags $ss]]} {
eval [concat [list $c create $type $coords -tags "$ss $self"] $args]
} {
eval [concat [list $c itemconfigure $ss] $args]
***************
*** 964,967 ****
--- 988,994 ----
set cy $@y1
return [list $cx $cy]
+ puts "cx --> $cx || cy --> $cy"
+ #puts "[expr $cx * $_($@canvas:scale)] ||| [expr $cy * $_($@canvas:scale)]"
+ #return [list [expr $cx * $_($@canvas:scale)] [expr $cy * $_($@canvas:scale)]]
}
***************
*** 1187,1190 ****
--- 1214,1218 ----
set @keynav_next 0
set @shift_wires {}
+ set @scale 1
}
***************
*** 1433,1445 ****
set c .$(a)canvas.c
for {set i 0} {$i<$n} {incr i} {
! set onset [expr $x1 + ($xs-[look iowidth]) * $i / $nplus]
! set points [list [expr $onset] $y [expr $onset+[look iowidth]] [expr $y+1]]
! # will update this code when proc item deals with mult.tags
! if {[llength [$c gettags $self$which$i]] != 0} {
! $c coords ${self}$which$i $points
! } {
! $c create rectangle $points -tags "$self$which $self$which$i $self" \
! -outline [switch $which { i {concat [look inletfg]} o {concat [look outletfg]}}]
! }
}
}
--- 1461,1477 ----
set c .$(a)canvas.c
for {set i 0} {$i<$n} {incr i} {
! set onset [expr $x1 + ($xs-([look iowidth]*$_($@canvas:scale))) * $i / $nplus]
! set points [list [expr $onset] [expr $y-1] [expr $onset+([look iowidth]*$_($@canvas:scale))] [expr $y+(1*$_($@canvas:scale))]]
! #will update this code when proc item deals with mult.tags
! #if {[llength [$c gettags $self$which$i]] != 0} {
! # $c coords ${self}$which$i $points
! #} {
! # $c create rectangle $points -tags "$self$which $self$which$i $self" \
! # -outline [switch $which { i {concat [look inletfg]} o {concat [look outletfg]}}]
! #}
!
! switch $which { i {set color [look inletfg]} o {set color [look outletfg]}}
! $self item $which$i rectangle $points -outline $color -fill $color -tags "$self$which $self$which$i $self"
!
}
}
***************
*** 1493,1497 ****
set t .$(a)canvas.c.${self}text
if {[info exists @isnew]} {set @isnew 0}
- # set propose .$(a)canvas.c.${self}propose ;# label completion
set @edit 1
set @tab_repeats 0
--- 1525,1528 ----
***************
*** 1499,1512 ****
set @selected? 1
.$(a)canvas.c delete ${self}TEXT
- # set @oldtext $@text
$self update_size
- # $self changed
- # text $propose -height 1 -width [expr [string length $@text]+1] -relief flat \
- # -bg $look(objectbg) -borderwidth 0 -highlightthickness 0\
- # -font $font(str) -fg red ;# label completion
bind Text <Tab> "$self tab; continue"
text $t -height 1 -width [expr [string length $@text]+1] -relief flat \
-bg [.$(a)canvas.c itemcget ${self}BASE -fill] -borderwidth 0 -highlightthickness 0\
! -font $font(str) -fg [look objectfg]
bind $t <Key> "$self key %W %x %y %K %A 0"
bind $t <Control-Return> "$self key %W %x %y 10 %A 0"
--- 1530,1540 ----
set @selected? 1
.$(a)canvas.c delete ${self}TEXT
$self update_size
bind Text <Tab> "$self tab; continue"
+ set new_size [format %.0f [expr $font(size)*$_($@canvas:scale)]]
+ set font_str [format $font(str2) $new_size]
text $t -height 1 -width [expr [string length $@text]+1] -relief flat \
-bg [.$(a)canvas.c itemcget ${self}BASE -fill] -borderwidth 0 -highlightthickness 0\
! -font $font_str -fg [look objectfg]
bind $t <Key> "$self key %W %x %y %K %A 0"
bind $t <Control-Return> "$self key %W %x %y 10 %A 0"
***************
*** 1521,1526 ****
# -window $propose -anchor nw -tags "${self}propose $self" -height $font(height)
#---------------------------------------
! .$(a)canvas.c create window [expr $cx+2] [expr $cy+2] \
! -window $t -anchor nw -tags "${self}text $self"
#$self draw
$t configure -pady 0 -padx 1
--- 1549,1558 ----
# -window $propose -anchor nw -tags "${self}propose $self" -height $font(height)
#---------------------------------------
! #.$(a)canvas.c create window [expr $cx+2] [expr $cy+2] \
! # -window $t -anchor nw -tags "${self}text $self"
!
! $self item text window [list [expr $cx+2] [expr $cy+2]] -window $t -anchor nw -tags "${self}text $self"
!
!
#$self draw
$t configure -pady 0 -padx 1
***************
*** 1572,1581 ****
global font
set textwidth [expr $font(padx)+$font(width)*([string length $@text]+$@edit)]
! set topwidth [expr (2* $@ninlets-1) * [look iowidth]]
! set bottomwidth [expr (2*$@noutlets-1) * [look iowidth]]
set @xs [max [look minobjwidth] [max $bottomwidth [max $topwidth $textwidth]]]
set @ys [expr $font(pady)+$font(height)]
}
#-----------------------------------------------------------------------------------
--- 1604,1629 ----
global font
set textwidth [expr $font(padx)+$font(width)*([string length $@text]+$@edit)]
! set topwidth [expr (2* $@ninlets-1) * ([look iowidth]*$_($@canvas:scale))]
! set bottomwidth [expr (2*$@noutlets-1) * ([look iowidth]*$_($@canvas:scale))]
set @xs [max [look minobjwidth] [max $bottomwidth [max $topwidth $textwidth]]]
set @ys [expr $font(pady)+$font(height)]
}
+ def TextBox update_size2 {} {
+ global font
+ set scale $_($@canvas:scale)
+ set font_width [expr $font(width) * $scale]
+ #set font_padx [expr $font(padx) * $scale]
+ #set font_pady [expr $font(pady) * $scale]
+ set font_padx $font(padx)
+ set font_pady $font(pady)
+ set font_height [expr $font(height) * $scale]
+ set textwidth [expr $font_padx+$font_width*([string length $@text]+$@edit)]
+ set topwidth [expr (2* $@ninlets-1) * [expr [look iowidth]*$scale]]
+ set bottomwidth [expr (2*$@noutlets-1) * [expr [look iowidth]*$scale]]
+ set @xs [max [expr [look minobjwidth]*$scale] [max $bottomwidth [max $topwidth $textwidth]]]
+ set @ys [expr ($font_pady+$font_height)]
+ }
+
#-----------------------------------------------------------------------------------
***************
*** 1605,1611 ****
set xyb [l+ [list $x2 $y1 $x1 $y1 $x1 $y2] [list -1 +1 +1 +1 +1 -1]]
set xyc [l+ [list $x2 $y1 $x2 $y2 $x1 $y2] [list -1 +1 -1 -1 +1 -1]]
! $self item BASE rectangle $xya -fill [look objectbg]
! $self item BASE1 line $xyb -fill [look objectframe1]
! $self item BASE2 line $xyc -fill [look objectframe2]
}
--- 1653,1659 ----
set xyb [l+ [list $x2 $y1 $x1 $y1 $x1 $y2] [list -1 +1 +1 +1 +1 -1]]
set xyc [l+ [list $x2 $y1 $x2 $y2 $x1 $y2] [list -1 +1 -1 -1 +1 -1]]
! $self item BASE rectangle $xya -fill [look objectbg] -width 1
! $self item BASE1 line $xyb -fill [look objectframe1] -width 1
! $self item BASE2 line $xyc -fill [look objectframe2] -width 1
}
***************
*** 1804,1811 ****
def View move {dx dy} {
mset {x y} [$self xy]
! set @x1 [expr $@x1+$dx]
! set @y1 [expr $@y1+$dy]
! mset {u v} [$self xy]
! .$(a)canvas.c move $self [expr $u-$x] [expr $v-$y]
$self draw_wires
}
--- 1852,1862 ----
def View move {dx dy} {
mset {x y} [$self xy]
! set dx2 [expr $dx / $_($@canvas:scale)]
! set dy2 [expr $dy / $_($@canvas:scale)]
! set @x1 [expr $@x1+$dx2]
! set @y1 [expr $@y1+$dy2]
! #mset {u v} [$self xy]
! #.$(a)canvas.c move $self [expr $u-$x] [expr $v-$y]
! .$(a)canvas.c move $self $dx $dy
$self draw_wires
}
***************
*** 1813,1823 ****
def View draw_wires {} {foreach wire $@wires {$wire draw}}
- # kill this please
- def* Canvas undomove {objs} {
- foreach obj $objs {
- pd .$self object_moveto !$obj $_($obj:orig_x) $_($obj:orig_y)
- }
- }
-
def* View set_orig_xy {x y} {
set @orig_x $x
--- 1864,1867 ----
***************
*** 1858,1862 ****
switch $@action {
move {
- puts "selection:::: $@selection"
mset {ox oy} $oldpos
foreach obj $@selection {$obj move [expr $x-$ox] [expr $y-$oy]}
--- 1902,1905 ----
***************
*** 1886,1891 ****
if {$@editmode && [llength [$id bbox]]} {
mset {x1 y1 x2 y2} [$id bbox]
! #post %s "y=$y y1=$y1 y2=$y2"
! if {$y<$y1+2} {
set port [$id hilite_io i $x $y]
if {$port==""} return
--- 1929,1938 ----
if {$@editmode && [llength [$id bbox]]} {
mset {x1 y1 x2 y2} [$id bbox]
! set x1 [expr $x1 * $@scale]
! set y1 [expr $y1 * $@scale]
! set x2 [expr $x2 * $@scale]
! set y2 [expr $y2 * $@scale]
! set var [expr 2*$@scale]
! if {$y<[expr $y1+2]} {
set port [$id hilite_io i $x $y]
if {$port==""} return
***************
*** 1894,1898 ****
return
}
! if {$y>=$y2-2} {
set port [$id hilite_io o $x $y]
if {$port==""} return
--- 1941,1945 ----
return
}
! if {$y>=[expr $y2-2]} {
set port [$id hilite_io o $x $y]
if {$port==""} return
***************
*** 2211,2214 ****
--- 2258,2265 ----
# handles the dash wire drawing
mset {x1 y1 x2 y2} [$id bbox]
+ set x1 [expr $x1 * $@scale]
+ set y1 [expr $y1 * $@scale]
+ set x2 [expr $x2 * $@scale]
+ set y2 [expr $y2 * $@scale]
set outs 0; set outs [$id noutlets]
set ins 0; set ins [$id ninlets]
***************
*** 2375,2381 ****
# 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} {
--- 2426,2442 ----
# if making wire without shift key (delete the dash line)
if {!$f} {$c delete lnew}
! set x1 [expr $x/$_($@canvas:scale)]
! set y1 [expr $y/$_($@canvas:scale)]
! set x2 [expr $x1 - 1]
! set y2 [expr $y1 - 1]
! #mset {type id} [$@canvas identify_target $x1 $y1 $x2 $y2s "unclick"]
! mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"]
! puts "type:: $type ||| id:: $id"
if {$id != ""} {
mset {x1 y1 x2 y2} [$id bbox]
+ set x1 [expr $x1 * $@scale]
+ set y1 [expr $y1 * $@scale]
+ set x2 [expr $x2 * $@scale]
+ set y2 [expr $y2 * $@scale]
set ins 0; set ins [$id ninlets]
if {$y<$y1+6 && $ins} {
***************
*** 2594,2621 ****
def* Canvas decr_fontsize {} {$self zoom "out"}
def* Canvas zoom {mode} {
-
-
- #puts "coords:::: $coords"
- #for {set i 0} {$i < [llength $coords]} {incr i} {
- # set val [expr [lindex $coords $i]*2]
- # puts "[lindex $coords $i] ::: $val"
- # set coords [lreplace $coords $i $i $val]
- #}
- #puts "coords::::: $coords"
-
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
}
--- 2655,2675 ----
def* Canvas decr_fontsize {} {$self zoom "out"}
def* Canvas zoom {mode} {
global font
switch $mode {
in {
! set @scale [expr $@scale + 0.5]
! #foreach object $@children {
! #mset {x1 y1 x2 y2} [$object bbox]
! #pd .$self object_moveto !$object [expr $x1*$@scale] [expr $y1*$@scale]
! #}
$self redraw
}
out {
!
! set @scale [expr $@scale - 0.5]
! #foreach object $@children {
! #mset {x1 y1 x2 y2} [$object bbox]
! #pd .$self object_moveto !$object [expr $x1*$@scale] [expr $y1*$@scale]
! #}
$self redraw
}
***************
*** 2739,2742 ****
--- 2793,2806 ----
mset {x y} [$self xy]
list $x $y [expr $x+$@xs] [expr $y+$@ys]
+
+ #mset {x y} [$self xy]
+ #set xs [expr $@xs * $_($@canvas:scale)]
+ #set ys [expr $@ys * $_($@canvas:scale)]
+ #set x1 [expr $x * $_($@canvas:scale)]
+ #set y1 [expr $y * $_($@canvas:scale)]
+ #set x2 [expr $x1 + $xs]
+ #set y2 [expr $y1 + $ys]
+ #puts " x1==$x1 y1==$y1 x2==$x2 y2==$y2"
+ #list $x1 $y1 $x2 $y2
}
***************
*** 2790,2793 ****
--- 2854,2859 ----
set tag $self$type$n
set area [.$(a)canvas.c bbox $self$type$n]
+ puts "tag -----------> $tag"
+ puts "area ----------> $area"
set center [expr ([lindex $area 2] + [lindex $area 0]) / 2 ]
set dist [expr abs($x - $center)]
***************
*** 3018,3021 ****
--- 3084,3088 ----
if {$isnew} {$_class new_as $self}
$self position= [lrange $mess 2 3]
+ $self canvas= $canvas(current)
$self ninlets= $ninlets
$self noutlets= $noutlets
***************
*** 3134,3138 ****
}
! def* MessageBox draw_box {} {
mset {x1 y1} [$self xy]
set x2 [expr $x1+$@xs]
--- 3201,3205 ----
}
! def MessageBox draw_box {} {
mset {x1 y1} [$self xy]
set x2 [expr $x1+$@xs]
***************
*** 3141,3145 ****
[expr $x2+4] $y2 $x1 $y2 $x2 $y2 $x1 $y2]
if {[$self selected?]} {set frcol [look selectframe]} {set frcol [look objectframe3]}
! $self item BASE polygon $points -fill [look objectbg] -outline $frcol
}
--- 3208,3212 ----
[expr $x2+4] $y2 $x1 $y2 $x2 $y2 $x1 $y2]
if {[$self selected?]} {set frcol [look selectframe]} {set frcol [look objectframe3]}
! $self item BASE polygon $points -fill [look objectbg] -outline $frcol -width 1
}
