[PD-cvs] pd/src u_main.tk,1.1.1.4.2.7.4.52,1.1.1.4.2.7.4.53 u_object.tk,1.1.2.28,1.1.2.29

[Mathieu Bouchard]

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]