Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2038
Modified Files: Tag: devel_0_39 desire.tk Log Message: adding more bugs.
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.448 retrieving revision 1.1.2.449 diff -C2 -d -r1.1.2.448 -r1.1.2.449 *** desire.tk 1 Sep 2006 19:41:30 -0000 1.1.2.448 --- desire.tk 1 Sep 2006 20:50:56 -0000 1.1.2.449 *************** *** 38,42 **** package require objective
! #if {[catch {source profdd.tcl}]} {error_dump} if {[file exists debug.tcl]} { source debug.tcl --- 38,42 ---- package require objective
! if {[catch {source profdd.tcl}]} {error_dump} if {[file exists debug.tcl]} { source debug.tcl *************** *** 1263,1267 **** set @focus "" set @curpos {30 30} - set @select_by "" set @bbox {0 0 100 100} set @children {} --- 1263,1266 ---- *************** *** 1443,1450 **** --- 1442,1451 ---- $self bind <Map> map $self bind <Unmap> unmap + $self bind <Leave> leave }
def Canvas map {} {} def Canvas unmap {} {} + def Canvas leave {} {$@crosshair erase}
def Canvas scroll {axis diff} { *************** *** 1750,1760 ****
def ObjectBox draw_box {} { ! global font super set xya [$self bbox] ! mset {x1 y1 x2 y2} $xya 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 [$self look bg] -outline [$self look frame1] -width 1 #$self item BASE1 line $xyb -fill [$self look frame1] -width 1 #$self item BASE2 line $xyc -fill [$self look frame2] -width 1 --- 1751,1762 ----
def ObjectBox draw_box {} { ! global font super set xya [$self bbox] ! mset {x1 y1 x2 y2} $xya 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]] ! if {[$self selected?]} {set fg [$self look selectframe]} {set fg [$self look frame3]} ! $self item BASE rectangle $xya -fill [$self look bg] -outline $fg -width 1 #$self item BASE1 line $xyb -fill [$self look frame1] -width 1 #$self item BASE2 line $xyc -fill [$self look frame2] -width 1 *************** *** 1765,1776 **** super $self draw_io ! if {[$self selected?]} {set frcol [$self look selectframe]} {set frcol [$self look frame3]} ! set c [$@canvas widget] ! $c itemconfigure ${self}BASE -outline $frcol -dash [if {$@valid} {list 8 8 8 8} {list}] #this is here to allow editing the newly created objectbox if {$@isnew} {$self edit} ;# why this here ? - #catch {$c raise ${self}TEXT $self} ;# shouldn't this be in $self edit ? - #this is here to redraw the connected wires after the objectbox is drawn/updated - $self draw_wires ;# why this here ? }
--- 1767,1775 ---- super $self draw_io ! #set c [$@canvas widget] ! #if {$@valid} {set dash {8 8 8 8}} {set dash {}} ;# isn't this backwards? ! #$c itemconfigure ${self}BASE -dash $dash #this is here to allow editing the newly created objectbox if {$@isnew} {$self edit} ;# why this here ? }
*************** *** 1799,1803 **** def ObjectBox unedit {} { super ! $self erase ;# (why?) }
--- 1798,1802 ---- def ObjectBox unedit {} { super ! $self erase ;# (why?) }
*************** *** 1932,1946 **** def View position= {xy1} {mset [list @x1 @y1] $xy1}
- #!@#$ contains Box-specific code. - def View move {dx dy} { - mset {x y} [$self xy] - set @x1 [expr $@x1+$dx] - set @y1 [expr $@y1+$dy] - set zoom [$@canvas zoom] - #[$@canvas widget] move $self [expr $dx*$zoom] [expr $dy*$zoom] - $self changed ;# until we find a way to avoid rounding errors on [$@canvas widget] move. - $self draw_wires - } - def View set_orig_xy {x y} { set @orig_x $x --- 1931,1934 ---- *************** *** 2276,2280 **** #foreach wire $@selection_wire {$wire selected?= 0} #} - set @select_by "" }
--- 2264,2267 ---- *************** *** 2429,2433 **** $@canvas selection_wire+= $wires } - set _($@canvas:select_by) "selrect" set _($@canvas:keynav_tab_sel) "wire" $@canvas end_action --- 2416,2419 ---- *************** *** 2827,2831 **** foreach o $@selection { mset {x1 y1} [$o xy] ! $o moveto [expr $x1+$dx] [expr $y1+$dy] } } --- 2813,2821 ---- foreach o $@selection { mset {x1 y1} [$o xy] ! if {[[$o _class] inherit? Box]} { ! $o moveto [expr $x1+$dx] [expr $y1+$dy] ! } else { ! puts "selection_move: $o is not a Box, it's a [$o class]" ! } } } *************** *** 2939,2944 **** }
! ! def Box draw_wires {} {foreach wire $@wires {$wire draw}}
def Box delete_wire {wire} { --- 2929,2933 ---- }
! def Box changed_wires {} {foreach wire $@wires {$wire changed}}
def Box delete_wire {wire} { *************** *** 2948,2953 ****
def Box move {dx dy} { ! super $dx $dy ! #$self draw_wires }
--- 2937,2947 ----
def Box move {dx dy} { ! mset {x y} [$self xy] ! set @x1 [expr $@x1+$dx] ! set @y1 [expr $@y1+$dy] ! set zoom [$@canvas zoom] ! #[$@canvas widget] move $self [expr $dx*$zoom] [expr $dy*$zoom] ! $self changed ;# until we find a way to avoid rounding errors on [$@canvas widget] move. ! $self changed_wires }
*************** *** 3044,3049 **** lappend _($@obj1:wires) $self lappend _($@obj2:wires) $self - # select_by is a hack to get wires remain hilited if selected by serect.... - set @select_by "" #$self subscribe $canvas } --- 3038,3041 ---- *************** *** 3080,3085 **** 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} --- 3072,3077 ---- 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} *************** *** 3382,3386 **** $self item BASE3 line $xyc -fill [darker $color] $self draw_io - $self draw_wires }
--- 3374,3377 ----
-
Mathieu Bouchard