[PD-cvs] pd/src desire.tk,1.1.2.55,1.1.2.56
Mathieu Bouchard
matju at users.sourceforge.net
Wed Sep 14 12:09:50 CEST 2005
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4733
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
stuff'n'stuff
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.55
retrieving revision 1.1.2.56
diff -C2 -d -r1.1.2.55 -r1.1.2.56
*** desire.tk 14 Sep 2005 09:49:17 -0000 1.1.2.55
--- desire.tk 14 Sep 2005 10:09:48 -0000 1.1.2.56
***************
*** 728,736 ****
set current_x 0
set current_y 0
- set tooltip(mx) -1000
- set tooltip(my) -1000
- set tooltip(canvas) foo
- set tooltip(visible) 0
- set tooltip(text) ""
set dehighlight {}
set wire_from {}
--- 728,731 ----
***************
*** 882,886 ****
#-----------------------------------------------------------------------------------#
! proc pdtk_canvas_new {name width height geometry editable} {
global _
set self [c2self $name]
--- 877,881 ----
#-----------------------------------------------------------------------------------#
! proc* pdtk_canvas_new {name width height geometry editable} {
global _
set self [c2self $name]
***************
*** 1371,1375 ****
if {$tooltip(visible)} {
if {[expr pow($tooltip(mx)-$cx,2) + pow($tooltip(my)-$cy,2) > 100]} {
! hide_canvas_tooltip $tooltip(canvas)
}
}
--- 1366,1370 ----
if {$tooltip(visible)} {
if {[expr pow($tooltip(mx)-$cx,2) + pow($tooltip(my)-$cy,2) > 100]} {
! $tooltip(canvas) hide_tooltip
}
}
***************
*** 1531,1542 ****
def statusbar update {x y} {
global _ cmdline
! set canvas .x$self.c
set bar .x$self.stat
! set cx [$canvas canvasx $x]
! set cy [$canvas canvasy $y]
$bar.pos configure -text "($cx,$cy)"
! set tags [$canvas gettags [lindex [$canvas find overlapping \
[expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]] end]]
! foreach {type id} [identify_target $canvas $cx $cy -1 -1 "click"] {}
switch $type {
object {
--- 1526,1537 ----
def statusbar update {x y} {
global _ cmdline
! set c .x$self.c
set bar .x$self.stat
! set cx [$c canvasx $x]
! set cy [$c canvasy $y]
$bar.pos configure -text "($cx,$cy)"
! set tags [$c gettags [lindex [$c find overlapping \
[expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]] end]]
! foreach {type id} [identify_target $self $cx $cy -1 -1 "click"] {}
switch $type {
object {
***************
*** 1560,1573 ****
def canvas click {x y b f} {
! global _ wire_from rightclick_object OS select_area mouse font look
! puts "canvas_click2::: $self $x $y $b $f"
! set canvas .x$self.c
! set cx [$canvas canvasx $x]
! set cy [$canvas canvasy $y]
set edit 0; switch $@mode { edit { set edit 1 } }
set select_area(x1) $x
set select_area(y1) $y
set mouse(b1down) 1
! foreach {type id} [identify_target $canvas $cx $cy $b $f "click"] {}
switch $type {
object {
--- 1555,1567 ----
def canvas click {x y b f} {
! global wire_from rightclick_object OS select_area mouse font look
! set c .x$self.c
! set cx [$c canvasx $x]
! set cy [$c canvasy $y]
set edit 0; switch $@mode { edit { set edit 1 } }
set select_area(x1) $x
set select_area(y1) $y
set mouse(b1down) 1
! foreach {type id} [identify_target $self $cx $cy $b $f "click"] {}
switch $type {
object {
***************
*** 1579,1589 ****
if {$run} {
#puts "click click click"
! if {$_($id:class) == "bang"} {bang_bang $id $canvas}
! event $id clickevent $canvas $cx $cy $b $f} {
! event $id clickeditevent $canvas $cx $cy $b $f
}
}
! if {!($f&8) && $edit && [llength [$canvas bbox ${id}BASE]]} {
! foreach {x1 y1 x2 y2} [$canvas bbox ${id}BASE] {}
if {abs($y2-3-$cy)<=3} {
set outs 0
--- 1573,1583 ----
if {$run} {
#puts "click click click"
! if {$_($id:class) == "bang"} {bang_bang $id $c}
! event $id clickevent $c $cx $cy $b $f} {
! event $id clickeditevent $c $cx $cy $b $f
}
}
! if {!($f&8) && $edit && [llength [$c bbox ${id}BASE]]} {
! foreach {x1 y1 x2 y2} [$c bbox ${id}BASE] {}
if {abs($y2-3-$cy)<=3} {
set outs 0
***************
*** 1591,1604 ****
if {$outs} {
set out [expr int(($cx-$x1)*$outs/($x2-$x1))]
! foreach {ox1 oy1 ox2 oy2} [$canvas bbox ${id}o${out}] {}
! wire_draw lnew $canvas 1 $cx $cy $cx $cy
! $canvas itemconfigure lnew -dash {4 4 4 4}
set wire_from [list $id $out]
return
}
}
- # selection
set already [expr [lsearch $@selection $id]>=0]
- #mine begins --chun
#if selection only contains one object and has already been selected,
#allow it to turn into edit mode.
--- 1585,1596 ----
if {$outs} {
set out [expr int(($cx-$x1)*$outs/($x2-$x1))]
! foreach {ox1 oy1 ox2 oy2} [$c bbox ${id}o${out}] {}
! wire_draw lnew $c 1 $cx $cy $cx $cy
! $c itemconfigure lnew -dash {4 4 4 4}
set wire_from [list $id $out]
return
}
}
set already [expr [lsearch $@selection $id]>=0]
#if selection only contains one object and has already been selected,
#allow it to turn into edit mode.
***************
*** 1608,1624 ****
}
}
- #mine ends --chun
if {($f&1) && !$already} {
pd "$self select-object x$id ;"
- #puts "___shift click___"
} elseif {!$already} {
- #pd "$self deselect-all ; $self select-object x$id ;"
- #puts "___select this object --> $id"
- # my click select object code begins --chun
#switch $_($id:class) {
#bang {
#puts "clicked on bang :: editable = $edit"
! #bang_bang $id $canvas
#}
--- 1600,1611 ----
}
}
if {($f&1) && !$already} {
pd "$self select-object x$id ;"
} elseif {!$already} {
#switch $_($id:class) {
#bang {
#puts "clicked on bang :: editable = $edit"
! #bang_bang $id $c
#}
***************
*** 1630,1642 ****
set old_obj [lindex $@selection 0]
if {$@select_by == "click"} {
! objectbox_complete $old_obj $canvas
}
set @obj_in_edit 0
}
- #de-hilight
if {[llength $@selection] > 0} {
- #puts "dehightlight all!!!!!"
foreach obj $@selection {
! $canvas itemconfigure ${obj}BASE -outline $look(objectframe3)
}
#set @selection {}
--- 1617,1627 ----
set old_obj [lindex $@selection 0]
if {$@select_by == "click"} {
! objectbox_complete $old_obj $c
}
set @obj_in_edit 0
}
if {[llength $@selection] > 0} {
foreach obj $@selection {
! $c itemconfigure ${obj}BASE -outline $look(objectframe3)
}
#set @selection {}
***************
*** 1644,1657 ****
set @selection {}
set @selection [linsert $@selection 0 $id]
- #puts "@selection --> $@selection"
foreach obj $@selection {
! #puts "${obj}BASE :: $canvas"
! $canvas itemconfigure ${obj}BASE -outline $look(objectframe4)
}
set @select_by "click"
#}
#}
- # my click select object code ends
-
}
set @action move
--- 1629,1638 ----
set @selection {}
set @selection [linsert $@selection 0 $id]
foreach obj $@selection {
! $c itemconfigure ${obj}BASE -outline $look(objectframe4)
}
set @select_by "click"
#}
#}
}
set @action move
***************
*** 1662,1667 ****
#puts "RIGHTCLICK WIRE"
}
- # my wire click select --chun
- #pd "[canvastosym $canvas] click-on-wire $id $cx $cy $b $f;"
puts "click on wire"
#$canvas create line $xys -tags $self -width $thick \
--- 1643,1646 ----
***************
*** 1678,1682 ****
if {[info exists @obj_in_edit]} {
if {$@obj_in_edit > 0} {
! objectbox_complete [lindex $@selection 0] $canvas
set @obj_in_edit 0
}
--- 1657,1661 ----
if {[info exists @obj_in_edit]} {
if {$@obj_in_edit > 0} {
! [lindex $@selection 0] complete $self
set @obj_in_edit 0
}
***************
*** 1684,1688 ****
if {[llength $@selection] > 0} {
foreach obj $@selection {
! $canvas itemconfigure ${obj}BASE -outline $look(objectframe3)
}
set @selection {}
--- 1663,1667 ----
if {[llength $@selection] > 0} {
foreach obj $@selection {
! $c itemconfigure ${obj}BASE -outline $look(objectframe3)
}
set @selection {}
***************
*** 1690,1702 ****
if {[llength $@selection_wire] > 0} {
foreach wire $@selection_wire {
! $canvas itemconfigure $wire -fill $look(wirefg)
}
set @selection_wire {}
}
! focus $canvas
# my object edit mode code ends
set @action rect
! $canvas create line $cx $cy $cx $cy $cx $cy $cx $cy $cx $cy -tags selrect
! switch $OS { osx {} default { $canvas itemconfigure selrect -dash {3 3 3 3}}}
}
}
--- 1669,1681 ----
if {[llength $@selection_wire] > 0} {
foreach wire $@selection_wire {
! $c itemconfigure $wire -fill $look(wirefg)
}
set @selection_wire {}
}
! focus $c
# my object edit mode code ends
set @action rect
! $c create line $cx $cy $cx $cy $cx $cy $cx $cy $cx $cy -tags selrect
! switch $OS { osx {} default { $c itemconfigure selrect -dash {3 3 3 3}}}
}
}
***************
*** 1713,1720 ****
def canvas mouseup {x y b} {
global canvas_mouseup wire_from wire_to _ font look offset_wire
! set canvas .x$self.c
! set name $canvas
! set cx [$name canvasx $x]
! set cy [$name canvasy $y]
if {[llength $wire_from]} {
if {[llength $wire_to]} {
--- 1692,1698 ----
def canvas mouseup {x y b} {
global canvas_mouseup wire_from wire_to _ font look offset_wire
! set c .x$self.c
! set cx [$c canvasx $x]
! set cy [$c canvasy $y]
if {[llength $wire_from]} {
if {[llength $wire_to]} {
***************
*** 1755,1760 ****
#maybe don't need this
set _($wire_id) $d
! wire_update $wire_id $d;
! wire_draw2 $wire_id $name;
#pd "$self add-wire x$wire_from x$wire_to ;"
#puts "::::connect from $wire_from to $wire_to"
--- 1733,1738 ----
#maybe don't need this
set _($wire_id) $d
! wire_update $wire_id $d
! wire_draw2 $wire_id $c
#pd "$self add-wire x$wire_from x$wire_to ;"
#puts "::::connect from $wire_from to $wire_to"
***************
*** 1765,1774 ****
set wire_from {}
set wire_to {}
! $name delete lnew
#return
}
! if {[llength [$canvas gettags selrect]] > 0} {
#puts "___figure out what objects are in selrect!!!"
! set coords [$canvas coords selrect]
set x1 [lindex $coords 0]
set y1 [lindex $coords 1]
--- 1743,1752 ----
set wire_from {}
set wire_to {}
! $c delete lnew
#return
}
! if {[llength [$c gettags selrect]] > 0} {
#puts "___figure out what objects are in selrect!!!"
! set coords [$c coords selrect]
set x1 [lindex $coords 0]
set y1 [lindex $coords 1]
***************
*** 1778,1784 ****
#puts "selrect area ::: $x1 $y1, $x2 $y2"
# my selrect code begins --chun
! set selrect_id [$canvas find withtag selrect]
#puts "selrect's id ::: $selrect_id"
! set selected_elements [$canvas find overlapping $x1 $y1 $x2 $y2]
#puts "elements in selrect --> $selected_elements"
set selrect_index [lsearch $selected_elements $selrect_id]
--- 1756,1762 ----
#puts "selrect area ::: $x1 $y1, $x2 $y2"
# my selrect code begins --chun
! set selrect_id [$c find withtag selrect]
#puts "selrect's id ::: $selrect_id"
! set selected_elements [$c find overlapping $x1 $y1 $x2 $y2]
#puts "elements in selrect --> $selected_elements"
set selrect_index [lsearch $selected_elements $selrect_id]
***************
*** 1791,1795 ****
set element_tags {}
foreach item $selected_elements {
! eval lappend element_tags [$canvas gettags $item]
}
#puts "tags in selrect --> $element_tags"
--- 1769,1773 ----
set element_tags {}
foreach item $selected_elements {
! eval lappend element_tags [$c gettags $item]
}
#puts "tags in selrect --> $element_tags"
***************
*** 1801,1805 ****
}
# this would make things shorter
! # if {[regexp {^l([a-f0-9]{6,8})} [$canvas gettags $tag] id]}
#if {[regexp {^l([a-f0-9]{6,8})} $tag wire_id]} {
#
--- 1779,1783 ----
}
# 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]} {
#
***************
*** 1838,1842 ****
foreach wire_id $_($obj:0:$x) {
#wire_update $wire_id $_($wire_id)
! #wire_draw2 $wire_id $canvas
set i [lsearch $@selection_wire $wire_id]
if {$i<0} {lappend @selection_wire $wire_id}
--- 1816,1820 ----
foreach wire_id $_($obj:0:$x) {
#wire_update $wire_id $_($wire_id)
! #wire_draw2 $wire_id $self
set i [lsearch $@selection_wire $wire_id]
if {$i<0} {lappend @selection_wire $wire_id}
***************
*** 1849,1853 ****
foreach wire_id $_($obj:1:$x) {
#wire_update $wire_id $_($wire_id)
! #wire_draw2 $wire_id $canvas
set i [lsearch $@selection_wire $wire_id]
if {$i<0} {lappend @selection_wire $wire_id}
--- 1827,1831 ----
foreach wire_id $_($obj:1:$x) {
#wire_update $wire_id $_($wire_id)
! #wire_draw2 $wire_id $self
set i [lsearch $@selection_wire $wire_id]
if {$i<0} {lappend @selection_wire $wire_id}
***************
*** 1859,1863 ****
#puts "@selection_wire --> $@selection_wire"
foreach obj $@selection) {
- #puts "${obj}BASE :: $canvas"
$canvas itemconfigure ${obj}BASE -outline $look(objectframe4)
}
--- 1837,1840 ----
***************
*** 1867,1871 ****
set @select_by "selrect"
} {
- #puts "dehightlight all!!!!!"
#foreach obj $@selection {
#$canvas itemconfigure ${obj}BASE -outline $look(objectframe3)
--- 1844,1847 ----
***************
*** 1873,1884 ****
#set @selection {}
}
- # my selrect code ends
$canvas delete selrect
}
if {[llength $@selection]==1} {
- #puts "___only one obj selected by click!!!"
#pd "$self gobj-activate x$@selection;"
- #puts "____ selected by ->$@select_by ____"
if {$@select_by == "click"} {
switch $_($@selection:class) {
--- 1849,1857 ----
***************
*** 1895,1902 ****
set edit 0; switch $@mode { edit { set edit 1 } }
set run [expr !$edit]
-
- #not sure what this does
- #puts "mouseup2::: @focus => $@focus"
-
if {[string length $@focus]} {
set id $@focus
--- 1868,1871 ----
***************
*** 1979,1985 ****
def canvas key {x y key iso shift} {
global OS
! set canvas $self.c
! # .controls.switches.meterbutton configure -text $key
! hide_canvas_tooltip $canvas
switch $OS {
osx {
--- 1948,1953 ----
def canvas key {x y key iso shift} {
global OS
! set c .x$self.c
! $c hide_tooltip
switch $OS {
osx {
***************
*** 1992,2023 ****
if {$key == "KP_Delete"} {set key 127; set keynum 127}
if {$iso != ""} {scan $iso %c key}
! #pd [canvastosym $canvas] key 1 $key $shift\;
! set edit 0; switch $_($self:mode) { edit { set edit 1 } }
! puts "focus = $_($self:focus)"
! #puts "key = $key"
!
if {$key == 8} {
! #puts "delete something"
! #puts "object selected=> [llength $_($self:selection)] => $_($self:selection)"
! if {[llength $_($self:selection)] > 0} {canvas_delete_selection $self}
! if {[llength $_($self:selection_wire)] > 0} {
! #$canvas delete $_($self:selection_wire)
! foreach wire $_($self:selection_wire) {
! $canvas delete $wire
! }
! set _($self:selection_wire) {}
}
}
-
- #mmm, don't know what this does.... -- chun
- #if {[string length $_($self:focus)] > 0} {
- #set id $_($self:focus)
- #set run [expr !$edit]
- #if {$run && [info exists _($id:keyevent)]} {
- # eval [linsert [list $_($self:focus) $canvas $key $shift] 0 $_($id:keyevent)]
- #} elseif {!$run && [info exists _($id:keyeditevent)]} {
- # eval [linsert [list $_($self:focus) $canvas $key $shift] 0 $_($id:keyeditevent)]
- #}
- #}
statusbar_update $self $x $y
}
--- 1960,1982 ----
if {$key == "KP_Delete"} {set key 127; set keynum 127}
if {$iso != ""} {scan $iso %c key}
! set edit 0; switch $@mode { edit { set edit 1 } }
! puts "focus = $@focus"
if {$key == 8} {
! if {[llength $@selection] > 0} {$self delete_selection}
! if {[llength $@selection_wire] > 0} {
! $c delete $@selection_wire
! foreach wire $@selection_wire {$c delete $wire}
! set @selection_wire {}
! }
! }
! if {[string length $@focus] > 0} {
! set id $@focus
! set run [expr !$edit]
! if {$run && [info exists _($id:keyevent)]} {
! eval [linsert [list $_($self:focus) $self $key $shift] 0 $_($id:keyevent)]
! } elseif {!$run && [info exists _($id:keyeditevent)]} {
! eval [linsert [list $_($self:focus) $self $key $shift] 0 $_($id:keyeditevent)]
}
}
statusbar_update $self $x $y
}
***************
*** 3017,3021 ****
set tooltip(mx) -1000
set tooltip(my) -1000
! set tooltip(canvas) foo
set tooltip(visible) 0
set tooltip(text) ""
--- 2976,2980 ----
set tooltip(mx) -1000
set tooltip(my) -1000
! set tooltip(canvas) ""
set tooltip(visible) 0
set tooltip(text) ""
***************
*** 3024,3028 ****
global current_x current_y tooltip
if {$tooltip(visible) && [string compare $text $tooltip(text)==0]} {return}
! hide_canvas_tooltip $canvas
set border 4
set x [expr $x+$border+4]
--- 2983,2987 ----
global current_x current_y tooltip
if {$tooltip(visible) && [string compare $text $tooltip(text)==0]} {return}
! $self hide_tooltip
set border 4
set x [expr $x+$border+4]
***************
*** 3039,3043 ****
set tooltip(mx) $current_x
set tooltip(my) $current_y
! set tooltip(canvas) $canvas
set tooltip(visible) 1
set tooltip(text) $text
--- 2998,3002 ----
set tooltip(mx) $current_x
set tooltip(my) $current_y
! set tooltip(canvas) $self
set tooltip(visible) 1
set tooltip(text) $text
More information about the Pd-cvs
mailing list