[PD-cvs] pd/src u_main.tk,1.1.1.4.2.7.4.58,1.1.1.4.2.7.4.59

Mathieu Bouchard matju at users.sourceforge.net
Mon May 3 21:44:55 CEST 2004


Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14154

Modified Files:
      Tag: impd_0_37
	u_main.tk 
Log Message:
key events can be handled by Tcl objects now


Index: u_main.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/u_main.tk,v
retrieving revision 1.1.1.4.2.7.4.58
retrieving revision 1.1.1.4.2.7.4.59
diff -C2 -d -r1.1.1.4.2.7.4.58 -r1.1.1.4.2.7.4.59
*** u_main.tk	3 May 2004 17:03:29 -0000	1.1.1.4.2.7.4.58
--- u_main.tk	3 May 2004 19:44:52 -0000	1.1.1.4.2.7.4.59
***************
*** 778,784 ****
  	bind $name.c <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
      }
!     bind $name.c <Key>        {pdtk_canvas_key %W %K %A 0}
!     bind $name.c <Shift-Key>  {pdtk_canvas_key %W %K %A 1}
!     bind $name.c <KeyRelease> {pdtk_canvas_keyup %W %K %A}
      bind $name.c <Motion>     {pdtk_canvas_motion %W %x %y 0 %s}
      bind $name.c <Alt-Motion> {pdtk_canvas_motion %W %x %y 4 %s}
--- 778,784 ----
  	bind $name.c <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
      }
!     bind $name.c <Key>        {pdtk_canvas_key %W %x %y %K %A 0}
!     bind $name.c <Shift-Key>  {pdtk_canvas_key %W %x %y %K %A 1}
!     bind $name.c <KeyRelease> {pdtk_canvas_keyup %W %x %y %K %A 0}
      bind $name.c <Motion>     {pdtk_canvas_motion %W %x %y 0 %s}
      bind $name.c <Alt-Motion> {pdtk_canvas_motion %W %x %y 4 %s}
***************
*** 808,811 ****
--- 808,813 ----
      set _($self:action) none
      set _($self:selection) {}
+     set _($self:grab) ""
+     #puts "self = $self, self.mode = $_($self:mode)"
  }
  
***************
*** 1076,1080 ****
  	pd "$self gobj-activate x$_($self:selection);"
      }
!     
      set edit 0; switch $_($self:mode) { edit { set edit 1 } }
      foreach {type id} [identify_target $canvas $cx $cy -1 -1 "blah "] {}
--- 1078,1082 ----
  	pd "$self gobj-activate x$_($self:selection);"
      }
! 
      set edit 0; switch $_($self:mode) { edit { set edit 1 } }
      foreach {type id} [identify_target $canvas $cx $cy -1 -1 "blah "] {}
***************
*** 1117,1126 ****
  }
  
