[PD-cvs] pd/src desire.tk,1.1.2.448,1.1.2.449
Mathieu Bouchard
matju at users.sourceforge.net
Fri Sep 1 22:50:59 CEST 2006
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 ----
More information about the Pd-cvs
mailing list