pd/src desire.tk,1.1.2.59,1.1.2.60 - Pd-cvs

15 Sep 2005


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25097
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
... and stuff
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.59
retrieving revision 1.1.2.60
diff -C2 -d -r1.1.2.59 -r1.1.2.60
*** desire.tk	15 Sep 2005 11:23:15 -0000	1.1.2.59
--- desire.tk	15 Sep 2005 19:21:04 -0000	1.1.2.60
***************
*** 884,906 ****
  class_new canvas
  def* canvas init {width height geometry editable} {
!     global pd_opendir pd_tearoff OS cmdline canvasmenu _
      set name .x$self
-     # focus should be set to either always a _ object or always a tk object. else we'll run into trouble. what do we do here? --matju
      set _(focus) $self
      toplevel $name -menu $name.m
      wm geometry $name $geometry
      canvas $name.c -width $width -height $height -background white \
!     	-yscrollcommand "$name.scrollvert set" \
!     	-xscrollcommand "$name.scrollhort set" \
    -scrollregion [list 0 0 $width $height] 
!     scrollbar $name.scrollvert -command "$name.c yview"
!     scrollbar $name.scrollhort -command "$name.c xview" -orient horizontal
!     if {[string compare $cmdline(icons) ""]} {
! 	make_button_bar $name.bbar $name
! 	pack $name.bbar -side top -fill x -expand no
!     }
!     statusbar_new $self
!     pack $name.scrollhort -side bottom -fill x
!     pack $name.scrollvert -side  right -fill y
      pack $name.c -side left -expand 1 -fill both
      wm minsize $name 1 1
--- 884,900 ----
  class_new canvas
  def* canvas init {width height geometry editable} {
!     global pd_opendir pd_tearoff OS cmdline canvasmenu
      set name .x$self
      set _(focus) $self
      toplevel $name -menu $name.m
      wm geometry $name $geometry
      canvas $name.c -width $width -height $height -background white \
!     	-yscrollcommand "$name.yscroll set" \
!     	-xscrollcommand "$name.xscroll set" \
    -scrollregion [list 0 0 $width $height] 
!     pack [make_button_bar $name.bbar $name] -side top -fill x -expand no
!     pack [statusbar_new $self] -side bottom -fill x
!     pack [scrollbar $name.xscroll -command "$name.c xview" -orient horizontal] -side bottom -fill x
!     pack [scrollbar $name.yscroll -command "$name.c yview"] -side  right -fill y
      pack $name.c -side left -expand 1 -fill both
      wm minsize $name 1 1
***************
*** 913,917 ****
    {"Help"       {popup_help       [canvastosym %W]} ""}
      }
- 
      wm protocol $name WM_DELETE_WINDOW "menu_close $name"
      $self new_binds
--- 907,910 ----
***************
*** 988,994 ****
  }
! def canvas scroll {axis diff} {
!     .x$self.c [list $axis]view scroll $diff units
! }
def canvas new_menubar {editable} {
--- 981,985 ----
  }