! proc pdtk_canvas_key {name key iso shift} {
  #    .controls.switches.meterbutton configure -text $key
  #  HACK for MAC OSX -- backspace seems different; I don't understand why.
  #  investigate this LATER...
      global pd_nt
!     hide_canvas_tooltip $name
      if {$pd_nt == 2} {
  	switch -- $key {
--- 1119,1130 ----
  }
  
! proc pdtk_canvas_key {canvas x y key iso shift} {
  #    .controls.switches.meterbutton configure -text $key
  #  HACK for MAC OSX -- backspace seems different; I don't understand why.
  #  investigate this LATER...
      global pd_nt
!     global _
!     set self [canvastosym $canvas]
!     hide_canvas_tooltip $canvas
      if {$pd_nt == 2} {
  	switch -- $key {
***************
*** 1130,1148 ****
      }
      if {$key == "KP_Delete"} {set key 127; set keynum 127}
!     if {$iso != ""} {
!     	scan $iso %c keynum 
!     	pd [canvastosym $name] key 1 $keynum $shift\;
!     } else {
!     	pd [canvastosym $name] key 1 $key $shift\;
      }
  }
  
! proc pdtk_canvas_keyup {name key iso} {
!     if {$iso != ""} {
!     	scan $iso %c keynum 
!     	pd [canvastosym $name] key 0 $keynum 0 \;
!     } else {
!     	pd [canvastosym $name] key 0 $key 0 \;
      }
  }
  
--- 1134,1169 ----
      }
      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 "grab = $_($self:grab)"
!     if {[string length $_($self:grab)] > 0} {
! 	set id $_($self:grab)
!         set run [expr !$edit]
!         if {$run && [info exists _($id:keyevent)]} {
! 		eval [linsert [list $_($self:grab) $canvas $key $shift] 0 $_($id:keyevent)]
!         } elseif {!$run && [info exists _($id:keyeditevent)]} {
! 		eval [linsert [list $_($self:grab) $canvas $key $shift] 0 $_($id:keyeditevent)]
! 	}
      }
+     statusbar_update [string trimright $canvas .c] $x $y
  }
  
! proc pdtk_canvas_keyup {canvas x y key iso shift} {
!     global _
!     set self [canvastosym $canvas]
!     if {$iso != ""} {scan $iso %c key}
!     pd [canvastosym $canvas] key 0 $key 0 \;
!     set edit 0; switch $_($self:mode) { edit { set edit 1 } }
!     if {[string length $_($self:grab)] > 0} {
! 	set id $_($self:grab)
!         set run [expr !$edit]
!         if {$run && [info exists _($id:keyreleaseevent)]} {
! 		eval [linsert [list $_($self:grab) $canvas $key $shift] 0 $_($id:keyreleaseevent)]
!         } elseif {!$run && [info exists _($id:keyreleaseeditevent)]} {
! 		eval [linsert [list $_($self:grab) $canvas $key $shift] 0 $_($id:keyreleaseeditevent)]
! 	}
      }
+     statusbar_update [string trimright $canvas .c] $x $y
  }
  
***************
*** 1600,1612 ****
      if {[string index $rcv 0] == "$"} { set rcv [string replace $rcv 0 0 #] }
      if {[string index $lab 0] == "$"} { set lab [string replace $lab 0 0 #] }
!     pd "$id send $snd ;"
!     pd "$id receive $rcv ;"
!     pd "$id label $lab ;"
!     pd "$id label_pos $_($self:ldx) $_($self:ldy) ;"
!     pd "$id label_font $_($self:fstyle) $_($self:fs) ;"
!     pd "$id color $_($self:bcol) $_($self:fcol) $_($self:lcol) ;"
!     pd "$id dialog \
!         $_($self:w) $_($self:h) $_($self:min) $_($self:max) \
! 	$_($self:is_log) $_($self:loadbang) $_($self:num) $_($self:steady) ;"
  }
  
--- 1621,1630 ----
      if {[string index $rcv 0] == "$"} { set rcv [string replace $rcv 0 0 #] }
      if {[string index $lab 0] == "$"} { set lab [string replace $lab 0 0 #] }
!     set l "$id reload"
!     global fields
!     foreach field [lrange $fields($_($self:class)) 5 end] {
! 	lappend l $_($self:$field)
!     }
!     pd "$l ;"
  }
  
***************
*** 1629,1632 ****
--- 1647,1651 ----
      }
      set _($self:loadbang) [expr $_($obj:isa) & 1]
+     set _($self:class) $_($obj:class)
      puts "pdtk_iemgui_dialog $id ..."
      toplevel $id
***************
*** 1740,1750 ****
  
  proc canvas_grab {canvas obj} {
! 	set self [string trimleft $id .]
! 	set $_($self:grab) $obj
  }
  
  proc canvas_ungrab {canvas} {
! 	set self [string trimleft $id .]
! 	set $_($self:grab) ""
  }
  
--- 1759,1773 ----
  
  proc canvas_grab {canvas obj} {
! 	puts "canvas_grab $canvas $obj"
! 	global _
! 	set self [canvastosym $canvas]
! 	set _($self:grab) $obj
  }
  
  proc canvas_ungrab {canvas} {
! 	puts "canvas_ungrab $canvas"
! 	global _
! 	set self [canvastosym $canvas]
! 	set _($self:grab) ""
  }
  





More information about the Pd-cvs mailing list