pd/src desire.tk,1.1.2.322,1.1.2.323 - Pd-cvs

13 Aug 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21854
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
cleanup
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.322
retrieving revision 1.1.2.323
diff -C2 -d -r1.1.2.322 -r1.1.2.323
*** desire.tk	13 Aug 2006 05:50:47 -0000	1.1.2.322
--- desire.tk	13 Aug 2006 06:16:23 -0000	1.1.2.323
***************
*** 2110,2114 ****
    set @selection_wire {}
    #if {$@selection_wire != ""} {
! 	#foreach wire $@selection_wire {$wire select 0}
    #}
    set @select_by ""
--- 2110,2114 ----
    set @selection_wire {}
    #if {$@selection_wire != ""} {
! 	#foreach wire $@selection_wire {$wire selected?= 0}
    #}
    set @select_by ""
***************
*** 2325,2329 ****
    	}
    	# hilite wire
! 		foreach wire $@selection_wire {$wire select 1}
    }
    set @select_by "selrect"
--- 2325,2329 ----
    	}
    	# hilite wire
! 		foreach wire $@selection_wire {$wire selected?= 1}
    }
    set @select_by "selrect"
***************
*** 2447,2451 ****
    set group ""
    set distances ""
- 	puts "current:::: $@keynav_current"
    set find [lsearch $@children $@keynav_current]
    set children [lreplace $@children $find $find]
--- 2447,2450 ----
***************
*** 2453,2463 ****
    set max 100
    
