[PD-cvs] pd/src desire.tk,1.1.2.48,1.1.2.49

Mathieu Bouchard matju at users.sourceforge.net
Tue Sep 13 23:58:23 CEST 2005


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

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
more converting of proc to def


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.48
retrieving revision 1.1.2.49
diff -C2 -d -r1.1.2.48 -r1.1.2.49
*** desire.tk	13 Sep 2005 20:33:29 -0000	1.1.2.48
--- desire.tk	13 Sep 2005 21:58:20 -0000	1.1.2.49
***************
*** 20,24 ****
  	proc ${name}_new {args} "
  		global nextid _
! 		set self \$nextid
  		incr nextid
  		set _(\$self:_class) $name
--- 20,24 ----
  	proc ${name}_new {args} "
  		global nextid _
! 		set self \[format %08x \$nextid\]
  		incr nextid
  		set _(\$self:_class) $name
***************
*** 65,72 ****
  #some variables i created, some are tmp only. --chun
  
- set canvas .x80f2b50
  set offset 0
  set offset_wire 0 
- set offset_canvas 0
  set offset_canvas_file 0
  set offset_wire_file 0
--- 65,70 ----
***************
*** 144,148 ****
  switch $OS {
    win32 {
-     global pd_guidir pd_tearoff
      set pd_gui2 [string range $argv0 0 [expr [string last \\ $argv0] - 1]]
      regsub -all \\\\ $pd_gui2 / pd_gui3
--- 142,145 ----
***************
*** 152,156 ****
    }
    osx {
-     global pd_guidir pd_tearoff
      set pd_gui2 [string range $argv0 0 [expr [string last / $argv0] - 1]]
      set pd_guidir $pd_gui2/..
--- 149,152 ----
***************
*** 424,428 ****
  }
  
- # Odd little function to make better Mac accelerators
  proc accel_munge {acc} {
      global OS
--- 420,423 ----
***************
*** 907,976 ****
  #-----------------------------------------------------------------------------------#
  
! class_new canvas
! def canvas init {} {
! 	global offset_canvas _
! 	set canvas_id [format %x [expr 0x80f2b50 + $offset_canvas]]
! 	set canvas_id .x$canvas_id
! 	set offset_canvas [expr $offset_canvas + 1]
! 	set _($canvas_id:obj_in_edit) 0
! 	#puts "new canvas id -> $canvas_id"
! 	canvas_new $canvas_id 300 300 +[expr $offset_canvas*50]+[expr $offset_canvas*50] 1
! 	set untitled_number $canvas_id
! }
! 
! #-----------------------------------------------------------------------------------#
! 
! proc canvas_new_menubar {name editable} {
!     global pd_opendir pd_tearoff OS cmdline canvasmenu _
!     menu $name.m
!     menu $name.m.file -tearoff $pd_tearoff
!     $name.m add cascade -label File -menu $name.m.file
!     populate_menu $name.m.file $name $canvasmenu(file)
!     menu $name.m.edit -postcommand "menu_fixeditmenu $name" -tearoff $pd_tearoff
!     $name.m add cascade -label Edit -menu $name.m.edit
!     populate_menu $name.m.edit $name $canvasmenu(edit)
!     # instead of "red = #BC3C60" we take "grey85", so there is no difference if
! # widget is selected or not.
!     $name.m.edit add checkbutton -label "Edit mode" \
!     	-indicatoron true -selectcolor grey85 \
!     	-command "menu_editmode $name" \
! 	-accelerator [accel_munge "Ctrl+e"]	
! 
!     if {!$editable} {$name.m.edit entryconfigure "Edit mode" -indicatoron false}
! 
!     menu $name.m.view -tearoff $pd_tearoff
!     $name.m add cascade -label View -menu $name.m.view
!     populate_menu $name.m.view $name {
! 	{Redraw {pd "%W map 0 ; %W map 1 ;"} {}}
!     }
! #	{Crosshair {global crosshair; set crosshair [expr !!$crosshair]} "" toggle}
! 
!     menu $name.m.put -tearoff $pd_tearoff
!     $name.m add cascade -label Put -menu $name.m.put
!     populate_menu $name.m.put $name $canvasmenu(put)
!     menu $name.m.find -tearoff $pd_tearoff
!     $name.m add cascade -label Find -menu $name.m.find
!     populate_menu $name.m.find $name {
! 	{Find... {foo menu_findobject} "Ctrl+f"}
! 	{"Find Again" {foo "pd %W findagain"} "Ctrl+g"}
!     	{"Find last error" {foo menu_finderror} {}}
!     }
!     menu $name.m.windows -postcommand "foo menu_fixwindowmenu" \
! 	-tearoff $pd_tearoff
!     populate_menu $name.m.windows $name {
! 	{"parent window" {foo menu_windowparent} {}}
! 	{"Pd window" {foo menu_pop_pd} {}}
! 	{}
!     }
!     menu $name.m.media -tearoff $pd_tearoff
!     $name.m add cascade -label Media -menu $name.m.media
!     $name.m add cascade -label Window -menu $name.m.windows
!     menu $name.m.help -tearoff $pd_tearoff
!     $name.m add cascade -label Help -menu $name.m.help
!     menu_addstd $name.m
  }
! 
! proc pdtk_canvas_new {name width height geometry editable} {canvas_new $name $width $height $geometry $editable}
! proc canvas_new {name width height geometry editable} {
      #puts "canvas_new::: $name $width $height $geometry $editable"
      global pd_opendir pd_tearoff OS cmdline canvasmenu _
--- 902,915 ----
  #-----------------------------------------------------------------------------------#
  
! proc pdtk_canvas_new {name width height geometry editable} {
! 	global _
! 	regsub "\\.x" $name "" self
! 	puts "NEW CANVAS $self"
! 	set _($self:_class) canvas
! 	$self init $width $height $geometry $editable
  }
! class_new canvas
! def canvas init {width height geometry editable} {
!     set name .$self
      #puts "canvas_new::: $name $width $height $geometry $editable"
      global pd_opendir pd_tearoff OS cmdline canvasmenu _
***************
*** 1093,1096 ****
--- 1032,1087 ----
  
  #-----------------------------------------------------------------------------------#
+ 
+ proc canvas_new_menubar {name editable} {
+     global pd_opendir pd_tearoff OS cmdline canvasmenu _
+     menu $name.m
+     menu $name.m.file -tearoff $pd_tearoff
+     $name.m add cascade -label File -menu $name.m.file
+     populate_menu $name.m.file $name $canvasmenu(file)
+     menu $name.m.edit -postcommand "menu_fixeditmenu $name" -tearoff $pd_tearoff
+     $name.m add cascade -label Edit -menu $name.m.edit
+     populate_menu $name.m.edit $name $canvasmenu(edit)
+     # instead of "red = #BC3C60" we take "grey85", so there is no difference if
+ # widget is selected or not.
+     $name.m.edit add checkbutton -label "Edit mode" \
+     	-indicatoron true -selectcolor grey85 \
+     	-command "menu_editmode $name" \
+ 	-accelerator [accel_munge "Ctrl+e"]	
+ 
+     if {!$editable} {$name.m.edit entryconfigure "Edit mode" -indicatoron false}
+ 
+     menu $name.m.view -tearoff $pd_tearoff
+     $name.m add cascade -label View -menu $name.m.view
+     populate_menu $name.m.view $name {
+ 	{Redraw {pd "%W map 0 ; %W map 1 ;"} {}}
+     }
+ #	{Crosshair {global crosshair; set crosshair [expr !!$crosshair]} "" toggle}
+ 
+     menu $name.m.put -tearoff $pd_tearoff
+     $name.m add cascade -label Put -menu $name.m.put
+     populate_menu $name.m.put $name $canvasmenu(put)
+     menu $name.m.find -tearoff $pd_tearoff
+     $name.m add cascade -label Find -menu $name.m.find
+     populate_menu $name.m.find $name {
+ 	{Find... {foo menu_findobject} "Ctrl+f"}
+ 	{"Find Again" {foo "pd %W findagain"} "Ctrl+g"}
+     	{"Find last error" {foo menu_finderror} {}}
+     }
+     menu $name.m.windows -postcommand "foo menu_fixwindowmenu" \
+ 	-tearoff $pd_tearoff
+     populate_menu $name.m.windows $name {
+ 	{"parent window" {foo menu_windowparent} {}}
+ 	{"Pd window" {foo menu_pop_pd} {}}
+ 	{}
+     }
+     menu $name.m.media -tearoff $pd_tearoff
+     $name.m add cascade -label Media -menu $name.m.media
+     $name.m add cascade -label Window -menu $name.m.windows
+     menu $name.m.help -tearoff $pd_tearoff
+     $name.m add cascade -label Help -menu $name.m.help
+     menu_addstd $name.m
+ }
+ 
+ #-----------------------------------------------------------------------------------#
  proc menu_editmode {name} {
  	#puts "menu_editmode::: $name"
***************
*** 1350,1354 ****
  
  	set _(focus) $self
! 	bind $t <KeyRelease> {text_key $_(focus) $canvas.c %W %x %y %K %A 0}
  
  	#$canvas create window 41 41 -window $t -anchor nw\
--- 1341,1345 ----
  
  	set _(focus) $self
! 	bind $t <KeyRelease> "text_key $self $canvas %W %x %y %K %A 0"
  
  	#$canvas create window 41 41 -window $t -anchor nw\
***************
*** 1370,1380 ****
  #-----------------------------------------------------------------------------------#
  def text key {canvas widget x y key iso shift} {
! 	global _ font
  	set obj_name [$widget get 1.0 1.end]
  	set name_len [string length $obj_name]
  	regexp {(\.x[0-9a-fA-F]+\.c)\.([0-9a-fA-F]+)text(.*)} $widget full canvas self
  	$widget configure -width [expr $name_len + 1]
! 	set _($self:xs) [expr ($font(width) * ($name_len+1) + $font(padx))]
! 	set _($self:ys) [expr $font(height) + $font(pady)]
  	objectbox_draw $self $canvas
  }
--- 1361,1371 ----
  #-----------------------------------------------------------------------------------#
  def text key {canvas widget x y key iso shift} {
! 	global font
  	set obj_name [$widget get 1.0 1.end]
  	set name_len [string length $obj_name]
  	regexp {(\.x[0-9a-fA-F]+\.c)\.([0-9a-fA-F]+)text(.*)} $widget full canvas self
  	$widget configure -width [expr $name_len + 1]
! 	set @xs [expr ($font(width) * ($name_len+1) + $font(padx))]
! 	set @ys [expr $font(height) + $font(pady)]
  	objectbox_draw $self $canvas
  }
***************
*** 1383,1401 ****
  class_new objectbox
  def objectbox init {} {
! 	global offset _
  	set canvas $_(focus)
! 	set self [canvastosym $canvas]
! 	if {$_($self:mode) == "edit"} {
! 		set offset [expr $offset + 1]
! 		set object_id [format %x [expr 0x81168b0 - $offset]]
! 		set _($object_id:class) objectbox
! 		set _($object_id:_class) objectbox
! 		#puts "new object id -> $object_id"
! 		object_add $object_id $canvas
! 	}
  }
  
  #-----------------------------------------------------------------------------------#
! def object add {canvas} {
  	#puts "object_add:: $self $canvas"
  	global font look
--- 1374,1386 ----
  class_new objectbox
  def objectbox init {} {
! 	global offset
! 	#set canvas [canvastosym $_(focus)]
  	set canvas $_(focus)
! 	set @class ""
! 	$self add $canvas
  }
  
  #-----------------------------------------------------------------------------------#
! def objectbox add {canvas} {
  	#puts "object_add:: $self $canvas"
  	global font look
***************
*** 1432,1460 ****
  #-----------------------------------------------------------------------------------#
  def object complete {canvas} {
- 	#puts "object_complete::: $self $canvas"
- 
  	global font
- 
  	set @isselected 0
  	set @isnew 0
  	set obj_name [${canvas}.${self}text get 1.0 1.end]
  	set @name_len [string length $obj_name]
- 	#set _($canvas:obj_in_edit) 0
- 	#puts $obj_name
- 	#puts "deleting ${self}text"
  	destroy ${canvas}.${self}text
          $canvas delete ${self}text
-         #puts "confirm -> [$canvas find withtag ${self}text]"        
-         
  	objectbox_erase $self $canvas 
  	set @sx	[expr ($@name_len*$font(width)) + $font(padx)]
  	set @sy [expr $font(height) + $font(pady)]
  	objectbox_draw $self $canvas
- 	#wire_update $wire_id $_($wire_id) 
- 	#wire_draw2 $wire_id $canvas
- 	
  	for {set x 0} {$x<$@inlets} {incr x} {
- 		#if {[info exists]}
- 		#puts "check -> $self"
  		if {[info exists _($self:0:$x)]} {
  			#puts "wires at inlet $x to select --> $_($self:0:$x)"
--- 1417,1432 ----
***************
*** 1480,1486 ****
  		}	
  	}
- 	#text_new $canvas ${self}TEXT [expr $@cx+2] [expr $@cy+2] \
- 	#	$obj_name $font(size) #000000
- 		
  	text_new $canvas $self [expr $@cx+2] [expr $@cy+2] \
  		$obj_name $font(size) #000000
--- 1452,1455 ----
***************
*** 1709,1732 ****
      #puts stderr "($label) $canvas $cx $cy $b $f : $tags "
      #puts "stack => $stack"
-     
      foreach tag $stack {
! 	#puts "target => [$canvas gettags $tag]"
! 	#puts "          [regexp {^([a-f0-9]{6,8})} [$canvas gettags $tag] id]"
! 	#puts "          $id"
! 	if {[regexp {^([a-f0-9]{6,8})} [$canvas gettags $tag] id]} {
  	    global _
  	    if {[info exists _($id:class)]} {set class $_($id:class)} {set class unknown}
! 	    #puts stderr "(.....) $id is a \[$class\] object"
! 	    #puts "target_id => $id"
  	    return [list "object" $id]
          }
      }
      foreach tag $stack {
!         if {[regexp {^l([a-f0-9]{6,8})} [$canvas gettags $tag] id]} {
! 	    #puts stderr "(.....) this is a wire"
  	    return [list "wire" $id]
          }
      }
!     #puts stderr "(.....) nothing in particular"
      return [list "nothing"]
  }
--- 1678,1698 ----
      #puts stderr "($label) $canvas $cx $cy $b $f : $tags "
      #puts "stack => $stack"
      foreach tag $stack {
! 	set tags [$canvas gettags $tag] 
! 	if {[regexp {^([a-f0-9]{6,8})} $tags id]} {
  	    global _
  	    if {[info exists _($id:class)]} {set class $_($id:class)} {set class unknown}
! 	    #post "(.....) $id is a \[$class\] object"
  	    return [list "object" $id]
          }
      }
      foreach tag $stack {
! 	set tags [$canvas gettags $tag] 
!         if {[regexp {^l([a-f0-9]{6,8})} $tags id]} {
! 	    #post "(.....) $id is a wire"
  	    return [list "wire" $id]
          }
      }
!     #post "(.....) nothing in particular"
      return [list "nothing"]
  }
***************
*** 1736,1740 ****
  	set f $name.stat
  	frame $f -border 2 -relief ridge
! 	foreach {a b} {pos 12 what 32 mode 4 action 4 sel 4} {
  		label $f.$a -width $b -font {courier 9} \
  		-background #cccccc -foreground black -anchor w
--- 1702,1706 ----
  	set f $name.stat
  	frame $f -border 2 -relief ridge
! 	foreach {a b} {pos 15 what 32 mode 4 action 4 sel 4} {
  		label $f.$a -width $b -font {courier 9} \
  		-background #cccccc -foreground black -anchor w
***************
*** 1744,1750 ****
  	label $f.sel_l    -text " Sel: "
  	pack $f.pos -side left
! 	pack $f.what -side left -padx 8
! 	pack $f -side bottom -fill x
  	pack $f.mode_l $f.mode $f.action_l $f.action $f.sel_l $f.sel -side left
  }
  
--- 1710,1716 ----
  	label $f.sel_l    -text " Sel: "
  	pack $f.pos -side left
! 	pack $f.what -side left -padx 8 -fill x -expand yes
  	pack $f.mode_l $f.mode $f.action_l $f.action $f.sel_l $f.sel -side left
+ 	pack $f -side bottom -fill x
  }
  
***************
*** 1779,1786 ****
  #-----------------------------------------------------------------------------------#
  proc canvas_click {canvas x y b f} {
!     #puts "canvas_click::: $canvas $x $y $b $f"
! 
!     canvas_click2 $canvas $x $y $b $f
!     statusbar_update [canvastosym $canvas] $x $y
  }
  
--- 1745,1752 ----
  #-----------------------------------------------------------------------------------#
  proc canvas_click {canvas x y b f} {
!     set self [canvastosym $canvas]
!     puts "canvas_click::: $canvas $x $y $b $f"
!     canvas_click2 $self $x $y $b $f
!     statusbar_update $self $x $y
  }
  
***************
*** 1788,1805 ****
  # agree, but could i do this a bit later? --chun
  
! proc canvas_click2 {canvas x y b f} {
!     #puts "canvas_click2::: $canvas $x $y $b $f"
! 
      global _ wire_from rightclick_object OS select_area mouse font look
!     set self [canvastosym $canvas]
      set cx [$canvas canvasx $x]
      set cy [$canvas canvasy $y]
!     set edit 0; switch $_($self: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"] {}
-     
      #puts "click on => $type:$id"
      
--- 1754,1768 ----
  # agree, but could i do this a bit later? --chun
  
! def canvas click2 {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 $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"] {}
      #puts "click on => $type:$id"
      
***************
*** 1808,1812 ****
          set run [expr !$edit || ($f&2)]
  	#pd "$self click-on-object x$id $cx $cy $b $f;"
! 	if {[string length $_($self:focus)]} {set gid $_($self:focus)}
  	if {$f&8} {
  	    #puts "RIGHTCLICK OBJECT"
--- 1771,1775 ----
          set run [expr !$edit || ($f&2)]
  	#pd "$self click-on-object x$id $cx $cy $b $f;"
! 	if {[string length $@focus]} {set gid $@focus}
  	if {$f&8} {
  	    #puts "RIGHTCLICK OBJECT"
***************
*** 1818,1822 ****
  			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]]} {
--- 1781,1785 ----
  			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]]} {
***************
*** 1835,1845 ****
  	    }
  	    # selection
! 	    set already [expr [lsearch $_($self:selection) $id]>=0]
  	    #mine begins --chun
  	    #if selection only contains one object and has already been selected,
  	    #allow it to turn into edit mode.
! 	    if {[llength $_($self:selection)] == 1} {
  	    	if {[expr $already]} {	
! 	    	 set _($self:select_by) "click"
  	    	}
  	    }
--- 1798,1808 ----
  	    }
  	    # 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.
! 	    if {[llength $@selection] == 1} {
  	    	if {[expr $already]} {	
! 	    	 set $@select_by "click"
  	    	}
  	    }
***************
*** 1862,1889 ****
  			# may need to call canvas_select_object here to work out 
  			# the shift+click selection
! 			if {[llength $_($self:selection)] == 1} {
! 				#puts "____complete [lindex $_($self:selection) 0] first!____"
! 				set old_obj [lindex $_($self:selection) 0]
! 				if {$_($self:select_by) == "click"} {
  					object_complete $old_obj $canvas
  				}
! 				set _($self:obj_in_edit) 0
  			}
  			#de-hilight
! 			if {[llength $_($self:selection)] > 0} {
  				#puts "dehightlight all!!!!!"
! 				foreach obj $_($self:selection) {
  					$canvas itemconfigure ${obj}BASE -outline $look(objectframe3)
  				}
! 				#set _($self:selection) {}
  			}
! 			set _($self:selection) {}
! 			set _($self:selection) [linsert $_($self:selection) 0 $id]
! 			#puts "self:selection --> $_($self:selection)"
! 			foreach obj $_($self:selection) {
  				#puts "${obj}BASE :: $canvas"
  				$canvas itemconfigure ${obj}BASE -outline $look(objectframe4)
  			}
! 			set _($self:select_by) "click"
  		    #}    		
  		#}
--- 1825,1852 ----
  			# may need to call canvas_select_object here to work out 
  			# the shift+click selection
! 			if {[llength $@selection] == 1} {
! 				#puts "____complete [lindex $@selection 0] first!____"
! 				set old_obj [lindex $@selection 0]
! 				if {$@select_by == "click"} {
  					object_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 {}
  			}
! 			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"
  		    #}    		
  		#}
***************
*** 1891,1895 ****
  		
  	    }
! 	    set _($self:action) move
  	}
        }
--- 1854,1858 ----
  		
  	    }
! 	    set @action move
  	}
        }
