Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29629
Modified Files: Tag: impd_0_37 u_main.tk Log Message: bugfix
Index: u_main.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/u_main.tk,v retrieving revision 1.1.1.4.2.7.4.42 retrieving revision 1.1.1.4.2.7.4.43 diff -C2 -d -r1.1.1.4.2.7.4.42 -r1.1.1.4.2.7.4.43 *** u_main.tk 17 Apr 2004 06:04:01 -0000 1.1.1.4.2.7.4.42 --- u_main.tk 19 Apr 2004 02:30:48 -0000 1.1.1.4.2.7.4.43 *************** *** 825,833 **** set cy [$canvas canvasy $y] set edit 0; switch $_($self:mode) { edit { set edit 1 } } - pd [canvastosym $canvas] mouse $cx $cy $b $f ; foreach {type id} [identify_target $canvas $x $y $b $f "click"] {} switch $type { object { ! pd "$self click-on-object $id $cx $cy $b $f;" if {$edit && [llength [$canvas bbox ${id}BASE]]} { set wire_from [list $cx $cy] --- 825,833 ---- set cy [$canvas canvasy $y] set edit 0; switch $_($self:mode) { edit { set edit 1 } } foreach {type id} [identify_target $canvas $x $y $b $f "click"] {} switch $type { object { ! puts "$self click-on-object x$id $cx $cy $b $f;" ! pd "$self click-on-object x$id $cx $cy $b $f;" if {$edit && [llength [$canvas bbox ${id}BASE]]} { set wire_from [list $cx $cy] *************** *** 836,845 **** set outs 0 catch {set outs $_($id:outlets)} ! if {$outs==0} return ! 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] } } --- 836,847 ---- set outs 0 catch {set outs $_($id:outlets)} ! 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 ! } } } *************** *** 847,856 **** --- 849,861 ---- wire { pd "[canvastosym $canvas] click-on-wire $id $cx $cy $b $f;" + return } } + pd "[canvastosym $canvas] mouse $cx $cy $b $f ;" }
set dehighlight {} set wire_from {} + set wire_to {}
proc pdtk_canvas_motion {canvas x y mods} { *************** *** 870,874 **** set current_x $cx set current_y $cy - pd [canvastosym $canvas] motion $x $y $mods ; foreach {type id} [identify_target $canvas $x $y -1 -1 "move "] {} switch $type { --- 875,878 ---- *************** *** 888,891 **** --- 892,896 ---- set dehighlight "$canvas delete ${id}i${port}b; set wire_to {}" set wire_to [list $id $port] + return } } { *************** *** 895,904 **** set ports 0 catch {set ports $_($id:outlets)} ! if {$ports==0} return ! set port [expr int(($cx-$x1)*$ports/($x2-$x1))] ! $canvas create rectangle \ ! [l+ [$canvas coords ${id}o${port}] {-4 -4 +4 +4}] \ ! -outline $look(outletfg) -width 1 -tags ${id}o${port}b ! set dehighlight "$canvas delete ${id}o${port}b" } } --- 900,910 ---- set ports 0 catch {set ports $_($id:outlets)} ! if {$ports} { ! set port [expr int(($cx-$x1)*$ports/($x2-$x1))] ! $canvas create rectangle \ ! [l+ [$canvas coords ${id}o${port}] {-4 -4 +4 +4}] \ ! -outline $look(outletfg) -width 1 -tags ${id}o${port}b ! set dehighlight "$canvas delete ${id}o${port}b" ! } } } *************** *** 919,923 **** --- 925,931 ---- lappend l $cx $cy $canvas coords lnew $l + return } + pd "[canvastosym $canvas] motion $x $y $mods ;" }
*************** *** 934,942 **** global pdtk_canvas_mouseup wire_from wire_to set self [canvastosym $name] - pd "$self mouseup [$name canvasx $x] [$name canvasy $y] $b ;" if {[llength $wire_from]} { ! pd "$self add-wire $wire_from $wire_to ;" set wire_from {} } set size [$name bbox all] if {$size != ""} { --- 942,956 ---- global pdtk_canvas_mouseup wire_from wire_to set self [canvastosym $name] if {[llength $wire_from]} { ! if {[llength $wire_to]} { ! pd "$self add-wire $wire_from $wire_to ;" ! } set wire_from {} + set wire_to {} + $name delete lnew + #return } + pd "$self mouseup [$name canvasx $x] [$name canvasy $y] $b ;" + set size [$name bbox all] if {$size != ""} { *************** *** 961,966 **** } pdtk_canvas_checkgeometry [canvastosym $name] - set canvas $name - if {[llength [$canvas gettags lnew]]} {$canvas delete lnew} }
--- 975,978 ---- *************** *** 1276,1290 **** }
! proc pdtk_gatom_dialog {id initwidth initlo inithi \ ! wherelabel label symfrom symto} { global _ set self [string trimleft $id .] ! set _($self:width) $initwidth ! set _($self:lo) $initlo ! set _($self:hi) $inithi set _($self:wherelabel) $wherelabel ! set _($self:label) [gatom_unescape $label] set _($self:symfrom) [gatom_unescape $symfrom] ! set _($self:symto) [gatom_unescape $symto] toplevel $id wm title $id "Atom" --- 1288,1301 ---- }
! proc pdtk_gatom_dialog {id width lo hi wherelabel label symfrom symto} { global _ set self [string trimleft $id .] ! set _($self:width) $width ! set _($self:lo) $lo ! set _($self:hi) $hi set _($self:wherelabel) $wherelabel ! set _($self:label) [gatom_unescape $label] set _($self:symfrom) [gatom_unescape $symfrom] ! set _($self:symto) [gatom_unescape $symto] toplevel $id wm title $id "Atom" *************** *** 2224,2228 **** proc tcl_eval {} { set l [.tcl.entry get] ! post_to_gui "tcl: $l\nreturns: [eval $l]\n" listener_append .tcl [.tcl.entry get] .tcl.entry delete 0 end --- 2235,2239 ---- proc tcl_eval {} { set l [.tcl.entry get] ! post "tcl: $l\nreturns: [eval $l]" listener_append .tcl [.tcl.entry get] .tcl.entry delete 0 end *************** *** 2231,2237 **** global cmdline after 1 { ! if {$cmdline(console) != 0} { listener_new .tcl "Tcl" {tcl_eval} ! }}
############ button bar --- 2242,2249 ---- global cmdline after 1 { ! # if {$cmdline(console) != 0} { listener_new .tcl "Tcl" {tcl_eval} ! # } ! }
############ button bar