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
