pd/src desire.tk,1.1.2.317,1.1.2.318 - Pd-cvs

11 Aug 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13626
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
more work on undo/redo; also rewrote the zoom spinbox code
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.317
retrieving revision 1.1.2.318
diff -C2 -d -r1.1.2.317 -r1.1.2.318
*** desire.tk	11 Aug 2006 14:38:55 -0000	1.1.2.317
--- desire.tk	11 Aug 2006 17:18:14 -0000	1.1.2.318
***************
*** 936,942 ****
  set look(minobjwidth) 21
! set scale(canned) [list 50 100 150 200 250 300]
! set scale(list) $scale(canned)
! set scale(incr) 0.25
  #-----------------------------------------------------------------------------------#
  proc read_ddrc {} {
--- 936,941 ----
  set look(minobjwidth) 21
! set scale(canned) [list 25 33 50 75 100 125 150 200 250 300 400]
! 
  #-----------------------------------------------------------------------------------#
  proc read_ddrc {} {
***************
*** 1766,1769 ****
--- 1765,1769 ----
# think of the children!!!
+ # should be only called from the server
  def Canvas children= {children} {
    set new  [lwithout $children $@children]
***************
*** 1772,1782 ****
    	$x unsubscribe $self
    	#$@history can't ;# need a way to instantiate objects with a specific index.
! 		$@history add [list $self insert [lsearch $@children $x] [$x deconstruct]]
    	$x erase
    }
    foreach x $new {
    	if {[info exists _($x:_class)]} {
    		$x subscribe $self; $x changed; $x canvas= $self
- 			$@history add [list $self del [lsearch $children $x]]
    	} else {
    		lappend @unborn $x
--- 1772,1784 ----
    	$x unsubscribe $self
    	#$@history can't ;# need a way to instantiate objects with a specific index.
! 		# THIS IS NOT WHERE HISTORY ADD IS SUPPOSED TO BE!
! 		# it's supposed to be on the user end!
! 		#$@history add [list $self ins [lsearch $@children $x] [$x deconstruct]]
    	$x erase
    }
    foreach x $new {
+ 		###$@history add [list $self del [lsearch $children $x]]
    	if {[info exists _($x:_class)]} {
    		$x subscribe $self; $x changed; $x canvas= $self
    	} else {
    		lappend @unborn $x
***************
*** 1787,1802 ****
  }
! def Canvas add {i constructor} {
! 	set x [meuh]
! 	$obj subscribe $self; $x changed
! 	$obj canvas= $self
! 	$@history add [list $self del $i]
! }
! 
! def Canvas del {i} {
! 	set i [lsearch $@children $obj]
! 	if {$i} {set @children [lreplace $@children $i $i]}
! 	$obj unsubscribe $self
! }
def Canvas wires= {wires2} {
--- 1789,1795 ----
  }
! # for undo; calls the server
! def Canvas ins {i constructor} {eval [concat [list pd .$self object_insert $i] $constructor]}
! def Canvas del {i} {pd .$self object_delete ![lindex $@children $i]}
def Canvas wires= {wires2} {
***************
*** 1853,1890 ****
  }
- def Canvas wires_new {whoout outno whoin inno} {
- 	# @wires_pair is a workaround for looking up the wire id with {0 1 1 0} format
- 	# i moved calling wire_new here instead of where it was (canvas wires=) 
- 	# is because i don't need to figure out which of the wire2 is new 
- 	# todo: need to put some things here to prevent from creating the same connection twice
- 	
- 	#puts "self === $self"
- 	#lappend @wires_pair [list $whoout $outno $whoin $inno]
- 	#lappend @wires_pair [eval [list wire_new $self $whoout $outno $whoin $inno]]
- }
- 
  def* Canvas wires {} {return $@wires}
def* Canvas delete_selection {} {
- 	global _
    set c .$self.c
    foreach obj $@selection {
! 	#pd .$self object_delete !$obj
        puts "wire to erase: $_($obj:wires)"
        foreach wire $_($obj:wires) {
! 	    	set find [lsearch $@wires_pair $wire]
    	if { $find != -1} {
! 		pd .$self disconnect [lindex $@wires_pair [expr $find - 1]]
! 		## remove the selected wire from the @wires_pair...
! 		set @wires_pair [lreplace $@wires_pair $find $find]
! 		set @wires_pair [lreplace $@wires_pair [expr $find - 1] [expr $find - 1]]
    	}
- 		
    	$wire delete
! 	    } 
! 	
! 	#$obj erase
! 	pd .$self object_delete !$obj
! 	
    }
    # before obj is deleted, it will be selected, therefore 
--- 1846,1868 ----
  }
def* Canvas wires {} {return $@wires}
def* Canvas delete_selection {} {
    set c .$self.c
    foreach obj $@selection {
! 	    #pd .$self object_delete !$obj
        puts "wire to erase: $_($obj:wires)"
        foreach wire $_($obj:wires) {
! 		set find [lsearch $@wires_pair $wire]
    	if { $find != -1} {
! 			pd .$self disconnect [lindex $@wires_pair [expr $find - 1]]
! 			## remove the selected wire from the @wires_pair...
! 			set @wires_pair [lreplace $@wires_pair $find $find]
! 			set @wires_pair [lreplace $@wires_pair [expr $find - 1] [expr $find - 1]]
    	}
    	$wire delete
! 	    }
! 	    #$obj erase
! 	    pd .$self object_delete !$obj
    }
    # before obj is deleted, it will be selected, therefore 
***************
*** 1895,1905 ****
  }
- #this is redundent 
- def* Canvas delete_wire {obj1 outport obj2 inport} {
- 	global _
- }
- 
- 
- 
  proc distance {point1 point2} {
    set off [l- $point1 $point2]
--- 1873,1876 ----
***************
*** 2305,2313 ****
          		set ins 0; set ins [$id ninlets]
          		if {$y<$y1+6 && $ins} {
! 	  		set in [expr int(($x-$x1)*$ins/($x2-$x1))]
! 	  		set @wire_to [list $id $in]
! 	  		mset {from outlet} $@shift_wires
! 	  		mset {to    inlet} $@wire_to
! 	  		pd .$self connect [lsearch $@children $from] $outlet \
    		    [lsearch $@children $to]  $inlet
    		}
--- 2276,2284 ----
          		set ins 0; set ins [$id ninlets]
          		if {$y<$y1+6 && $ins} {
! 			set in [expr int(($x-$x1)*$ins/($x2-$x1))]
! 			set @wire_to [list $id $in]
! 			mset {from outlet} $@shift_wires
! 			mset {to    inlet} $@wire_to
! 			pd .$self connect [lsearch $@children $from] $outlet \
    		    [lsearch $@children $to]  $inlet
    		}
***************
*** 2318,2322 ****
    	}
         } else {
- 	     
         # clcik on object
         # if no previous selection, edit the clicked object
--- 2289,2292 ----
***************
*** 2327,2333 ****
         	if {[lsearch $@selection $id] < 0} {lappend @selection $id}
         	$id selected?= 1; set @action edit
! 	     } 
! 	     
! 	     
         }
         }
--- 2297,2301 ----
         	if {[lsearch $@selection $id] < 0} {lappend @selection $id}
         	$id selected?= 1; set @action edit
! 	     }
         }
         }
