[PD-cvs] pd/src desire.tk,1.1.2.326,1.1.2.327

Mathieu Bouchard matju at users.sourceforge.net
Sun Aug 13 21:09:07 CEST 2006


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

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.326
retrieving revision 1.1.2.327
diff -C2 -d -r1.1.2.326 -r1.1.2.327
*** desire.tk	13 Aug 2006 08:42:24 -0000	1.1.2.326
--- desire.tk	13 Aug 2006 19:09:04 -0000	1.1.2.327
***************
*** 1880,1884 ****
  	mset {ox1 oy1 ox2 oy2} [lrange [$c coords lnew] end-3 end]
  	mset {x1 y1} [lrange [$c coords lnew] 0 1]
- 	#puts "ox1=$ox1 oy1=$oy1 x=$x y=$y"
  	set l [$c coords lnew]
  	#if {[llength $l]<4 || [distance [list $ox1 $oy1] [list $x $y]] < 30} {
--- 1880,1883 ----
***************
*** 1944,1966 ****
  #-----------------------------------------------------------------------------------#
  def Canvas identify_target {x y b f label} {
      set c .$self.c
!     set stack [lreverse [$c find overlapping \
! 	    [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]]]
      foreach tag $stack {
  	set tags [$c gettags $tag] 
  	if {[regexp {^x([a-f0-9]{6,8})} $tags id]} {
- 	    global _
  	    if {[info exists _($id:pdclass)]} {set class $_($id:pdclass)} {set class unknown}
- 	    #post "(.....) $id is a \[$class\] object"
  	    return [list "object" $id]
          }
      }
      foreach tag $stack {
! 	set tags [$c gettags $tag] 
! 	if {[regexp {^([0-9a-f]{6,8})} $tags id]} {
! 	    return [list "wire" $id]
!         }
      }
-     #post "(.....) nothing in particular"
      return [list "nothing"]
  }
--- 1943,1960 ----
  #-----------------------------------------------------------------------------------#
  def Canvas identify_target {x y b f label} {
+     global _
      set c .$self.c
!     set stack [lreverse [$c find overlapping [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]]]
      foreach tag $stack {
  	set tags [$c gettags $tag] 
  	if {[regexp {^x([a-f0-9]{6,8})} $tags id]} {
  	    if {[info exists _($id:pdclass)]} {set class $_($id:pdclass)} {set class unknown}
  	    return [list "object" $id]
          }
      }
      foreach tag $stack {
! 	set tags [$c gettags $tag]
! 	if {[regexp {^([0-9a-f]{6,8})} $tags id]} {return [list "wire" $id]}
      }
      return [list "nothing"]
  }
***************
*** 2093,2096 ****
--- 2087,2091 ----
  	$self copy
  	$self paste
+ 	$clipboard _delete
  	set clipboard $backup
  }
***************
*** 2122,2126 ****
    menu $p -tearoff false
    if {$id == ""} {
!     $self populate_menu $p {popup_properties popup_help}
    } {
      $id   populate_menu $p {popup_properties popup_open popup_help}
--- 2117,2121 ----
    menu $p -tearoff false
    if {$id == ""} {
!     $self populate_menu $p {popup_properties            popup_help}
    } {
      $id   populate_menu $p {popup_properties popup_open popup_help}
***************
*** 2129,2133 ****
  }
  
! # this method is too long
  def* Canvas clickedit {x y b f} {
  	set c .[$self canvas].c
--- 2124,2128 ----
  }
  
! #!@#$ this method is too long
  def* Canvas clickedit {x y b f} {
  	set c .[$self canvas].c
***************
*** 2610,2625 ****
  	if {[llength $@selection] > 0} {$self delete_selection}
  	if {[llength $@selection_wire] > 0} {
- 		puts "delete this $self :: $@selection_wire"
  		foreach x $@selection_wire {
! 		 set find [lsearch $@wires_pair $x]
! 		  if { $find != -1} {
! 		  pd .$self disconnect [lindex $@wires_pair [expr $find - 1]]
! 		  # remove the selected wire from the @wire_pair...
! 		  set @wires_pair [lreplace $@wires_pair $find $find]
! 		  set @wires_pair [lreplace $@wires_pair [expr $find - 1] [expr $find - 1]]
  		  }
  		  $x delete
  		}
- 		
  		set $@selection_wire {}
  	}
--- 2605,2616 ----
  	if {[llength $@selection] > 0} {$self delete_selection}
  	if {[llength $@selection_wire] > 0} {
  		foreach x $@selection_wire {
! 		  set find [lsearch $@wires_pair $x]
! 		  if {$find != -1} {
! 		    pd .$self disconnect [lindex $@wires_pair [expr $find - 1]]
! 		    set @wires_pair [lreplace $@wires_pair [expr $find - 1] [expr $find - 1]]
  		  }
  		  $x delete
  		}
  		set $@selection_wire {}
  	}
***************
*** 2637,2649 ****
  	    	if {$_($@selection:_class) == "ObjectBox"} {$@selection edit; $self dehilite_io}
  	    } else {
- 	    	puts "connect this :::: $@keynav_iosel"
  		set from_obj [lindex $@keynav_iosel 0]
! 		set to_obj [lindex $@keynav_iosel 1]
! 		set from [lsearch $@children [lindex $@keynav_iosel 0]]
! 		set to [lsearch $@children [lindex $@keynav_iosel 1]]
! 		puts "from::: $from to:::$to"
! 		pd .$self connect [list $from [lindex $_($from_obj:ioselect) 0] $to [lindex $_($to_obj:ioselect) 0]]
  		$self dehilite_io
- 		
  	    }
  	  }
