[PD-cvs] pd/src desire.tk,1.1.2.77,1.1.2.78
Mathieu Bouchard
matju at users.sourceforge.net
Fri Sep 23 16:32:12 CEST 2005
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31661
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
added new_as, super, view move, objectbox move, etc
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.77
retrieving revision 1.1.2.78
diff -C2 -d -r1.1.2.77 -r1.1.2.78
*** desire.tk 23 Sep 2005 12:36:59 -0000 1.1.2.77
--- desire.tk 23 Sep 2005 14:32:09 -0000 1.1.2.78
***************
*** 37,40 ****
--- 37,45 ----
eval [concat [list \$self init] \$args]
"
+ proc ${self}_new_as {self args} "
+ global _
+ set _(\$self:_class) $self
+ eval [concat [list \$self init] \$args]
+ "
}
***************
*** 86,90 ****
set name [lindex $methods $i]
#puts "proc name of $self $selector is $name"
! set r [uplevel 1 [concat [list $name $self] [lrange $args 2 end]]]
#puts "!!! /unknown $args"
return $r
--- 91,95 ----
set name [lindex $methods $i]
#puts "proc name of $self $selector is $name"
! set r [eval [concat [list $name $self] [lrange $args 2 end]]]
#puts "!!! /unknown $args"
return $r
***************
*** 93,97 ****
# this one is broken (n'ajustez pas votre appareil)
proc super {args} {
! upvar 2 methods methods self self i oi
set i [expr 1+$oi]
puts "!!! super #$i"
--- 98,106 ----
# this one is broken (n'ajustez pas votre appareil)
proc super {args} {
! uplevel 0 {catch {puts "0: [info locals]"}}
! uplevel 1 {catch {puts "1: [info locals]"}}
! uplevel 2 {catch {puts "2: [info locals]"}}
! uplevel 3 {catch {puts "3: [info locals]"}}
! upvar 2 methods methods self self selector selector i oi
set i [expr 1+$oi]
puts "!!! super #$i"
***************
*** 99,103 ****
set name [lindex $methods $i]
puts "proc name of $self $selector is $name"
! set r [uplevel 1 [concat [list $name $self] $args]]
}
--- 108,112 ----
set name [lindex $methods $i]
puts "proc name of $self $selector is $name"
! set r [eval [concat [list $name $self] $args]]
}
***************
*** 726,731 ****
global _
set self [c2self $name]
! set _($self:_class) canvas
! $self init $width $height $geometry $editable
}
--- 735,739 ----
global _
set self [c2self $name]
! canvas_new_as $self $width $height $geometry $editable
}
***************
*** 734,737 ****
--- 742,746 ----
global pd_opendir pd_tearoff OS cmdline canvasmenu focus
set name .x$self
+ set c .x$self.c
set focus(canvas) $self
set _(focus) $self
***************
*** 740,746 ****
pack [make_button_bar $name.bbar $name] -side top -fill x -expand no
pack [statusbar_new $self] -side bottom -fill x
! pack [scrollbar $name.xscroll -command "$name.c xview" -orient horizontal] -side bottom -fill x
! pack [scrollbar $name.yscroll -command "$name.c yview"] -side right -fill y
! pack [canvas $name.c -width $width -height $height -background white \
-yscrollcommand "$name.yscroll set" \
-xscrollcommand "$name.xscroll set" \
--- 749,755 ----
pack [make_button_bar $name.bbar $name] -side top -fill x -expand no
pack [statusbar_new $self] -side bottom -fill x
! pack [scrollbar $name.xscroll -command "$c xview" -orient horizontal] -side bottom -fill x
! pack [scrollbar $name.yscroll -command "$c yview"] -side right -fill y
! pack [canvas $c -width $width -height $height -background white \
-yscrollcommand "$name.yscroll set" \
-xscrollcommand "$name.xscroll set" \
***************
*** 751,761 ****
menu $name.popup -tearoff false
populate_menu $name.popup $name {
! {"Properties" {popup_properties [canvastosym %W]} ""}
! {"Open" {popup_open [canvastosym %W]} ""}
! {"Help" {popup_help [canvastosym %W]} ""}
}
wm protocol $name WM_DELETE_WINDOW "menu_close $name"
$self new_binds
! focus $name.c
$self editmode $editable
set @action none
--- 760,770 ----
menu $name.popup -tearoff false
populate_menu $name.popup $name {
! {"Properties" {popup_properties [c2self %W]} ""}
! {"Open" {popup_open [c2self %W]} ""}
! {"Help" {popup_help [c2self %W]} ""}
}
wm protocol $name WM_DELETE_WINDOW "menu_close $name"
$self new_binds
! focus $c
$self editmode $editable
set @action none
***************
*** 770,773 ****
--- 779,783 ----
set @wire_from {}
set @wire_to {}
+ set @children {}
}
***************
*** 1173,1178 ****
after 1 "destroy $t"
set l {}
! foreach c [split $@text ""] {lappend l [scan $c %c]}
pd ".x$canvas text_setto !$self $l ;"
}
--- 1183,1189 ----
after 1 "destroy $t"
set l {}
! foreach char [split $@text ""] {lappend l [scan $char %c]}
pd ".x$canvas text_setto !$self $l ;"
+ eval "focus $c"
}
***************
*** 1185,1203 ****
for {set x 0} {$x<$@ninlets} {incr x} {
if {[info exists _($self:i:$x)]} {
! foreach wire_id $_($self:i:$x) {
! wire_update $wire_id $_($wire_id)
! #set i [lsearch $@selection_wire $wire_id]
! #if {$i<0} {lappend @selection_wire $wire_id}
! }
}
}
for {set x 0} {$x<$@noutlets} {incr x} {
if {[info exists _($self:o:$x)]} {
! foreach wire_id $_($self:o:$x) {
! wire_update $wire_id $_($wire_id)
! #set i [lsearch $@selection_wire $wire_id]
! #if {$i<0} {lappend @selection_wire $wire_id}
! }
! }
}
text_new $canvas $self [expr $@cx+2] [expr $@cy+2] \
--- 1196,1206 ----
for {set x 0} {$x<$@ninlets} {incr x} {
if {[info exists _($self:i:$x)]} {
! foreach wire_id $_($self:i:$x) {wire_update $wire_id $_($wire_id)}
}
}
for {set x 0} {$x<$@noutlets} {incr x} {
if {[info exists _($self:o:$x)]} {
! foreach wire_id $_($self:o:$x) {wire_update $wire_id $_($wire_id)}
! }
}
text_new $canvas $self [expr $@cx+2] [expr $@cy+2] \
***************
*** 1231,1240 ****
#}
! #def objectbox move {args} {
! # set @cx [expr $@cx+[lindex $args 0]]
! # set @cy [expr $@cy+[lindex $args 1]]
! # $self draw $self $_($self:canvas)
! # $self draw $_($self:canvas)
! #}
#-----------------------------------------------------------------------------------#
--- 1234,1252 ----
#}
! def objectbox draw_wires {canvas} {
! for {set x 0} {$x<$@ninlets} {incr x} {
! set v $self:i:$x
! if {[info exists _($v)]} {foreach wire $_($v) {$wire draw $self}}
! }
! for {set x 0} {$x<$@noutlets} {incr x} {
! set v $self:o:$x
! if {[info exists _($v)]} {foreach wire $_($v) {$wire draw $self}}
! }
! }
!
! def objectbox move {canvas dx dy} {
! super $canvas $dx $dy
! $self draw_wires $canvas
! }
#-----------------------------------------------------------------------------------#
***************
*** 1260,1272 ****
set @cy [expr $@cy+$dy]
.x$@canvas.c move $self $dx $dy
- #$self draw
- for {set x 0} {$x<$@ninlets} {incr x} {
- set v $self:i:$x
- if {[info exists _($v)]} {foreach wire $_($v) {$wire draw $self}}
- }
- for {set x 0} {$x<$@noutlets} {incr x} {
- set v $self:o:$x
- if {[info exists _($v)]} {foreach wire $_($v) {$wire draw $self}}
- }
}
--- 1272,1275 ----
***************
*** 1421,1433 ****
}
#-----------------------------------------------------------------------------------#
# this proc is too long, should be cut in several parts --matju
# agree, but could i do this a bit later? --chun
- def objectbox bbox {} {
- list $@cx $@cy [expr $@cx+$@xs] [expr $@cy+$@ys]
-
- }
-
def* canvas click_on_object {x y b f id} {
global look
--- 1424,1433 ----
}
+ def objectbox bbox {} {list $@cx $@cy [expr $@cx+$@xs] [expr $@cy+$@ys]}
+
#-----------------------------------------------------------------------------------#
# this proc is too long, should be cut in several parts --matju
# agree, but could i do this a bit later? --chun
def* canvas click_on_object {x y b f id} {
global look
***************
*** 1544,1549 ****
focus $c
set @action rect
! $c create line $x $y $x $y $x $y $x $y $x $y -tags selrect
! $c itemconfigure selrect -dash {3 3 3 3}
}
}
--- 1544,1548 ----
focus $c
set @action rect
! $c create line $x $y $x $y $x $y $x $y $x $y -tags {selrect1 selrect} -fill black -dash {3 3 3 3} -dashoffset 3
}
}
***************
*** 1557,1570 ****
set cy [$c canvasy $y]
if {[llength $@wire_from]} {
! if {[llength $wire_to]} {
! #puts "wire reachs inlet, draw proper wire!!"
set d $@wire_from
foreach item $wire_to {lappend d $item}
#add a last 0 for wire_update, not sure what's for....
lappend d 0
- #my wire code --chun
- #$_($id:noutlets) -> number of outlets an object has
- #propose: _(obj_id:flag:port_number) -> list of connections an particular in/outlet has
-
#tmp only, generates id for wires
set wire_id l[format %x [expr 0x80f8ea8 - $offset_wire]]
--- 1556,1564 ----
set cy [$c canvasy $y]
if {[llength $@wire_from]} {
! if {[llength $@wire_to]} {
set d $@wire_from
foreach item $wire_to {lappend d $item}
#add a last 0 for wire_update, not sure what's for....
lappend d 0
#tmp only, generates id for wires
set wire_id l[format %x [expr 0x80f8ea8 - $offset_wire]]
***************
*** 1639,1644 ****
foreach obj $@selection {
for {set x 0} {$x<$_($obj:ninlets)} {incr x} {
- #if {[info exists]}
- #puts "check -> $obj"
if {[info exists _($obj:i:$x)]} {
foreach wire_id $_($obj:i:$x) {
--- 1633,1636 ----
More information about the Pd-cvs
mailing list