Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13690
Modified Files: Tag: devel_0_39 desire.tk Log Message:
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.113 retrieving revision 1.1.2.114 diff -C2 -d -r1.1.2.113 -r1.1.2.114 *** desire.tk 8 Nov 2005 13:17:53 -0000 1.1.2.113 --- desire.tk 8 Nov 2005 16:15:58 -0000 1.1.2.114 *************** *** 1317,1335 **** def objectbox unclickedit {args} { puts "$self is being unclicked in edit mode $args" - set x [lindex $args 0] - set y [lindex $args 1] - mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"] - mset {x1 y1 x2 y2} [$id bbox] - set ins 0; set ins [$id ninlets] - if {abs($y1+3-$y)<=3 && $ins} { - set in [expr int(($x-$x1)*$ins/($x2-$x1))] - set @wire_to [list $id $in] - - #mset {x1 y1 x2 y2} [$c bbox ${id}o${out}] - #$c create line [expr ($x1+$x2)/2] [expr ($y1+$y2)/2] $x $y -dash {4 4 4 4} -tags lnew - #set @wire_from [list $self $out] - #set @action wire - #return - } }
--- 1317,1320 ---- *************** *** 1672,1787 **** }
! def canvas unclick {x y b} { ! global font look offset_wire set c .$self.c ! set cx [$c canvasx $x] ! 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]] ! set wire_id l$wire_id ! mset {from outlet_number} $@wire_from ! mset {to inlet_number} $@wire_to ! if {[info exists _($from:o:$outlet_number)]} {lappend _($from:o:$outlet_number) $wire_id} else {set _($from:o:$outlet_number) $wire_id} ! if {[info exists _($to:i:$inlet_number)]} {lappend _($to:i:$inlet_number) $wire_id} else {set _($to:i:$inlet_number) $wire_id} ! #puts "d = $d" ! set offset_wire [expr $offset_wire + 1] ! #propose: _($wire_id) to store sire info ! #maybe don't need this ! set _($wire_id) $d ! wire_update $wire_id $d ! #pd $self add-wire x$@wire_from x$wire_to ! #puts "::::connect from $@wire_from to $wire_to" ! #::::connect from 81168af 2 to 81168ae 0 ! #my wire code -end ! } ! #erase lnew in any case ! set @wire_from {} ! set @wire_to {} ! $c delete lnew ! #return ! } ! if {[llength [$c gettags selrect]] > 0} { ! set coords [$c coords selrect] ! mset {x1 y1} $coords ! set x2 $cx ! set y2 $cy ! set selrect_id [$c find withtag selrect] set selected_elements [$c find overlapping $x1 $y1 $x2 $y2] ! set selrect_index [lsearch $selected_elements $selrect_id] ! set selected_elements [lreplace $selected_elements $selrect_index $selrect_index] ! if {[llength $selected_elements]} { ! set element_tags {} ! foreach item $selected_elements { ! eval lappend element_tags [$c gettags $item] ! } ! #puts "tags in selrect --> $element_tags" ! set ids {} ! set wires {} ! foreach tag $element_tags { ! if {[regexp {^([a-f0-9]{6,8})} $tag id]} {lappend ids $id} ! # this would make things shorter ! # if {[regexp {^l([a-f0-9]{6,8})} [$c gettags $tag] id]} ! #if {[regexp {^l([a-f0-9]{6,8})} $tag wire_id]} {lappend wires $wire_id} ! } ! set selected_objs [lsort -unique $ids] ! foreach obj $selected_objs { ! set i [lsearch $@selection $obj] ! if {$i<0} {lappend @selection $obj} ! } ! #foreach wire $wires { ! # set i [lsearch $@selection_wire $wire] ! # if {$i<0} {lappend @selection_wire $wire} ! #} ! ! set @selection_wire $wires ! ! foreach obj $@selection { ! for {set x 0} {$x<$_($obj:ninlets)} {incr x} { ! if {[info exists _($obj:i:$x)]} { ! foreach wire_id $_($obj: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<$_($obj:noutlets)} {incr x} { ! if {[info exists _($obj:o:$x)]} { ! foreach wire_id $_($obj:o:$x) { ! #wire_update $wire_id $_($wire_id) ! set i [lsearch $@selection_wire $wire_id] ! if {$i<0} {lappend @selection_wire $wire_id} ! } ! } ! } ! } ! foreach obj $@selection {$c itemconfigure ${obj}BASE -outline $look(objectframe4)} ! foreach wire $@selection_wire {$c itemconfigure $wire -fill $look(wirefg2)} ! set @select_by "selrect" ! } { ! #foreach obj $@selection {$c itemconfigure ${obj}BASE -outline $look(objectframe3)} ! #set @selection {} ! } $c delete selrect ! } ! if {[string length $@focus]} { ! set id $@focus ! if {$@editmode} {set event unclickedit} {set event unclick} ! $id $event $cx $cy ! } ! foreach {type id} [$self identify_target $cx $cy -1 -1 "blah "] {} ! switch $@action { edit {set @obj_in_edit $id; $id edit}} ! switch $type { ! object { ! if {$@editmode} {set event unclickedit} {set event unclick} ! $id $event $cx $cy } } $self adjust_scrollbars $self checkgeometry --- 1657,1815 ---- }
! def* canvas unclickedit {x y b} { set c .$self.c ! switch $@action { ! rect { ! puts "sel rect handling code here" ! mset {x1 y1 x2 y2} [$c bbox selrect] ! #if selrect is always at the last stack order, then we don't need to do this ! set selrect_order [$c find withtag selrect] set selected_elements [$c find overlapping $x1 $y1 $x2 $y2] ! set selrect_index [lsearch $selected_elements $selrect_order] ! set selected_elements [lreplace $selected_elements $selrect_index $selrect_index] ! puts "items:$selected_elements" $c delete selrect ! } ! wire { ! $c delete lnew ! mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"] ! mset {x1 y1 x2 y2} [$id bbox] ! set ins 0; set ins [$id ninlets] ! if {abs($y1+3-$y)<=3 && $ins} { ! set in [expr int(($x-$x1)*$ins/($x2-$x1))] ! set @wire_to [list $id $in] ! } ! puts "connect $@wire_from $@wire_to" ! } ! edit { ! #foreach {type id} [$self identify_target $cx $cy -1 -1 "blah "] {} ! mset {type id} [$self identify_target $x $y [expr $x-1] [expr $y-1] "unclick"] ! puts "type:$type id:$id" ! set @obj_in_edit $id ! $id edit ! } } + + } + + def* canvas unclickrun {x y b} { + + } + + def* canvas unclick {x y b} { + if {$@editmode} {$self unclickedit $x $y %b} {$self unclickrun $x $y %b} + global font look offset_wire + set c .$self.c + set cx [$c canvasx $x] + set cy [$c canvasy $y] + # don't remove these codes just yet, thx -chun + # 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]] + # set wire_id l$wire_id + # mset {from outlet_number} $@wire_from + # mset {to inlet_number} $@wire_to + # if {[info exists _($from:o:$outlet_number)]} {lappend _($from:o:$outlet_number) $wire_id} else {set _($from:o:$outlet_number) $wire_id} + # if {[info exists _($to:i:$inlet_number)]} {lappend _($to:i:$inlet_number) $wire_id} else {set _($to:i:$inlet_number) $wire_id} + # #puts "d = $d" + # set offset_wire [expr $offset_wire + 1] + # #propose: _($wire_id) to store sire info + # #maybe don't need this + # set _($wire_id) $d + # wire_update $wire_id $d + # #pd $self add-wire x$@wire_from x$wire_to + # #puts "::::connect from $@wire_from to $wire_to" + # #::::connect from 81168af 2 to 81168ae 0 + # #my wire code -end + # } + # #erase lnew in any case + # set @wire_from {} + # set @wire_to {} + # $c delete lnew + # #return + # } + # if {[llength [$c gettags selrect]] > 0} { + # set coords [$c coords selrect] + # mset {x1 y1} $coords + # set x2 $cx + # set y2 $cy + # set selrect_id [$c find withtag selrect] + # set selected_elements [$c find overlapping $x1 $y1 $x2 $y2] + # set selrect_index [lsearch $selected_elements $selrect_id] + # set selected_elements [lreplace $selected_elements $selrect_index $selrect_index] + # if {[llength $selected_elements]} { + # set element_tags {} + # foreach item $selected_elements { + # eval lappend element_tags [$c gettags $item] + # } + # #puts "tags in selrect --> $element_tags" + # set ids {} + # set wires {} + # foreach tag $element_tags { + # if {[regexp {^([a-f0-9]{6,8})} $tag id]} {lappend ids $id} + # # this would make things shorter + # # if {[regexp {^l([a-f0-9]{6,8})} [$c gettags $tag] id]} + # #if {[regexp {^l([a-f0-9]{6,8})} $tag wire_id]} {lappend wires $wire_id} + # } + # set selected_objs [lsort -unique $ids] + # foreach obj $selected_objs { + # set i [lsearch $@selection $obj] + # if {$i<0} {lappend @selection $obj} + # } + # #foreach wire $wires { + # # set i [lsearch $@selection_wire $wire] + # # if {$i<0} {lappend @selection_wire $wire} + # #} + # + # set @selection_wire $wires + # + # foreach obj $@selection { + # for {set x 0} {$x<$_($obj:ninlets)} {incr x} { + # if {[info exists _($obj:i:$x)]} { + # foreach wire_id $_($obj: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<$_($obj:noutlets)} {incr x} { + # if {[info exists _($obj:o:$x)]} { + # foreach wire_id $_($obj:o:$x) { + # #wire_update $wire_id $_($wire_id) + # set i [lsearch $@selection_wire $wire_id] + # if {$i<0} {lappend @selection_wire $wire_id} + # } + # } + # } + # } + # foreach obj $@selection {$c itemconfigure ${obj}BASE -outline $look(objectframe4)} + # foreach wire $@selection_wire {$c itemconfigure $wire -fill $look(wirefg2)} + # set @select_by "selrect" + # } { + # #foreach obj $@selection {$c itemconfigure ${obj}BASE -outline $look(objectframe3)} + # #set @selection {} + # } + # $c delete selrect + # } + # if {[string length $@focus]} { + # set id $@focus + # if {$@editmode} {set event unclickedit} {set event unclick} + # $id $event $cx $cy + # } + # foreach {type id} [$self identify_target $cx $cy -1 -1 "blah "] {} + # switch $@action { edit {set @obj_in_edit $id; $id edit}} + # switch $type { + # object { + # if {$@editmode} {set event unclickedit} {set event unclick} + # $id $event $cx $cy + # } + # } $self adjust_scrollbars $self checkgeometry