--- 2628,2639 ----
  	    	if {$_($@selection:_class) == "ObjectBox"} {$@selection edit; $self dehilite_io}
  	    } else {
  		set from_obj [lindex $@keynav_iosel 0]
! 		set to_obj   [lindex $@keynav_iosel 1]
! 		set from   [lsearch $@children [lindex $@keynav_iosel 0]]
! 		set inlet  [lindex $_($from_obj:ioselect) 0]
! 		set to     [lsearch $@children [lindex $@keynav_iosel 1]]
! 		set outlet [lindex $_($to_obj:ioselect) 0]
! 		pd .$self connect [list $from $inlet $to $outlet]
  		$self dehilite_io
  	    }
  	  }
***************
*** 2707,2714 ****
    super $dx $dy
    #$self draw_wires
-   #foreach wire $@wires {
-    # set _($wire:select_by) $_($@canvas:select_by)
-     #$wire draw
-   #}
  }
  
--- 2697,2700 ----
***************
*** 2722,2731 ****
      if {$in_selection && [llength $_($@canvas:selection)]>1} {
         foreach obj $_($@canvas:selection) {mset {x y} [$obj xy];$obj set_orig_xy $x $y}
-        puts "begin to move _______ $_($@canvas:selection)"
         set _($@canvas:action) move
      } {
         $@canvas deselect_all
         set _($@canvas:selection) $self
-        #set _($@canvas:action) move
         set _($@canvas:action) edit
      }
--- 2708,2715 ----
***************
*** 2741,2752 ****
  	
  	for {set n 0} {$n<$ports} {incr n} {
! 	set tag $self$type$n
! 	set area [.$@canvas.c bbox $self$type$n]
! 	set center [expr ([lindex $area 2] + [lindex $area 0]) / 2 ]
! 	set dist [expr abs($x - $center)]
! 	if {$dist < [expr ([look iowidth]/2)+5] && $dist > 0} {set port $n}
  	}
! 	
! 	
  	if {$ports==0 | $port==-1} return
  	#set port [expr int(($x-$x1)*$ports/$xs)]
--- 2725,2735 ----
  	
  	for {set n 0} {$n<$ports} {incr n} {
! 		set tag $self$type$n
! 		set area [.$@canvas.c bbox $self$type$n]
! 		set center [expr ([lindex $area 2] + [lindex $area 0]) / 2 ]
! 		set dist [expr abs($x - $center)]
! 		if {$dist < [expr ([look iowidth]/2)+5] && $dist > 0} {set port $n}
  	}
! 
  	if {$ports==0 | $port==-1} return
  	#set port [expr int(($x-$x1)*$ports/$xs)]
***************
*** 2771,2779 ****
      set @port2 $inlet
      set @canvas $canvas
-     #set _($@obj1:wires) $self
-     #set _($@obj2:wires) $self
      # associate wires to its connected objects
      lappend _($@obj1:wires) $self
-     puts "_($@obj1:wires) is $_($@obj1:wires)"
      lappend _($@obj2:wires) $self
      # select_by is a hack to get wires remain hilited if selected by serect....
