Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25707
Modified Files: Tag: impd_0_37 u_main.tk u_object.tk Log Message: Tcl-based renderers can now receive events too
Index: u_object.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/u_object.tk,v retrieving revision 1.1.2.28 retrieving revision 1.1.2.29 diff -C2 -d -r1.1.2.28 -r1.1.2.29 *** u_object.tk 1 May 2004 01:46:18 -0000 1.1.2.28 --- u_object.tk 1 May 2004 15:03:07 -0000 1.1.2.29 *************** *** 203,207 ****
proc objectbox_draw {self canvas xs ys ins outs} { ! global look foreach {x1 y1} [object_xy $self $canvas] {} set x2 [expr $x1+$xs] --- 203,207 ----
proc objectbox_draw {self canvas xs ys ins outs} { ! global _ look foreach {x1 y1} [object_xy $self $canvas] {} set x2 [expr $x1+$xs] *************** *** 222,225 **** --- 222,226 ---- } io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs + set _($self:clickevent) objectbox_click }
*************** *** 236,239 **** --- 237,244 ---- }
+ proc objectbox_click {self canvas x y b f} { + puts "objectbox_click $self $canvas $x $y $b $f" + } + proc brokenbox_draw {self canvas xs ys ins outs} { objectbox_draw $self $canvas $xs $ys $ins $outs
Index: u_main.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/u_main.tk,v retrieving revision 1.1.1.4.2.7.4.52 retrieving revision 1.1.1.4.2.7.4.53 diff -C2 -d -r1.1.1.4.2.7.4.52 -r1.1.1.4.2.7.4.53 *** u_main.tk 1 May 2004 01:46:18 -0000 1.1.1.4.2.7.4.52 --- u_main.tk 1 May 2004 15:03:07 -0000 1.1.1.4.2.7.4.53 *************** *** 857,860 **** --- 857,865 ----
proc pdtk_canvas_click {canvas x y b f} { + pdtk_canvas_click2 $canvas $x $y $b $f + statusbar_update [string trimright $canvas .c] $x $y + } + + proc pdtk_canvas_click2 {canvas x y b f} { global _ wire_from set self [canvastosym $canvas] *************** *** 865,871 **** 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]]} { foreach {x1 y1 x2 y2} [$canvas bbox ${id}BASE] {} if {abs($y2-3-$cy)<=3} { --- 870,881 ---- switch $type { object { + set run [expr !$edit || ($f&2)] puts "$self click-on-object x$id $cx $cy $b $f;" pd "$self click-on-object x$id $cx $cy $b $f;" ! if {$f&8} { ! puts "RIGHTCLICK OBJECT" ! } elseif {$run && [info exists _($id:clickevent)]} { ! eval [linsert [list $id $self $cx $cy $b $f] 0 $_($id:clickevent)] ! } elseif {$edit && [llength [$canvas bbox ${id}BASE]]} { foreach {x1 y1 x2 y2} [$canvas bbox ${id}BASE] {} if {abs($y2-3-$cy)<=3} { *************** *** 883,887 **** } # selection ! if {[lsearch $_($self:selection) $id]<0} { pd "$self deselect-all ; $self select-object x$id ;" } --- 893,903 ---- } # selection ! set already [expr [lsearch $_($self:selection) $id]>=0] ! puts "f = $f" ! if {($f&1) && !$already} { ! pd "$self select-object x$id ;" ! #} elseif {($f&2) && $already} { ! # pd "$self deselect-object x$id ;" ! } elseif {!$already} { pd "$self deselect-all ; $self select-object x$id ;" } *************** *** 890,893 **** --- 906,912 ---- } wire { + if {$f&8} { + puts "RIGHTCLICK WIRE" + } pd "[canvastosym $canvas] click-on-wire $id $cx $cy $b $f;" return *************** *** 902,905 **** --- 921,929 ----
proc pdtk_canvas_motion {canvas x y mods} { + pdtk_canvas_motion2 $canvas $x $y $mods + statusbar_update [string trimright $canvas .c] $x $y + } + + proc pdtk_canvas_motion2 {canvas x y mods} { global current_x current_y old_x old_y global tooltip _ dehighlight look wire_from wire_to *************** *** 942,945 **** --- 966,974 ---- switch $type { object { + puts $mods + set run [expr !$edit] + if {$run && [info exists _($id:motionevent)]} { + eval [linsert [list $id $self $cx $cy $mods] 0 $_($id:motionevent)] + } if {$edit && [llength [$canvas bbox ${id}BASE]]} { # may highlight an inlet *************** *** 993,997 **** # geometry of the window since I haven't taken the time to figure out # how to do it right. ! proc pdtk_canvas_mouseup {name x y b} { global pdtk_canvas_mouseup wire_from wire_to _ set cx [$name canvasx $x] --- 1022,1032 ---- # geometry of the window since I haven't taken the time to figure out # how to do it right. ! ! proc pdtk_canvas_mouseup {canvas x y b} { ! pdtk_canvas_mouseup2 $canvas $x $y $b ! statusbar_update [string trimright $canvas .c] $x $y ! } ! ! proc pdtk_canvas_mouseup2 {name x y b} { global pdtk_canvas_mouseup wire_from wire_to _ set cx [$name canvasx $x]