***************
*** 1905,1909 ****
  	#$canvas itemconfigure ${obj}BASE -outline $look(wirefg2)
  	$canvas itemconfigure $id -fill $look(wirefg2)
! 	set _($self:selection_wire) $id
  	# my wire click select end
  	return
--- 1868,1872 ----
  	#$canvas itemconfigure ${obj}BASE -outline $look(wirefg2)
  	$canvas itemconfigure $id -fill $look(wirefg2)
! 	set @selection_wire $id
  	# my wire click select end
  	return
***************
*** 1912,1938 ****
  	if {$edit} {
  	# my object edit mode code begins --chun
! 		if {[info exists _($self:obj_in_edit)]} {
! 			if {$_($self:obj_in_edit) > 0} {
! 				object_complete [lindex $_($self:selection) 0] $canvas
! 				set _($self:obj_in_edit) 0
  			}
  		}
! 		if {[llength $_($self:selection)] > 0} {
  			#puts "dehightlight all!!!!!"
! 			foreach obj $_($self:selection) {
  				$canvas itemconfigure ${obj}BASE -outline $look(objectframe3)
  			}
! 			set _($self:selection) {}
  		}
! 		if {[llength $_($self:selection_wire)] > 0} {
  			#puts "dehightlight all wires!!!!!"
! 			foreach wire $_($self:selection_wire) {
  				$canvas itemconfigure $wire -fill $look(wirefg)
  			}
! 			set _($self:selection_wire) {}
  		}
  		focus $canvas
  		# my object edit mode code ends
! 		set _($self:action) rect
  		$canvas create line $cx $cy $cx $cy $cx $cy $cx $cy $cx $cy -tags selrect
  		global OS
--- 1875,1901 ----
  	if {$edit} {
  	# my object edit mode code begins --chun
! 		if {[info exists @obj_in_edit]} {
! 			if {$@obj_in_edit > 0} {
! 				object_complete [lindex $@selection 0] $canvas
! 				set @obj_in_edit 0
  			}
  		}
! 		if {[llength $@selection] > 0} {
  			#puts "dehightlight all!!!!!"
! 			foreach obj $@selection {
  				$canvas itemconfigure ${obj}BASE -outline $look(objectframe3)
  			}
! 			set @selection {}
  		}
! 		if {[llength $@selection_wire] > 0} {
  			#puts "dehightlight all wires!!!!!"
! 			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
  		global OS
***************
*** 1951,1966 ****
  
  proc canvas_mouseup {canvas x y b} {
!     canvas_mouseup2 $canvas $x $y $b
!     statusbar_update [canvastosym $canvas] $x $y
  }
  
! proc canvas_mouseup2 {name x y b} {
!     #puts "canvas_mouseup2::: $name $x $y $b"
      global canvas_mouseup wire_from wire_to _ font look offset_wire
!     set canvas $name
      set cx [$name canvasx $x]
      set cy [$name canvasy $y]
-     set self [canvastosym $name]
-     
      if {[llength $wire_from]} {
          if {[llength $wire_to]} {
--- 1914,1929 ----
  
  proc canvas_mouseup {canvas x y b} {
!     set self [canvastosym $canvas]
!     puts "canvas_mouseup::: $canvas $x $y $b"
!     canvas_mouseup2 $self $x $y $b
!     statusbar_update $self $x $y
  }
  
! def canvas mouseup2 {x y b} {
      global canvas_mouseup wire_from wire_to _ font look offset_wire
!     set canvas $self.c
!     set name $canvas
      set cx [$name canvasx $x]
      set cy [$name canvasy $y]
      if {[llength $wire_from]} {
          if {[llength $wire_to]} {
***************
*** 1975,1981 ****
  	
  		#tmp only, generates id for wires
! 		set wire_id [format %x [expr 0x80f8ea8 - $offset_wire]];
  		set wire_id l$wire_id
- 	
  		set from [lindex $wire_from 0]
  		set outlet_number [lindex $wire_from 1]
--- 1938,1943 ----
  	
  		#tmp only, generates id for wires
! 		set wire_id l[format %x [expr 0x80f8ea8 - $offset_wire]]
  		set wire_id l$wire_id
  		set from [lindex $wire_from 0]
  		set outlet_number [lindex $wire_from 1]
***************
*** 2061,2079 ****
      	
      		foreach obj $selected_objs {
!     			set i [lsearch $_($self:selection) $obj]
!     			if {$i<0} {lappend _($self:selection) $obj} 
      		}
  		
  		#foreach wire $wires {
!     		#	set i [lsearch $_($self:selection_wire) $wire]
!     		#	if {$i<0} {lappend _($self:selection_wire) $wire} 
      		#}
  		
! 		set _($self:selection_wire) $wires
  		
  		#----handles the wire----
! 		#set _($self:inlets)  $ins
!     		#set _($self:outlets) $outs
! 		foreach obj $_($self:selection) {
  			for {set x 0} {$x<$_($obj:inlets)} {incr x} {
  				#if {[info exists]}
--- 2023,2041 ----
      	
      		foreach obj $selected_objs {
!     			set i [lsearch $@selection $obj]
!     			if {$i<0} {lappend @selection $obj} 
      		}
  		
  		#foreach wire $wires {
!     		#	set i [lsearch $@selection_wire $wire]
!     		#	if {$i<0} {lappend @selection_wire $wire} 
      		#}
  		
! 		set @selection_wire $wires
  		
  		#----handles the wire----
! 		#set @inlets  $ins
!     		#set @outlets $outs
! 		foreach obj $@selection {
  			for {set x 0} {$x<$_($obj:inlets)} {incr x} {
  				#if {[info exists]}
***************
*** 2086,2091 ****
  						#wire_update $wire_id $_($wire_id) 
  						#wire_draw2 $wire_id $canvas
! 						set i [lsearch $_($self:selection_wire) $wire_id]
! 						if {$i<0} {lappend _($self:selection_wire) $wire_id} 
  					}
  				}
--- 2048,2053 ----
  						#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} 
  					}
  				}
***************
*** 2097,2122 ****
  						#wire_update $wire_id $_($wire_id) 
  						#wire_draw2 $wire_id $canvas
! 						set i [lsearch $_($self:selection_wire) $wire_id]
! 						if {$i<0} {lappend _($self:selection_wire) $wire_id} 
  					}
  				}
  			}
  		}
! 		#puts "self:selection --> $_($self:selection)"
! 		#puts "self:wire_selection --> $_($self:selection_wire)"
!     		foreach obj $_($self:selection) {
      			#puts "${obj}BASE :: $canvas"
      			$canvas itemconfigure ${obj}BASE -outline $look(objectframe4)
      		}
! 		foreach wire $_($self:selection_wire) {
  			$canvas itemconfigure $wire -fill $look(wirefg2)
  		}
!     		set _($self:select_by) "selrect"
  	} {
  		#puts "dehightlight all!!!!!"
!       		#foreach obj $_($self:selection) {
        		#$canvas itemconfigure ${obj}BASE -outline $look(objectframe3)
        		#}
!       		#set _($self:selection) {}
  	}
  	# my selrect code ends
--- 2059,2084 ----
  						#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} 
  					}
  				}
  			}
  		}
