pd/src desire.tk,1.1.2.597,1.1.2.598 - Pd-cvs

28 Nov 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13231
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
work on subpatcherize again
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.597
retrieving revision 1.1.2.598
diff -C2 -d -r1.1.2.597 -r1.1.2.598
*** desire.tk	27 Nov 2006 23:10:52 -0000	1.1.2.597
--- desire.tk	28 Nov 2006 03:42:00 -0000	1.1.2.598
***************
*** 251,254 ****
--- 251,255 ----
  set subpatcherize(paste) 0
  set subpatcherize(parent) 0
+ set subpatcherize(count) 0
  #-----------------------------------------------------------------------------------#
  # adapted from matju's MetaRuby (UndoQueue.rb)
***************
*** 2688,2691 ****
--- 2689,2744 ----
  }
+ def Canvas visible_rect {} {
+ 	global subpatcherize
+ 	set c [$self widget]
+ 	set height [winfo height $c]
+ 	set width [winfo width $c]
+ 	if {$subpatcherize(paste)} {set height 300; set width 450}
+ 	mset {l r} [$c xview]
+ 	mset {t b} [$c yview]
+ 	if {$l == $r} {set l 0; set r 1}
+ 	if {$t == $b} {set t 0; set b 1}
+ 	set w [expr (1 / ($r - $l)) * $width]
+ 	set h [expr (1 / ($b - $t)) * $height]
+ 	mset {l2 r2} [lmap * [list $l $r] $w]
+ 	mset {t2 b2} [lmap * [list $t $b] $h]
+ 	return [list $l2 $t2 $r2 $b2]
+ }
+ 
+ def Canvas clipboard_coords {offset} {
+ 	set in 0
+ 	foreach mess [pd_mess_split [$::clipboard value]] {
+ 		set type [lindex $mess 1]
+ 		switch $type {
+ 			canvas {set in 1} "" {} connect {}
+ 			default {
+ 				if {$type == "restore"} {set in 0}
+ 				mset {x y} [lmap + [lrange $mess 2 3] $offset]
+ 				if {!$in} {lappend xcoords $x; lappend ycoords $y} 
+ 			} 
+ 		}
+ 	}
+ 	return [list $xcoords $ycoords]
+ }
+ 
+ def Canvas paste_visible? {x1 y1 x2 y2 offset} {
+ 	set in 0
+ 	foreach mess [pd_mess_split [$::clipboard value]] {
+ 		set type [lindex $mess 1]
+ 		switch $type {
+ 			canvas {set in 1} "" {} connect {}
+ 			default {
+ 				if {$type == "restore"} {set in 0}
+ 				mset {x y} [lmap + [lrange $mess 2 3] $offset]
+ 				if {!$in} {
+ 					if {$x > $x2 || $x < $x1} {return 0;break}
+ 					if {$y > $y2 || $y < $y1} {return 0;break}
+ 				} 
+ 			} 
+ 		}
+ 	}
+ 	return 1
+ }
+ 
  def Canvas copy_times= {c} {set @copy_count $c}
  def Canvas copy_times {} {return $@copy_count}
