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 ----