[PD-cvs] pd/src desire.tk, 1.1.2.600.2.269, 1.1.2.600.2.270 defaults.ddrc, 1.1.2.10.2.15, 1.1.2.10.2.16

[chunlee]

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

Modified Files:
      Tag: desiredata
	desire.tk defaults.ddrc 
Log Message:
new feature: snap to grid


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.600.2.269
retrieving revision 1.1.2.600.2.270
diff -C2 -d -r1.1.2.600.2.269 -r1.1.2.600.2.270
*** desire.tk	2 Aug 2007 20:22:11 -0000	1.1.2.600.2.269
--- desire.tk	3 Aug 2007 02:48:14 -0000	1.1.2.600.2.270
***************
*** 2103,2133 ****
  	$self selection= $obj
  }
! set grid 5
! def Canvas snapx {} {
! 	$@history atomically [list move] {
! 		$self snapx2
! 	}
! }
! def Canvas snapx2 {} {
! 	set grid $::grid
! 	set new_xy {}
! 	set snapped {}
! 	foreach child $@children {
! 		mset {x y} [$child xy]
! 		set x1 [expr $x - ($x%$grid)]
! 		#set y1 [expr $y - ($y%$grid)]
! 		set i 0
! 		while {[lsearch $new_xy [list $x1 $y]] > 0} {
! 			incr i
! 			set x1 [expr $x1+($grid*$i)]
! 		#	set y1 [expr $y1+($grid*$i)]
! 		}
! 		# need to test overlap..
! 		lappend new_xy [list $x1 $y]
! 		lappend snapped $child
! 		$child moveto $x1 $y
! 	}
! 	incr ::grid 5
! }
  def Canvas Object  {} {$self new_object obj}
  def Canvas Message {} {$self new_object msg}
--- 2103,2107 ----
  	$self selection= $obj
  }
! 
  def Canvas Object  {} {$self new_object obj}
  def Canvas Message {} {$self new_object msg}
***************
*** 2843,2846 ****
--- 2817,2824 ----
  }
  
+ proc remainder {val val2} {
+ 	if {[expr abs($val)]} {return [expr (abs($val)%$val2)*($val/abs($val))]} else {return 0}
+ }
+ 
  def Canvas motion_move {oldpos x y} {
  	mset {ox oy} $oldpos
***************
*** 2848,2852 ****
  	foreach obj $@selection {
  		if {[[$obj class] <= Box]} {
! 			$obj move [expr $x-$ox] [expr $y-$oy]
  		} else {
  			puts "Canvas motion warning: trying to move non-Box explicitly"
--- 2826,2846 ----
  	foreach obj $@selection {
  		if {[[$obj class] <= Box]} {
! 			if {[$self look snap_grid]} {
! 				set grid [$self look grid_size]
! 				set ax [expr (int($x)/$grid)*$grid]
! 				set ay [expr (int($y)/$grid)*$grid]
! 				set oax [expr (int($ox)/$grid)*$grid]
! 				set oay [expr (int($oy)/$grid)*$grid]
! 				mset {x1 y1} [$obj xy]
! 				if {![expr ($ax-$oax)%$grid]} {
! 					set xoff [remainder [expr int($x1-$ax)] $grid]
! 				} else {set xoff 0}
! 				if {![expr ($ay-$oay)%$grid]} {
! 					set yoff [remainder [expr int($y1-$ay)] $grid]
! 				} else {set yoff 0}
! 				$obj move [expr ($ax-$oax)-$xoff] [expr ($ay-$oay)-$yoff]
! 			} else {
! 				$obj move [expr $x-$ox] [expr $y-$oy]
! 			}
  		} else {
  			puts "Canvas motion warning: trying to move non-Box explicitly"
***************
*** 4836,4842 ****
  
  def Box move {dx dy} {
! 	mset {x y} [$self xy]
! 	set @x1 [expr $@x1+$dx]
! 	set @y1 [expr $@y1+$dy]
  	set zoom [$@canvas zoom]
  	$self changed ;# until we find a way to avoid rounding errors on [$@canvas widget] move.
--- 4830,4834 ----
  
  def Box move {dx dy} {
! 	set @x1 [expr $@x1+$dx]; set @y1 [expr $@y1+$dy]
  	set zoom [$@canvas zoom]
  	$self changed ;# until we find a way to avoid rounding errors on [$@canvas widget] move.
***************
*** 7804,7807 ****
--- 7796,7800 ----
      toggle Canvas gridstate
      integer Canvas grid_size
+     toggle Canvas snap_grid
      toggle Canvas buttonbar
      toggle Canvas statusbar

Index: defaults.ddrc
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/defaults.ddrc,v
retrieving revision 1.1.2.10.2.15
retrieving revision 1.1.2.10.2.16
diff -C2 -d -r1.1.2.10.2.15 -r1.1.2.10.2.16
*** defaults.ddrc	2 Aug 2007 18:01:24 -0000	1.1.2.10.2.15
--- defaults.ddrc	3 Aug 2007 02:48:17 -0000	1.1.2.10.2.16
***************
*** 27,30 ****
--- 27,31 ----
      gridstate 1
      grid_size 10
+     snap_grid 1
      showcomp 10
      statusbar 1