! 	set x1 $_($@keynav_current:x1)
! 	set y1 $_($@keynav_current:y1)
! 	switch $direction {
! 	up {
! 		while {![llength $group]} {
! 		set left [expr $_($@keynav_current:x1) - ($_($@keynav_current:xs) * $off)]
! 		set right [expr ($_($@keynav_current:x1) + $_($@keynav_current:xs)) + ($_($@keynav_current:xs) * $off)]
    	foreach item $children {
    	if {$_($item:y1) < $y1} {
--- 2452,2462 ----
    set max 100
    
! 	set x1 $_($@keynav_current:x1); set xs $_($@keynav_current:xs)
! 	set y1 $_($@keynav_current:y1); set ys $_($@keynav_current:ys)
! 	while {![llength $group]} {
! 	  switch $direction {
! 	    up {
! 		set left [expr $x1 - ($xs * $off)]
! 		set right [expr ($x1 + $xs) + ($xs * $off)]
    	foreach item $children {
    	if {$_($item:y1) < $y1} {
***************
*** 2471,2483 ****
    	}
    	}
! 		incr off
! 		#puts "incr ----> $off"
! 		if {$off == $max} {break}
! 		}
! 	}
! 	down {
! 		while {![llength $group]} {
! 		set left [expr $_($@keynav_current:x1) - ($_($@keynav_current:xs) * $off)]
! 		set right [expr ($_($@keynav_current:x1) + $_($@keynav_current:xs)) + ($_($@keynav_current:xs) * $off)]
    	foreach item $children {
    	if {$_($item:y1) > $y1} {
--- 2470,2477 ----
    	}
    	}
! 	    }
! 	    down {
! 		set left [expr $x1 - ($xs * $off)]
! 		set right [expr ($x1 + $xs) + ($xs * $off)]
    	foreach item $children {
    	if {$_($item:y1) > $y1} {
***************
*** 2491,2503 ****
    	}
    	}
! 		incr off
! 		#puts "incr ----> $off"
! 		if {$off == $max} {break}
! 		}
! 	}
! 	right {
! 		while {![llength $group]} {
! 		set top [expr $_($@keynav_current:y1) + ($_($@keynav_current:ys) * $off)]
! 		set bottom [expr ($_($@keynav_current:y1) - $_($@keynav_current:ys)) - ($_($@keynav_current:ys) * $off)]
    	foreach item $children {
    	if {$_($item:x1) > $x1} {
--- 2485,2492 ----
    	}
    	}
! 	    }
! 	    right {
! 		set top [expr $y1 + ($ys * $off)]
! 		set bottom [expr ($y1 - $ys) - ($ys * $off)]
    	foreach item $children {
    	if {$_($item:x1) > $x1} {
***************
*** 2511,2523 ****
    	}
    	}
! 		incr off
! 		#puts "incr ----> $off"
! 		if {$off == $max} {break}
! 		}
! 	}
! 	left {
! 		while {![llength $group]} {
! 		set top [expr $_($@keynav_current:y1) + ($_($@keynav_current:ys) * $off)]
! 		set bottom [expr ($_($@keynav_current:y1) - $_($@keynav_current:ys)) - ($_($@keynav_current:ys) * $off)]
    	foreach item $children {
    	if {$_($item:x1) < $x1} {
--- 2500,2507 ----
    	}
    	}
! 	    }
! 	    left {
! 		set top [expr $y1 + ($ys * $off)]
! 		set bottom [expr ($y1 - $ys) - ($ys * $off)]
    	foreach item $children {
    	if {$_($item:x1) < $x1} {
***************
*** 2531,2564 ****
    	}
    	}
! 		incr off
! 		#puts "incr ----> $off"
! 		if {$off == $max} {break}
! 		}
! 	}
    }
- 	
- 	puts "group:::: $group"
- 	
    if {[llength $group] > 0} {
    	set closest [lindex $distances 0]
    	for {set i 1} {$i<[llength $distances]} {incr i} {
! 		set val [lindex $distances $i]
! 		if {$val < $closest} {set closest [lindex $distances $i]}
    	}
    	set index [lsearch $distances $closest]
    	set @keynav_next [lindex $group $index]
! 		} else {
    	set @keynav_next [lindex $@selection end end]
! 		}
! 		
    if {!$shift} {
! 	set find [lsearch $@selection $@keynav_current]
! 	set @selection [lreplace $@selection $find $find]
! 	$@keynav_current selected?= 0
    }
    if {[lsearch $@selection $@keynav_next] < 0} {lappend @selection $@keynav_next}
    $@keynav_next selected?= 1
    set @keynav_current $@keynav_next
- 	
  }
--- 2515,2542 ----
    	}
    	}
! 	    }
! 	  }
! 	  incr off
! 	  if {$off == $max} {break}
    }
    if {[llength $group] > 0} {
    	set closest [lindex $distances 0]
    	for {set i 1} {$i<[llength $distances]} {incr i} {
! 			set val [lindex $distances $i]
! 			if {$val < $closest} {set closest [lindex $distances $i]}
    	}
    	set index [lsearch $distances $closest]
    	set @keynav_next [lindex $group $index]
! 	} else {
    	set @keynav_next [lindex $@selection end end]
! 	}
    if {!$shift} {
! 		set find [lsearch $@selection $@keynav_current]
! 		set @selection [lreplace $@selection $find $find]
! 		$@keynav_current selected?= 0
    }
    if {[lsearch $@selection $@keynav_next] < 0} {lappend @selection $@keynav_next}
    $@keynav_next selected?= 1
    set @keynav_current $@keynav_next
  }
***************
*** 2614,2621 ****
  }
! def* Canvas incr_zoom {} {$self zoom "in"}
! def* Canvas decr_zoom {} {$self zoom "out"}
! 
! def* Canvas zoom {mode} {
    global scale
    set spinbox .$self.bbar.scale
--- 2592,2598 ----
  }
! def Canvas incr_zoom {} {$self zoom "in"}
! def Canvas decr_zoom {} {$self zoom "out"}
! def Canvas zoom {mode} {
    global scale
    set spinbox .$self.bbar.scale
***************
*** 2670,2679 ****
      }
      #if {$iso != ""} {scan $iso %c key}