! 		#puts "@selection --> $@selection"
! 		#puts "@selection_wire --> $@selection_wire"
!     		foreach obj $@selection) {
      			#puts "${obj}BASE :: $canvas"
      			$canvas itemconfigure ${obj}BASE -outline $look(objectframe4)
      		}
! 		foreach wire $@selection_wire {
  			$canvas itemconfigure $wire -fill $look(wirefg2)
  		}
!     		set @select_by "selrect"
  	} {
  		#puts "dehightlight all!!!!!"
!       		#foreach obj $@selection {
        		#$canvas itemconfigure ${obj}BASE -outline $look(objectframe3)
        		#}
!       		#set @selection {}
  	}
  	# my selrect code ends
***************
*** 2124,2141 ****
      }
      
!     if {[llength $_($self:selection)]==1} {
      	#puts "___only one obj selected by click!!!"
      
! 	#pd "$self gobj-activate x$_($self:selection);"
! 	#puts "____ selected by ->$_($self:select_by) ____"
  	
! 	if {$_($self:select_by) == "click"} {
  	
! 		switch $_($_($self:selection):class) {
  		
  		objectbox {
! 		if {$_($self:obj_in_edit) == 0} {
! 			set _($self:obj_in_edit) 1
! 			object_edit [lindex $_($self:selection) 0] $canvas
      		}
  		}
--- 2086,2103 ----
      }
      
!     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) {
  		
  		objectbox {
! 		if {$@obj_in_edit == 0} {
! 			set @obj_in_edit 1
! 			object_edit [lindex $@selection 0] $canvas
      		}
  		}
***************
*** 2143,2156 ****
  		}
  	}