--- 2754,2759 ----
***************
*** 2787,2792 ****
  
  def Wire draw {} {
- 	#set thick 2
- 	#puts "------- from:$@obj1 outlet:$@port1 to:$@obj2 inlet:$@port2"
  	set bbox1 [.$@canvas.c bbox [join [list "$@obj1" o "$@port1"] ""]]
  	set bbox2 [.$@canvas.c bbox [join [list "$@obj2" i "$@port2"] ""]]
--- 2767,2770 ----
***************
*** 2795,2806 ****
  	mset {x1 y1} [l/2 [l+ [lrange $bbox1 0 1] [lrange $bbox1 2 3]]]
  	mset {x2 y2} [l/2 [l+ [lrange $bbox2 0 1] [lrange $bbox2 2 3]]]
- 	#wire_draw $self 1 $x1 $y1 $x2 $y2
  	set xys [list $x1 $y1 $x2 $y2]
  	set length [expr sqrt(pow($x2-$x1,2)+pow($y2-$y1,2))]
! 	# how to customise the arrow size/shape? 
  	set arrowsize [expr $length<100 ? $length/10 : 10]
  	if {$arrowsize < 5} {set arrow none} {set arrow last}
  	set arrowshape [list $arrowsize [expr $arrowsize*4/5] [expr $arrowsize/3]]
- 	# need this, maybe...
  	#if {$@select_by == "selrect"} {set wire_color [look wirefg2]} {set wire_color [look wirefg]}
  	if {[$self selected?]} {set wire_color [look wirefg2]} {set wire_color [look wirefg]}
--- 2773,2782 ----
  	mset {x1 y1} [l/2 [l+ [lrange $bbox1 0 1] [lrange $bbox1 2 3]]]
  	mset {x2 y2} [l/2 [l+ [lrange $bbox2 0 1] [lrange $bbox2 2 3]]]
  	set xys [list $x1 $y1 $x2 $y2]
  	set length [expr sqrt(pow($x2-$x1,2)+pow($y2-$y1,2))]
! 	# how to customise the arrow size/shape?
  	set arrowsize [expr $length<100 ? $length/10 : 10]
  	if {$arrowsize < 5} {set arrow none} {set arrow last}
  	set arrowshape [list $arrowsize [expr $arrowsize*4/5] [expr $arrowsize/3]]
  	#if {$@select_by == "selrect"} {set wire_color [look wirefg2]} {set wire_color [look wirefg]}
  	if {[$self selected?]} {set wire_color [look wirefg2]} {set wire_color [look wirefg]}
***************
*** 2808,2831 ****
  	$self item WIRE line $xys -width [look wirethick] -smooth yes \
  		-arrow $arrow -arrowshape $arrowshape -fill $wire_color
- 	
- 	#puts ".......tags: [.$@canvas.c gettags $self]"	
- 	#if {[llength [.$@canvas.c gettags $self]] != 0} {
- 		#$canvas coords $self $xys
- 		#$canvas itemconfigure -arrow $arrow -arrowshape $arrowshape
- 	#} {
- 		#$canvas create line $xys -tags $self -width $thick \
- 		#	-arrow $arrow -arrowshape $arrowshape -fill [look wirefg]
- 	#	$self item WIRE line $xys -width $thick -smooth yes \
- 	#	-arrow $arrow -arrowshape $arrowshape -fill [look wirefg]
- 	#}
  }
  
- #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
  	set @outlet $outlet
--- 2784,2792 ----
  	$self item WIRE line $xys -width [look wirethick] -smooth yes \
  		-arrow $arrow -arrowshape $arrowshape -fill $wire_color
  }
  
  #!@#$ what's this? doesn't match the name of instance variables.
  def Wire update {source outlet target inlet kind} {
+ 	error "proof that this method is used somewhere..."
  	set @source $source
  	set @outlet $outlet
***************
*** 3170,3179 ****
  	set class $_($@of:class)
  	if {![info exists fields($class)]} {set class obj}
- 	puts "this is a $_($@of:class) class"
  	set orig {}
  	set props ".$@of reload"
  	set props2 {}
          foreach var [lrange $fields($class) 5 end] {
- 	  #puts "$var --from-- $_($@of:$var)  --to-- $@$var"
  	  lappend orig $_($@of:$var)
  	  lappend props2 $@$var ;# does $@$ really work or not? if not, fix objective.tcl ...
--- 3131,3138 ----
***************
*** 3185,3198 ****
  	    default {set val $@$var}
  	  }
! 	  if {[regexp -nocase {^([a-z])col$} $var]} {
! 	    set val [unparse_color $val]
! 	    puts "color ---- > $val"
!           }
  	  switch -- $val { {} {set val "empty"}}
  	  set props "$props $val"
  	}