***************
*** 2702,2756 ****
  def* Canvas incr_zoom {} {$self zoom "in"}
  def* Canvas decr_zoom {} {$self zoom "out"}
- def* Canvas zoom {mode} {
- 	global font scale
- 	switch $mode {
- 	in {
- 		set @scale [expr $@scale + $scale(incr)]
- 	}
- 	out {
- 		if {$@scale > $scale(incr)} {set @scale [expr $@scale - $scale(incr)]}
- 	}
- 	}
- 	$self redraw
- 	set val [format %.0f [expr $@scale * 100]]
- 	set val ${val}%
- 	set scale(list) $val 
- 	.$self.bbar.scale set $val
! }
! def* Canvas spin_zoom {spinbox val direction} {
    global scale
! 	set val [string trimright $val %]
! 	switch $direction {
! 	up {
! 		for {set i 0} {$i < [llength $scale(canned)]} {incr i} {
! 		set value [lindex $scale(canned) $i]
! 		if {[expr $value - $val] > 0} {break}
! 		}
! 		set next [lindex $scale(canned) $i]
! 		if {[expr $i+1] <= [llength $scale(canned)]} {
! 		$spinbox set ${next}%
! 		set next_f [format %.6f $next]
! 		set @scale [expr $next_f/100]
! 		}
! 	}
! 	down {
! 		for {set i 0} {$i < [llength $scale(canned)]} {incr i} {
! 		set value [lindex $scale(canned) $i]
! 		if {[expr $value - $val] >= 0} {break}
! 		}
! 		set next [lindex $scale(canned) [expr $i-1]]
! 		if {[expr $i-1] >= 0} {$spinbox set ${next}%
! 		set next_f [format %.6f $next]
! 		set @scale [expr $next_f/100]
! 		}
! 	}
    }
    $self redraw
- 	
- }
- def* Canvas spin_zoom_key {spinbox string string} {
- 	return 1
  }
  #-----------------------------------------------------------------------------------#
  set lastcanvasconfigured ""