-     #puts "focus = $@focus"
      if {$key == "BackSpace" || $key == "Delete" || $key == "KP_Delete"} {
! 	if {[llength $@selection] > 0} {
! 		puts "delete objects!!!"
! 		$self delete_selection
! 	}
    if {[llength $@selection_wire] > 0} {
    	puts "delete this $self :: $@selection_wire"
--- 2647,2652 ----
      }
      #if {$iso != ""} {scan $iso %c key}
      if {$key == "BackSpace" || $key == "Delete" || $key == "KP_Delete"} {
! 	if {[llength $@selection] > 0} {$self delete_selection}
    if {[llength $@selection_wire] > 0} {
    	puts "delete this $self :: $@selection_wire"
***************
*** 2888,2896 ****
  }
! #def* Wire select {flag} {
  #	if {$flag} {set colour [look wirefg2]} {set colour [look wirefg]}
  #	.$@canvas.c itemconfigure ${self}WIRE -fill $colour
  #}
def Wire update {source outlet target inlet kind} {
    set @source $source
--- 2861,2870 ----
  }
! #def* Wire selected?= {flag} {
  #	if {$flag} {set colour [look wirefg2]} {set colour [look wirefg]}
  #	.$@canvas.c itemconfigure ${self}WIRE -fill $colour
  #}
+ #!@#$ what's this? doesn't match the name of instance variables.
  def Wire update {source outlet target inlet kind} {
    set @source $source
***************
*** 2902,2905 ****
--- 2876,2880 ----
  }
+ #!@#$ should it be called delete or _delete ?
  def Wire delete {} {
    set c .$@canvas.c
***************
*** 2907,2915 ****
    $@obj2 delete_wire $self
    #super
! 	# i don't know why wires are taged as 00000000WIRE...
! 	# not sure why $self erase don't work, look later...
    #$self erase
    $c delete ${self}WIRE
- 
  }
--- 2882,2888 ----
    $@obj2 delete_wire $self
    #super
! 	#!@#$ not sure why $self erase don't work, look later...
    #$self erase
    $c delete ${self}WIRE
  }
***************
*** 2962,2967 ****
# real classes
- #set fields(obj)    [eval list $fields1]
- #set fields(msg) {foo bar x1 y1}
  set fields(tgl)    [eval list $fields1    w                  isa   $fields2 on nonzero]
  set fields(bng)    [eval list $fields1    w hold break       isa   $fields2]
--- 2935,2938 ----
***************
*** 3070,3077 ****
    }
    update_object_3 $self $mess
-   #-------------------------------------------------------------
-   # maybe this $self changed should be changed, so that when loading a file, changed won't
-   # call the drawing method twice... -- chun
-   # excuse me. why would it be called twice? -- matju
    $self changed
  }
--- 3041,3044 ----
***************
*** 3100,3104 ****
    		}
    	}
! 	} 
  }
--- 3067,3071 ----
    		}
    	}
! 	}
  }
***************
*** 3116,3120 ****
  class_new MessageBox {TextBox}
! def* MessageBox init {args} {
    super
    set @valid 0
--- 3083,3087 ----
  class_new MessageBox {TextBox}
! def MessageBox init {args} {
    super
    set @valid 0
***************
*** 3135,3139 ****
  }
! def* MessageBox draw {} {
    super
    io_draw $self
--- 3102,3106 ----
  }
! def MessageBox draw {} {
    super
    io_draw $self
***************
*** 3146,3150 ****
  }
! def* MessageBox click {x y b f} {
    $self bang 1
    $@canvas focus= $self
--- 3113,3117 ----
  }
! def MessageBox click {x y b f} {
    $self bang 1
    $@canvas focus= $self
***************
*** 3153,3157 ****
  }
! def* MessageBox unclick {x y mod} {
    $@canvas focus= ""
  }
--- 3120,3124 ----
  }
! def MessageBox unclick {x y mod} {
    $@canvas focus= ""
  }
***************
*** 3165,3169 ****
  # it shouldn't have mattered, but super doesn't support proper pruning yet
  class_new AtomBox {Box}
! def* AtomBox draw_box {} {
    global font
    mset {x1 y1} [$self xy]
--- 3132,3136 ----
  # it shouldn't have mattered, but super doesn't support proper pruning yet
  class_new AtomBox {Box}
! def AtomBox draw_box {} {
    global font
    mset {x1 y1} [$self xy]
***************
*** 3178,3182 ****
  }
! def* AtomBox draw {} {
    super
    mset {x1 y1} [$self xy]
--- 3145,3149 ----
  }
! def AtomBox draw {} {
    super
    mset {x1 y1} [$self xy]
***************
*** 3228,3232 ****
  }
! def* BlueBox popup_properties {} {IEMPropertiesDialog new $self}
class_new PropertiesDialog {Dialog}
--- 3195,3199 ----
  }