!     	#object_edit $_($self:edit_object) $canvas
      }
!     set edit 0; switch $_($self:mode) { edit { set edit 1 } }
      set run [expr !$edit]
  
      #not sure what this does 
!     #puts "mouseup2::: _($self:focus) => $_($self:focus)"
      
!     if {[string length $_($self:focus)]} {
! 	set id $_($self:focus)
          if {$run} {
          	#puts "====== drag drag drag ======"
--- 2105,2118 ----
  		}
  	}
!     	#object_edit $@edit_object $canvas
      }
!     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
          if {$run} {
          	#puts "====== drag drag drag ======"
***************
*** 2165,2169 ****
      }
  
!     set edit 0; switch $_($self:mode) { edit { set edit 1 } }
      foreach {type id} [identify_target $canvas $cx $cy -1 -1 "blah "] {}
  
--- 2127,2131 ----
      }
  
!     set edit 0; switch $@mode { edit { set edit 1 } }
      foreach {type id} [identify_target $canvas $cx $cy -1 -1 "blah "] {}
  
***************
*** 2206,2210 ****
      }
      canvas_checkgeometry [canvastosym $name]
!     set _($self:action) none
  }
  
--- 2168,2172 ----
      }
      canvas_checkgeometry [canvastosym $name]
!     set @action none
  }
  





More information about the Pd-cvs mailing list