--- 2670,2690 ----
  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
! 	set val [string trimright [$spinbox get] %]
! 	set i [lsearch $scale(canned) $val]
! 	set end [expr [llength $scale(canned)] - 1]
! 	switch -regexp $mode {
! 	   in|up   {if {$i<$end} {incr i +1}}
! 	  out|down {if {$i>0}    {incr i -1}}
    }
+ 	set per [lindex $scale(canned) $i]
+ 	$spinbox set $per%
+ 	set @scale [expr $per/100.0]
    $self redraw
  }
+ 
  #-----------------------------------------------------------------------------------#
  set lastcanvasconfigured ""
***************
*** 2948,2961 ****
  class_new Wire {View}
! def Wire init {canvas from outno to inno} {
      super
!     set @connects [list $from $outno $to $inno]
!     #puts "------ children:$_($canvas:children)"
!     #hack
      set children $_($canvas:children)
      set @obj1 [lindex $children $from]
      set @obj2 [lindex $children $to]
!     set @port1 $outno
!     set @port2 $inno
      set @canvas $canvas
      #set _($@obj1:wires) $self
--- 2882,2893 ----
  class_new Wire {View}
! def Wire init {canvas from outlet to inlet} {
      super
!     set @connects [list $from $outlet $to $inlet]
      set children $_($canvas:children)
      set @obj1 [lindex $children $from]
      set @obj2 [lindex $children $to]
!     set @port1 $outlet
!     set @port2 $inlet
      set @canvas $canvas
      #set _($@obj1:wires) $self
***************
*** 4533,4538 ****
    }
    pack [entry $bb.name -font {courier 10} -width 10 -border 0] -side right
! 	#pack [spinbox $bb.scale -width 6 -command "$canvas spin_zoom %W %s %d" -validate key -vcmd "$canvas spin_zoom_key %W %s %S"] -side right
! 	pack [spinbox $bb.scale -width 6 -command "$canvas spin_zoom %W %s %d" -state readonly] -side right
    $bb.scale set "100%"
    $bb.name insert 0 .$@canvas
--- 4465,4469 ----
    }
    pack [entry $bb.name -font {courier 10} -width 10 -border 0] -side right
! 	pack [spinbox $bb.scale -width 6 -command "$canvas zoom %d" -state readonly] -side right
    $bb.scale set "100%"
    $bb.name insert 0 .$@canvas