! def BlueBox popup_properties {} {IEMPropertiesDialog new $self}
class_new PropertiesDialog {Dialog}
***************
*** 3239,3243 ****
  class_new IEMPropertiesDialog {PropertiesDialog}
! def* IEMPropertiesDialog apply {} {
    global fields classinfo
    set class $_($@of:class)
--- 3206,3210 ----
  class_new IEMPropertiesDialog {PropertiesDialog}
! def IEMPropertiesDialog apply {} {
    global fields classinfo
    set class $_($@of:class)
***************
*** 3271,3275 ****
  }
! def* IEMPropertiesDialog init {of} {
    global classinfo fields
    super $of
--- 3238,3242 ----
  }
! def IEMPropertiesDialog init {of} {
    global classinfo fields
    super $of
***************
*** 3351,3355 ****
  class_new CanvasPropertiesDialog {PropertiesDialog}
! def* CanvasPropertiesDialog init {of} {
    super $of
    #X coords 0 0 1 1 100 100 1 100 200;
--- 3318,3322 ----
  class_new CanvasPropertiesDialog {PropertiesDialog}
! def CanvasPropertiesDialog init {of} {
    super $of
    #X coords 0 0 1 1 100 100 1 100 200;
***************
*** 3371,3379 ****
  }
! def* CanvasPropertiesDialog apply {} {
      pd ".$self donecanvasdialog $@xscale $@yscale $@graphme ;"
  }
! def* CanvasPropertiesDialog cancel {id} {pd ".$self cancel ;"}
set properties(gatom) {
--- 3338,3346 ----
  }
! def CanvasPropertiesDialog apply {} {
      pd ".$self donecanvasdialog $@xscale $@yscale $@graphme ;"
  }
! def CanvasPropertiesDialog cancel {id} {pd ".$self cancel ;"}
set properties(gatom) {
***************
*** 3514,3530 ****
    set @clickpos {}
    set @key_input 0
- 	#set @isnew 1
- }
- 
- def* FloatAtom init {args} {
- 	eval [concat [list super] $args]
- 	set @text 0
- }
- 
- def SymbolAtom init {args} {
- 	eval [concat [list super] $args]
- 	set @text "symbol"
  }
def* AtomBox   canonize {x} {return x}
  def* FloatAtom canonize {x} {return [expr $x]}
--- 3481,3488 ----
    set @clickpos {}
    set @key_input 0
  }
+ def* FloatAtom init {args} {eval [concat [list super] $args]; set @text 0}
+ def SymbolAtom init {args} {eval [concat [list super] $args]; set @text "symbol"}
  def* AtomBox   canonize {x} {return x}
  def* FloatAtom canonize {x} {return [expr $x]}
***************
*** 3536,3541 ****
    		$@canvas focus= ""
    		pd .$self set [$self canonize $@val]
! 			pd .$self set $@val
! 			pd .$self bang
    		set @text $@val
    		$self selected?= 0
--- 3494,3499 ----
    		$@canvas focus= ""
    		pd .$self set [$self canonize $@val]
! 			#pd .$self set $@val
! 			#pd .$self bang
    		set @text $@val
    		$self selected?= 0
***************
*** 3605,3609 ****
  def AtomBox update_size {} {
    global font
- 	#set @textwidth [expr $font(padx)+$font(width)*[string length $@val]]
    if {!$@w} {set @w 5}
    set textwidth [expr $font(padx)+$font(width)*$@w]
--- 3563,3566 ----
***************
*** 3614,3623 ****
  }
! def* AtomBox click {x y b f} {
    set c .$@canvas.c
    set @clickpos [list $x $y]
    set @mouse [list $x $y]
    set t .$@canvas.c.${self}text
- 	#.$@canvas.c itemconfigure $t -state disabled
    $@canvas focus= $self
    set @rate [expr $f&1 ? 0.01 : 1.00]
--- 3571,3579 ----
  }
! def AtomBox click {x y b f} {
    set c .$@canvas.c
    set @clickpos [list $x $y]
    set @mouse [list $x $y]
    set t .$@canvas.c.${self}text
    $@canvas focus= $self
    set @rate [expr $f&1 ? 0.01 : 1.00]
***************
*** 3626,3630 ****
  }
! def* AtomBox unclick {x y b} {
    set @clicking 0
    if {[lindex $@clickpos 0] == $x && [lindex $@clickpos 1] == $y} {
--- 3582,3586 ----
  }
! def AtomBox unclick {x y b} {
    set @clicking 0
    if {[lindex $@clickpos 0] == $x && [lindex $@clickpos 1] == $y} {
***************
*** 3640,3644 ****
  }
! def* FloatAtom motion {x y mod} {
    set focused [$self == [$@canvas focus]]
    if {!$focused} {return}
--- 3596,3600 ----
  }
! def FloatAtom motion {x y mod} {
    set focused [$self == [$@canvas focus]]
    if {!$focused} {return}
***************
*** 3655,3659 ****
class_new NumBox {Labeled Box}
! def* NumBox init {args} {
    super
    eval [concat [list super] $args]
--- 3611,3615 ----
class_new NumBox {Labeled Box}
! def NumBox init {args} {
    super
    eval [concat [list super] $args]
***************
*** 3666,3670 ****
  }
! def* NumBox update_size {} {
    global font
    set textwidth [expr $font(padx)+$font(width)*[string length $@buf]]
--- 3622,3626 ----
  }
! def NumBox update_size {} {
    global font
    set textwidth [expr $font(padx)+$font(width)*[string length $@buf]]
***************
*** 3731,3735 ****
  }
! def* NumBox click {x y b f} {
    $@canvas focus= $self
    .$@canvas.c itemconfigure ${self}BASE4 -fill #00ff00
--- 3687,3691 ----
  }
! def NumBox click {x y b f} {
    $@canvas focus= $self
    .$@canvas.c itemconfigure ${self}BASE4 -fill #00ff00
***************
*** 3741,3745 ****
  }
! def* NumBox motion {x y mod} {
    set focused [$self == [$@canvas focus]]
    if {!$focused || !$@clicking} {return}
--- 3697,3701 ----
  }
! def NumBox motion {x y mod} {
    set focused [$self == [$@canvas focus]]
    if {!$focused || !$@clicking} {return}
***************
*** 3753,3759 ****
  }
! def* NumBox unfocus {} {set @buf ""; $self changed}
! def* NumBox unclick {x y b} {
    set @clicking 0
    #if {$@oval!=$@val} {
--- 3709,3715 ----
  }
! def NumBox unfocus {} {set @buf ""; $self changed}
! def NumBox unclick {x y b} {
    set @clicking 0
    #if {$@oval!=$@val} {
***************
*** 3762,3766 ****
    #	pd .$self float $@val
    #}
- 	
    if {[lindex $@clickpos 0] == $x && [lindex $@clickpos 1] == $y} {
    	$@canvas focus= $self
--- 3718,3721 ----
***************
*** 3768,3772 ****
    	set @val ""
    	set @key_input 1
! 	} { 
    	$@canvas focus= ""
    	.$@canvas.c itemconfigure ${self}BASE4 -fill [look objectbg]
--- 3723,3727 ----
    	set @val ""
    	set @key_input 1
! 	} {
    	$@canvas focus= ""
    	.$@canvas.c itemconfigure ${self}BASE4 -fill [look objectbg]
***************
*** 3777,3781 ****
  }
! def* NumBox key {key shift} {
      switch -regexp -- $key {
        ^[\d]$ {
--- 3732,3736 ----
  }
! def NumBox key {key shift} {
      switch -regexp -- $key {
        ^[\d]$ {
***************
*** 3840,3844 ****
  }
! def* Radio draw {} {
    set orient [$self orient]
    mset {x1 y1 x2 y2} [$self bbox]
--- 3795,3799 ----
  }
! def Radio draw {} {
    set orient [$self orient]
    mset {x1 y1 x2 y2} [$self bbox]
***************
*** 3994,4004 ****
  }
- #def Labeled erase {} {
- #	$@canvas delete ${self}LABEL
- #}
- 
  #-----------------------------------------------------------------------------------#
  class_new Bang {BlueBox}
! def* Bang init {args} {
    super
    set @valid 0
--- 3949,3955 ----
  }
#-----------------------------------------------------------------------------------#
  class_new Bang {BlueBox}
! def Bang init {args} {
    super
    set @valid 0
***************
*** 4073,4077 ****
  }
! def* Toggle click {x y b f} {
    pd .$self bang
    if {!$@on} {set @on 1} {set @on 0}
--- 4024,4028 ----
  }
! def Toggle click {x y b f} {
    pd .$self bang
    if {!$@on} {set @on 1} {set @on 0}
***************
*** 4081,4085 ****
  }
! def* Toggle unclick {x y b} {
    set @clicking 0
    $@canvas focus= ""
--- 4032,4036 ----
  }
! def Toggle unclick {x y b} {
    set @clicking 0
    $@canvas focus= ""
***************
*** 4171,4176 ****
class_new Dropper {View}
! def Dropper draw {} {	
!     set isnew [expr [llength [$@canvas gettags ${self}BASE]] == 0]
      mset {x1 y1} [$self xy]
      set xs $@w
--- 4122,4130 ----
class_new Dropper {View}
! 
! # somewhat broken...
! def Dropper draw {} {
!     set c .$@canvas.c
!     set isnew [expr [llength [$c gettags ${self}BASE]] == 0]
      mset {x1 y1} [$self xy]
      set xs $@w
***************
*** 4181,4193 ****
      super
      if {$isnew} {
! 	canvas $@canvas.${self}DROP -width $xs -height $xs -bg $colour \
    	-highlightbackground $lcolour -highlightcolor $colour
! 	$@canvas create window [expr $x1 + 7] [expr $y1 - 2] \
! 		-window $@canvas.${self}DROP -anchor nw -tags $@canvas.${self}window
! 	dnd bindtarget $@canvas.${self}DROP text/uri-list <Drop> \
    	"pd "x[list ${self}] symbol [ enquote %D ] ;""
      } {
! 	$@canvas coords $@canvas.${self}window [expr $x1 + 7] [expr $y1 - 2]
! 	$@canvas.${self}DROP configure -width $xs -height $xs -bg $colour \
    	-highlightbackground $lcolour -highlightcolor $colour
      }
--- 4135,4151 ----
      super
      if {$isnew} {
! 	canvas $c.${self}DROP -width $xs -height $xs -bg $colour \
    	-highlightbackground $lcolour -highlightcolor $colour
! 	$c create window [expr $x1 + 7] [expr $y1 - 2] \
! 		-window $c.${self}DROP -anchor nw -tags $c.${self}window
! 	if {[catch {
! 	    dnd bindtarget $c.${self}DROP text/uri-list <Drop> \
    	"pd "x[list ${self}] symbol [ enquote %D ] ;""
+ 	}]} {
+ 	    post "dropper: dnd not installed"
+ 	}
      } {
! 	$c coords $@canvas.${self}window [expr $x1 + 7] [expr $y1 - 2]
! 	$c.${self}DROP configure -width $xs -height $xs -bg $colour \
    	-highlightbackground $lcolour -highlightcolor $colour
      }
***************
*** 4207,4211 ****
#####################################################################################
! ############ console
proc make_console {} {
--- 4165,4169 ----
#####################################################################################
! # console
proc make_console {} {
***************
*** 4439,4444 ****
    $c create text $x $y -text $text -anchor w -tags tooltip_fg
    mset {x1 y1 x2 y2} [$c bbox tooltip_fg]
- 	set w 0
- 	set h 0
    $c create rectangle \
    	[expr $x1-$border] [expr $y1-$border] \
--- 4397,4400 ----