***************
*** 2716,2764 ****
def Canvas do_paste {offset} {
! 	global paste
    set @obj_count 0; set @wire_count 0
! 	set in 0; set visible 1
    #foreach mess [pd_mess_split [$::clipboard value]] {
    #	set type [lindex $mess 1]
    #	switch $type {connect {} restore {} default {if {$type != ""} {incr paste(count)}}}
    #}
! 	set c [$self widget]
! 	set height [winfo height $c]
! 	set width [winfo width $c]
! 	mset {l r} [$c xview]
! 	mset {t b} [$c yview]
! 	set w [expr (1 / ($r - $l)) * $width]
! 	set h [expr (1 / ($b - $t)) * $height]
! 	mset {l2 r2} [lmap * [$c xview] $w]
! 	mset {t2 b2} [lmap * [$c yview] $h]
! 	set xcoords {}; set ycoords {}
! 	
! 	foreach mess [pd_mess_split [$::clipboard value]] {
! 		set type [lindex $mess 1]
! 		switch $type {
! 			canvas {set in 1} "" {} connect {}
! 			default {
! 				if {$type == "restore"} {set in 0}
! 				mset {x y} [lmap + [lrange $mess 2 3] $offset]
! 				if {!$in} {lappend xcoords $x; lappend ycoords $y} 
! 			} 
! 		}
! 	}
! 	foreach mess [pd_mess_split [$::clipboard value]] {
! 		set type [lindex $mess 1]
! 		switch $type {
! 			canvas {set in 1} "" {} connect {}
! 			default {
! 				if {$type == "restore"} {set in 0}
! 				mset {x y} [lmap + [lrange $mess 2 3] $offset]
! 				if {!$in} {
! 					if {$x > $r2 || $x < $l2} {set visible 0;break}
! 					if {$y > $b2 || $y < $t2} {set visible 0;break}
! 				} 
! 			} 
! 		}
! 	}
    set ref [lsearch $ycoords [lindex [lsort -increasing $ycoords] 0]]
- 	puts "                ref ::::::::::: $ref"
    pd .$self push
    set paste(state) $self
--- 2769,2784 ----
def Canvas do_paste {offset} {
! 	global paste subpatcherize
    set @obj_count 0; set @wire_count 0
! 	set in 0
    #foreach mess [pd_mess_split [$::clipboard value]] {
    #	set type [lindex $mess 1]
    #	switch $type {connect {} restore {} default {if {$type != ""} {incr paste(count)}}}
    #}
! 	mset {vx1 vy1 vx2 vy2} [$self visible_rect]
! 	mset {xcoords ycoords} [$self clipboard_coords $offset]
! 	set visible [$self paste_visible? $vx1 $vy1 $vx2 $vy2 $offset]
! 
    set ref [lsearch $ycoords [lindex [lsort -increasing $ycoords] 0]]
    pd .$self push
    set paste(state) $self
***************
*** 2781,2788 ****
    			} else {
    				if {!$visible} {
! 						set xoff [expr ($r2 - $l2) * 0.25]
! 						set yoff [expr ($b2 - $t2) * 0.25]
! 						set x2 [expr [lindex $mess 2] - [lindex $xcoords $ref] + $l2 + $xoff]
! 						set y2 [expr [lindex $mess 3] - [lindex $ycoords $ref] + $t2 + $yoff]
    					set mess2 [lreplace $mess 2 3 $x2 $y2]
    				}
--- 2801,2808 ----
    			} else {
    				if {!$visible} {
! 						set xoff [expr ($vx2 - $vx1) * 0.25]
! 						set yoff [expr ($vy2 - $vy1) * 0.25]
! 						set x2 [expr [lindex $mess 2] - [lindex $xcoords $ref] + $vx1 + $xoff]
! 						set y2 [expr [lindex $mess 3] - [lindex $ycoords $ref] + $vy1 + $yoff]
    					set mess2 [lreplace $mess 2 3 $x2 $y2]
    				}
***************
*** 2797,2805 ****
def Canvas done_paste {} {
! 	global paste
    $self deselect_all
    $self selection= [lrange $@children [expr [llength $@children] - $@obj_count] end]
    $self selection_wire= [lrange $@wires [expr [llength $@wires] - $@wire_count] end]
    set paste(state) 0
  }
--- 2817,2827 ----
def Canvas done_paste {} {
! 	global paste subpatcherize
! 	puts "           count ---------- $@obj_count"
    $self deselect_all
    $self selection= [lrange $@children [expr [llength $@children] - $@obj_count] end]
    $self selection_wire= [lrange $@wires [expr [llength $@wires] - $@wire_count] end]
    set paste(state) 0
+ 	if {$subpatcherize(paste)} {set subpatcherize(paste) 0}
  }
***************
*** 2952,2958 ****
    set x [expr $x / [llength $@selection]]
    set y [expr $y / [llength $@selection]]
! 	set construct "#X obj $x $y pd foo"
    set subpatcherize(pack) 1
    set subpatcherize(parent) $self
    $self cut
    pd .$self object_insert [expr [llength $@children] - 1] $construct
--- 2974,2981 ----
    set x [expr $x / [llength $@selection]]
    set y [expr $y / [llength $@selection]]
! 	set construct "#X obj $x $y pd sub$subpatcherize(count)"
    set subpatcherize(pack) 1
    set subpatcherize(parent) $self
+ 	incr subpatcherize(count) 
    $self cut
    pd .$self object_insert [expr [llength $@children] - 1] $construct
***************
*** 2964,2971 ****
    if {$self == $subpatcherize(parent)} {return}
    if {$subpatcherize(pack)} {
- 		puts "    ------------ ------------- ----------E"
    	set subpatcherize(paste) 1
! 		$self paste
! 		after 200 $self edit
    	set c $@canvas
    	set subpatcherize(pack) 0
--- 2987,2993 ----
    if {$self == $subpatcherize(parent)} {return}
    if {$subpatcherize(pack)} {
    	set subpatcherize(paste) 1
! 	        $self paste
! 		#after 200 $self edit
    	set c $@canvas
    	set subpatcherize(pack) 0
***************
*** 3812,3816 ****
      set i 0
      if {[info exists fields($@pdclass)]} {
! 	    foreach f $fields($@pdclass) {set _($self:$f) [lindex $mess $i];puts " >>> $self:$f  <<<";  incr i}
      }
  }
--- 3834,3838 ----
      set i 0
      if {[info exists fields($@pdclass)]} {
! 	    foreach f $fields($@pdclass) {set _($self:$f) [lindex $mess $i];  incr i}
      }
  }
***************
*** 5137,5141 ****
    set lfont [list [lindex {courier helvetica times} $@fstyle] $@fs bold]
    set lcolor [parse_color $@lcol]
- 	puts "Labeled: lfont=[list $lfont] lcolor=$lcolor"
    if {$leet} {
    	    set text [string map -nocase {a 4 e 3 t 7 s 5 i 1 o 0 g 9} $label]
--- 5159,5162 ----