! def canvas scroll {axis diff} {.x$self.c [list $axis]view scroll $diff units}
def canvas new_menubar {editable} {
***************
*** 1082,1088 ****
      # for quit/save/undo
      switch -- $key {
!       q {if {$shift} {menu_really_quit}     {menu_quit};          return}
!       s {if {$shift} {menu_saveas $topname} {menu_save $topname}; return}
!       z {if {$shift} {menu_redo $topname}   {menu_undo $topname}; return}
      }
      if {[info exists accels(ctrl+$key)]} {
--- 1073,1079 ----
      # for quit/save/undo
      switch -- $key {
!       q {if {$shift} {menu_really_quit} {menu_quit};      return}
!       s {if {$shift} {menu_saveas $top} {menu_save $top}; return}
!       z {if {$shift} {menu_redo $top}   {menu_undo $top}; return}
      }
      if {[info exists accels(ctrl+$key)]} {
***************
*** 1152,1159 ****
          set y2 [expr $y1+$ys]
          set xya [list $x1 $y1 $x2 $y2]
!         set xyb [list [expr $x2-1] [expr $y1+1] [expr $x1+1] [expr $y1+1] [expr $x1+1] [expr $y2-1]]
!         set xyc [list [expr $x2-1] [expr $y1+1] [expr $x2-1] [expr $y2-1] [expr $x1+1] [expr $y2-1]]
!         set xyd [list [expr $x1+4] [expr $y1+4] [expr $x2+4] [expr $y2+4]]
!         #shadow_draw $self $canvas $xya
    item $self $canvas BASE  rectangle $xya -fill $look(objectbg)
    item $self $canvas BASE2 line      $xyb -fill $look(objectframe2)
--- 1143,1149 ----
          set y2 [expr $y1+$ys]
          set xya [list $x1 $y1 $x2 $y2]
! 	set xyb [l+ [list $x2 $y1 $x1 $y1 $x1 $y2] [list -1 +1 +1 +1 +1 -1]]
! 	set xyc [l+ [list $x2 $y1 $x2 $y2 $x1 $y2] [list -1 +1 -1 -1 +1 -1]]
! 	#shadow_draw $self $canvas $xya
    item $self $canvas BASE  rectangle $xya -fill $look(objectbg)
    item $self $canvas BASE2 line      $xyb -fill $look(objectframe2)
***************
*** 1170,1177 ****
  }
- #----------------------------------------------------------------------------------
  #this just tells whether an object is part of the selection, that is, what usually 
  #make objects turn blue.
- 
  def canvas selected? {member} {
      set i [lsearch $@selection $member]
--- 1160,1165 ----
***************
*** 1184,1191 ****
      set nplus [expr $n==1 ? 1 : $n-1]
      foreach {x1 y1} [$self xy $canvas] {}
-     set xs $@xs
-     set ys $@ys
-     set x2 [expr $x1+$xs]
-     set y2 [expr $y1+$ys]
      set c .x$canvas.c
      for {set i 0} {$i<$n} {incr i} {
--- 1172,1175 ----
***************
*** 1236,1241 ****
    global look font
    set @text $text
! 	objectbox_update_size $self
! 	objectbox_draw $self $canvas
    set t .x$canvas.c.${self}text
    text $t -height 1 -width [llength $@text] -relief flat \
--- 1220,1225 ----
    global look font
    set @text $text
! 	$self update_size
! 	$self draw $canvas
    set t .x$canvas.c.${self}text
    text $t -height 1 -width [llength $@text] -relief flat \
***************
*** 1514,1518 ****
    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
  }
--- 1498,1502 ----
    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
! 	return $f
  }
***************
*** 1725,1729 ****
      }
      if {[llength [$c gettags selrect]] > 0} {
-     	#puts "___figure out what objects are in selrect!!!"
          set coords [$c coords selrect]
    set x1 [lindex $coords 0]
--- 1709,1712 ----
***************
*** 1731,1747 ****
    set x2 $cx
    set y2 $cy
! 	
! 	#puts "selrect area ::: $x1 $y1, $x2 $y2"
! 	# my selrect code begins --chun
!   	set selrect_id [$c find withtag selrect]
!   	#puts "selrect's id ::: $selrect_id"
    set selected_elements [$c find overlapping $x1 $y1 $x2 $y2]
-         #puts "elements in selrect --> $selected_elements"
          set selrect_index [lsearch $selected_elements $selrect_id]
-         #puts "selrect's index ::: $selrect_index"
-         #removes selrect from the list of selected elements
          set selected_elements [lreplace $selected_elements $selrect_index $selrect_index]
-         #puts "elements in selrect --> $selected_elements"
-         
          if {[llength $selected_elements]} {
          	set element_tags {}
--- 1714,1721 ----
    set x2 $cx
    set y2 $cy
! 	set selrect_id [$c find withtag selrect]
    set selected_elements [$c find overlapping $x1 $y1 $x2 $y2]
          set selrect_index [lsearch $selected_elements $selrect_id]
          set selected_elements [lreplace $selected_elements $selrect_index $selrect_index]
          if {[llength $selected_elements]} {
          	set element_tags {}
***************
*** 1753,1777 ****
    	set wires {}
      		foreach tag $element_tags {
! 			if {[regexp {^([a-f0-9]{6,8})} $tag id]} {
! 				lappend ids $id
! 			}
    		# this would make things shorter		
    		# if {[regexp {^l([a-f0-9]{6,8})} [$c gettags $tag] id]}
! 			#if {[regexp {^l([a-f0-9]{6,8})} $tag wire_id]} {
! 			#	
! 			#	lappend wires $wire_id
! 			#}
      		}
-     	
-     		#puts "ids in selrect --> $ids"
- 		#puts "wires in selrect --> $wires"
      		set selected_objs [lsort -unique $ids]
!     		#puts "selected_objs --> $selected_objs"
!     	
!     		foreach obj $selected_objs {
      			set i [lsearch $@selection $obj]
      			if {$i<0} {lappend @selection $obj} 
      		}
- 		
    	#foreach wire $wires {
      		#	set i [lsearch $@selection_wire $wire]
--- 1727,1740 ----
    	set wires {}
      		foreach tag $element_tags {
! 			if {[regexp {^([a-f0-9]{6,8})} $tag id]} {lappend ids $id}
    		# this would make things shorter		
    		# if {[regexp {^l([a-f0-9]{6,8})} [$c gettags $tag] id]}
! 			#if {[regexp {^l([a-f0-9]{6,8})} $tag wire_id]} {lappend wires $wire_id}
      		}
      		set selected_objs [lsort -unique $ids]
! 		foreach obj $selected_objs {
      			set i [lsearch $@selection $obj]
      			if {$i<0} {lappend @selection $obj} 
      		}
    	#foreach wire $wires {
      		#	set i [lsearch $@selection_wire $wire]
***************
*** 1781,1787 ****
    	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} {
--- 1744,1747 ----
***************
*** 1789,1795 ****
    			#puts "check -> $obj"
    			if {[info exists _($obj:i:$x)]} {
- 					#puts "wires at inlet $x to select --> $_($obj:i:$x)"
- 					#wire_update $_()
- 					#wire_update:: l80f8ea8 81168ae 1 81168af 0 0
    				foreach wire_id $_($obj:i:$x) {
    					#wire_update $wire_id $_($wire_id) 
--- 1749,1752 ----
***************
*** 1802,1806 ****
    		for {set x 0} {$x<$_($obj:outlets)} {incr x} {
    			if {[info exists _($obj:o:$x)]} {
- 					#puts "wires at outlet $x to update --> $_($obj:o:$x)"
    				foreach wire_id $_($obj:o:$x) {
    					#wire_update $wire_id $_($wire_id) 
--- 1759,1762 ----
***************
*** 1812,1828 ****
    		}
    	}
! 		#puts "@selection --> $@selection"
! 		#puts "@selection_wire --> $@selection_wire"
!     		foreach obj $@selection) {
!     			$c itemconfigure ${obj}BASE -outline $look(objectframe4)
!     		}
! 		foreach wire $@selection_wire {
! 			$c itemconfigure $wire -fill $look(wirefg2)
! 		}
      		set @select_by "selrect"
    } {
!       		#foreach obj $@selection {
!       		#$c itemconfigure ${obj}BASE -outline $look(objectframe3)
!       		#}
        		#set @selection {}
    }
--- 1768,1776 ----
    		}
    	}
!     		foreach obj  $@selection      {$c itemconfigure ${obj}BASE -outline $look(objectframe4)}
! 		foreach wire $@selection_wire {$c itemconfigure $wire -fill $look(wirefg2)}
      		set @select_by "selrect"
    } {
!       		#foreach obj $@selection {$c itemconfigure ${obj}BASE -outline $look(objectframe3)}
        		#set @selection {}
    }
***************
*** 2889,2892 ****
--- 2837,2841 ----
    #$self.name configure -state disabled
    pack $self.name -side right
+ 	return $self
  }