- 	puts "orig props:: $orig"
- 	puts "inter props:: $props2"
- 	puts "real props:: $props"
  	pd $props
  }
--- 3144,3151 ----
  	    default {set val $@$var}
  	  }
! 	  if {[regexp -nocase {^([a-z])col$} $var]} {set val [unparse_color $val]}
  	  switch -- $val { {} {set val "empty"}}
  	  set props "$props $val"
  	}
  	pd $props
  }
***************
*** 3205,3236 ****
  	wm title .$self "\[$class\] [say popup_properties]"
  	if {![info exists fields($class)]} {set class obj}
- 	puts "this is a $_($of:class) class"
- 	puts "it has [llength $fields($class)] properties"
- 	#clone values	
  	foreach var $fields($class) {
- 		puts "$var ---------- $_($of:$var)"
  		switch $var {
! 			is_log {if {$_($of:$var)} {set val "linear"} else { set val "logarithmic"}}
! 			isa {if {$_($of:$var)} {set val "yes"} else { set val "no"}}
! 			steady {if {$_($of:$var)} {set val "jump"} else { set val "steady"}}
! 			fstyle {if {$_($of:$var)} {set val "yes"} else { set val "no"}}
  			default {set val $_($of:$var)}
  		}
- 		#set val $_($of:$var)
  		switch -- $val { empty {set val ""}}
  		if {[regexp -nocase {^([a-z])col$} $var]} {set val [parse_color $val]}
  		set @$var $val
  	}
- 	
- 
- 	#set @loadbang [expr $@isa & 1]
- 	#set @scale [expr ($@isa>>20) & 1]
  	set @class $_($of:class)
- 	# the longest label is...
  	foreach prop $fields($class) {
! 	set label [say $prop]
! 	if {[string length $label] > $@max_label} {set @max_label [string length $label]}
  	}
- 	
  	foreach prop [lrange $fields($class) 5 end] {
  	    switch $prop {
--- 3158,3178 ----
  	wm title .$self "\[$class\] [say popup_properties]"
  	if {![info exists fields($class)]} {set class obj}
  	foreach var $fields($class) {
  		switch $var {
! 			is_log  {if {$_($of:$var)} {set val "linear"} else {set val "logarithmic"}}
! 			isa     {if {$_($of:$var)} {set val "yes"   } else {set val "no"}}
! 			steady  {if {$_($of:$var)} {set val "jump"  } else {set val "steady"}}
! 			fstyle  {if {$_($of:$var)} {set val "yes"   } else {set val "no"}}
  			default {set val $_($of:$var)}
  		}
  		switch -- $val { empty {set val ""}}
  		if {[regexp -nocase {^([a-z])col$} $var]} {set val [parse_color $val]}
  		set @$var $val
  	}
  	set @class $_($of:class)
  	foreach prop $fields($class) {
! 		set label [say $prop]
! 		if {[string length $label] > $@max_label} {set @max_label [string length $label]}
  	}
  	foreach prop [lrange $fields($class) 5 end] {
  	    switch $prop {
***************
*** 3271,3277 ****
  	    properties_dialog $self .$self $d
  	}
- 	
- 	
- 	#puts "$self = IEMPropertiesDialog $of"
  }
  
--- 3213,3216 ----
***************
*** 3283,3287 ****
  	foreach var {xscale yscale graphme} {set @$var $_($of:$var)}
  	wm title .$self "[say canvas] [say popup_properties]"
- 	#wm protocol $id WM_DELETE_WINDOW "canvas_cancel $id"
  	set props {
  		xscale "X units/px: " entry {-width 10}
--- 3222,3225 ----
***************
*** 3291,3295 ****
  	pack [checkbutton .$self.graphme -text "graph on parent" \
  		-variable @graphme -anchor w] -side top
- 	#bind .$self.xscale.entry <KeyPress-Return> "canvas_ok $id"
  	#bind .$self.yscale.entry <KeyPress-Return> "canvas_ok $id"
  	.$self.xscale.entry select from 0
--- 3229,3232 ----





More information about the Pd-cvs mailing list