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