From a41e2eb20ce6db5dfb65791b47d0cf145458f8f1 Mon Sep 17 00:00:00 2001 From: lecoanet Date: Mon, 19 Feb 2001 15:01:03 +0000 Subject: *** empty log message *** --- sandbox/Controls.pm | 191 ++++++++++++++++++++++++++++++++++++++++++++++++++++ sandbox/controls.pl | 168 --------------------------------------------- 2 files changed, 191 insertions(+), 168 deletions(-) create mode 100644 sandbox/Controls.pm delete mode 100644 sandbox/controls.pl (limited to 'sandbox') diff --git a/sandbox/Controls.pm b/sandbox/Controls.pm new file mode 100644 index 0000000..b432129 --- /dev/null +++ b/sandbox/Controls.pm @@ -0,0 +1,191 @@ + +package controls; + +$cur_x = 0; +$cur_y = 0; +$cur_angle = 0; +$corner_x = 0; +$corner_y = 0; +$top = 1; + +sub new { + $tlbbox = $zinc->add('group', $top, + -sensitive => 0, -visible => 0, + -tags 'currentbbox'); + $zinc->add('rectangle', $tlbbox, [-3, -3, +3, +3]); + $trbbox = $zinc->add('group', $top, + -sensitive => 0, -visible => 0, + -tags => 'currentbbox'); + $zinc->add('rectangle', $trbbox, [-3, -3, +3, +3]); + $blbbox = $zinc->add('group', $top, + -sensitive => 0, -visible => 0, + -tags => 'currentbbox'); + $zinc->add('rectangle', $blbbox, [-3, -3, +3, +3]); + $brbbox = $zinc->add('group', $top, + -sensitive => 0, -visible => 0, + -tags 'currentbbox'); + $zinc->add('rectangle', $brbbox, [-3, -3, +3, +3]); + $zinc->add('rectangle', $top, [0, 0, 1, 1], + -linecolor => 'red', -tags => 'lasso', + -visible => 0, -sensitive => 0); + + $zinc->bind('', \&start_lasso); + $zinc->bind('', \&fin_lasso); + $zinc->bind('', sub { my @closest = $zinc->find('closest', + $zinc->XEvent->x, + $zinc->XEvent->y); + print "at point=$closest[0]\n" }); + + $zinc->bind('', [\&press, \&motion]); + $zinc->bind('', \&release); + + $zinc->bind('', [\&press, \&zoom]); + $zinc->bind('', \&release); + + $zinc->bind('', [\&press, \&rotate]); + $zinc->bind('', \&release); + + $zinc->bind('current', '', \&showbox); + $zinc->bind('current', '', \&hidebox); +} + +# +# Controls for the window transform. +# +sub press { + my ($action) = @_; + my $lx = $zinc->XEvent->x; + my $ly = $zinc->XEvent->y; + + $cur_x $lx; + $cur_y $ly; + $cur_angle = atan2($y, $x); + $zinc->bind('', $action); +} + +sub motion { + my $lx = $zinc->XEvent->x; + my $ly = $zinc->XEvent->y; + my @it; + my @res; + + @it = $zinc->find('withtag' 'controls'); + if (scalar(@it) == 0) { + return; + } + @res = $zinc->transform($it[0], [$lx, $ly, $cur_x, $cur_y]); + $zinc->translate('controls', $res[0] - $res[2], $res[1] - $res[3]); + $cur_x = $lx; + $cur_y = $ly; +} + +sub zoom { + my $lx = $zinc->XEvent->x; + my $ly = $zinc->XEvent->y; + my $maxx; + my $maxy; + my $sx; + my $sy; + + if ($lx > $cur_x) { + $maxx = $lx; + } else { + $maxx = $cur_x + } + if ($ly > $cur_y) { + $maxy = $ly + } else { + $maxy = $cur_y + } + $sx = 1.0 + ($lx - $cur_x)/$maxx; + $sy = 1.0 + ($ly - $cur_y)/$maxy; + $cur_x = $lx; + $cur_y = $ly; + $zinc->scale('controls', $sx, $sy); +} + +sub rotate { + my $lx = $zinc->XEvent->x; + my $ly = $zinc->XEvent->y; + my $langle; + + $langle = atan2($ly, $lx); + $zinc->rotate('controls', -($langle - $cur_angle)); + $cur_angle = $langle; +} + +sub release { + $zinc->bind('', ''); +} + +sub start_lasso { + my $lx = $zinc->XEvent->x; + my $ly = $zinc->XEvent->y; + my @coords; + + $cur_x = $lx; + $cur_y = $ly; + $corner_x = $lx; + $corner_y = $ly; + @coords = $zinc->transform($top, [$x, $y]); + $zinc->coords('lasso', [$coords[0], $coords[1], $coords[0], $coords[1]]); + $zinc->itemconfigure('lasso' -visible => 1); + $zinc->raise('lasso'); + $zinc->bind('', \&lasso); +} + +sub lasso { + my $lx = $zinc->XEvent->x; + my $ly = $zinc->XEvent->y; + my @coords; + + $corner_x = $lx; + $corner_y = $ly; + @coords = $zinc->transform($top [$cur_x, $cur_y, $lx, $ly]); + $zinc->coords('lasso', [$coords[0], $$coords[1], $coords[2], $coords[3]]); +} + +sub fin_lasso { + my $enclosed = join(', ', + $zinc->find('enclosed', $cur_x, $cur_y, $corner_x, $corner_y)); + my $overlapping = join(', ', + $zinc->find('overlapping', $cur_x, $cur_y, $corner_x, $corner_y)); + + $zinc->bind('', ''); + $zinc->itemconfigure('lasso', -visible => 0); + print "enclosed=$enclosed, overlapping=$overlapping\n" +} + +sub showbox { + my @coords; + my @it; + + if (! $zinc->hastag('current' 'currentbbox')) { + @it = $zinc->find('withtag', 'current'); + if (scalar(@it) == 0) { + return; + } + @coords = $zinc->transform($top, $zinc->bbox('current')); + + $zinc->coords($tlbbox, [$coords[0], $coords[1]]); + $zinc->coords($trbbox, [$coords[2], $coords[1]]); + $zinc->coords($brbbox, [$coords[2], $coords[3]]); + $zinc->coords($blbbox, [$coords[0], $coords[3]]); + $zinc->itemconfigure('currentbbox', -visible => 1); + } +} + +sub hidebox { + my $lx = $zinc->XEvent->x; + my $ly = $zinc->XEvent->y; + my @next; + + @next = $zinc->find('closest' $lx, $ly); + if ((scalar(@next) == 0) || + ! $zinc->hastag($next[0], 'currentbbox') || + $zinc->hastag('current', 'currentbbox')) { + $zinc->itemconfigure('currentbbox', -visible => 0); + } +} + + diff --git a/sandbox/controls.pl b/sandbox/controls.pl deleted file mode 100644 index fcddda5..0000000 --- a/sandbox/controls.pl +++ /dev/null @@ -1,168 +0,0 @@ -$tlbbox = $zinc->add('group', $top, - -sensitive => 0, -visible => 0, - -tags 'currentbbox'); -$zinc->add('rectangle', $tlbbox, [-3, -3, +3, +3]); -$trbbox = $zinc->add('group', $top, - -sensitive => 0, -visible => 0, - -tags => 'currentbbox'); -$zinc->add('rectangle', $trbbox, [-3, -3, +3, +3]); -$blbbox = $zinc->add('group', $top, - -sensitive => 0, -visible => 0, - -tags => 'currentbbox'); -$zinc->add('rectangle', $blbbox, [-3, -3, +3, +3]); -$brbbox = $zinc->add('group', $top, - -sensitive => 0, -visible => 0, - -tags 'currentbbox'); -$zinc->add('rectangle', $brbbox, [-3, -3, +3, +3]); -$zinc->add('rectangle', $top, [0, 0, 1, 1], - -linecolor => 'red', -tags => 'lasso', - -visible => 0, -sensitive => 0); - -# -# Controls for the window transform. -# -proc press {lx ly action} { - global x y angle - set x $lx - set y $ly - set angle [expr atan2($y, $x)] - bind .r "" "$action %x %y" -} - -proc motion {lx ly} { - global x y - set it [.r find withtag controls] - if {$it != ""} { - set it [.r group [lindex $it 0]] - } - set res [.r transform $it "$lx $ly $x $y"] - set nx [lindex $res 0] - set ny [lindex $res 1] - set ox [lindex $res 2] - set oy [lindex $res 3] - .r translate controls [expr $nx - $ox] [expr $ny - $oy] - set x $lx - set y $ly -} - -proc zoom {lx ly} { - global x y - - if {$lx > $x} { - set maxx $lx - } else { - set maxx $x - } - if {$ly > $y} { - set maxy $ly - } else { - set maxy $y - } - set sx [expr 1.0 + double($lx - $x)/$maxx] - set sy [expr 1.0 + double($ly - $y)/$maxy] - set x $lx - set y $ly - .r scale controls $sx $sy -} - -proc rotate {lx ly} { - global angle - - set langle [expr atan2($ly, $lx)] - .r rotate controls [expr -($langle-$angle)] - set angle $langle -} - -proc release {} { - bind .r "" "" -} - -proc start_lasso {lx ly} { - global top x y cx cy - set x $lx - set y $ly - set cx $lx - set cy $ly - set coords [.r transform $top "$x $y"] - set fx [lindex $coords 0] - set fy [lindex $coords 1] - .r coords lasso "$fx $fy $fx $fy" - .r itemconfigure lasso -visible t - .r raise lasso - bind .r "" "lasso %x %y" -} - -proc lasso {lx ly} { - global top x y cx cy - set cx $lx - set cy $ly - set coords [.r transform $top "$x $y $lx $ly"] - set fx [lindex $coords 0] - set fy [lindex $coords 1] - set fcx [lindex $coords 2] - set fcy [lindex $coords 3] - .r coords lasso "$fx $fy $fcx $fcy" -} - -proc fin_lasso {} { - global x y cx cy - - bind .r "" "" - .r itemconfigure lasso -visible f -# puts "x=$x, y=$y, cx=$cx, cy=$cy" - puts "enclosed='[.r find enclosed $x $y $cx $cy]', overlapping='[.r find overlapping $x $y $cx $cy]'" -} - -proc getrect {x y} { - list [expr $x-3] [expr $y-3] [expr $x+3] [expr $y+3] -} - -proc showbox {} { - global top tlbbox trbbox blbbox brbbox - - if { ! [.r hastag current currentbbox]} { - if {[catch {.r find withtag current} item] } { - return - } - set coords [.r transform $top [.r bbox current]] - set xo [lindex $coords 0] - set yo [lindex $coords 1] - set xc [lindex $coords 2] - set yc [lindex $coords 3] - - .r coords $tlbbox "$xo $yo" - .r coords $trbbox "$xc $yo" - .r coords $brbbox "$xc $yc" - .r coords $blbbox "$xo $yc" - .r itemconfigure currentbbox -visible t - } -} - -proc hidebox {lx ly} { - set next [.r find closest $lx $ly] - if {[llength $next] > 1} { - set next [lindex $next 0] - } - if { $next == "" || ! [.r hastag $next currentbbox] ||\ - [.r hastag current currentbbox]} { - .r itemconfigure currentbbox -visible f - } -} - - -$zinc->bind('', "start_lasso %x %y"); -$zinc->bind('', \&fin_lasso); -$zinc->bind('', sub { $closest = $zinc->find('closest', %x %y); - print "at point=$closest\n" }); - -$zinc->bind('', "press %x %y motion"); -$zinc->bind('', \&release); - -$zinc->bind('', "press %x %y zoom"); -$zinc->bind('', \&release); - -$zinc->bind('' "press %x %y rotate"); -$zinc->bind('', \&release); - -$zinc->bind('current', '', \&showbox); -$zinc->bind('current', '', {hidebox %x %y}); -- cgit v1.1