aboutsummaryrefslogtreecommitdiff
path: root/sandbox
diff options
context:
space:
mode:
Diffstat (limited to 'sandbox')
-rw-r--r--sandbox/Controls.pm191
-rw-r--r--sandbox/controls.pl168
2 files changed, 191 insertions, 168 deletions
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('<ButtonPress-1>', \&start_lasso);
+ $zinc->bind('<ButtonRelease-1>', \&fin_lasso);
+ $zinc->bind('<ButtonPress-2>', sub { my @closest = $zinc->find('closest',
+ $zinc->XEvent->x,
+ $zinc->XEvent->y);
+ print "at point=$closest[0]\n" });
+
+ $zinc->bind('<ButtonPress-3>', [\&press, \&motion]);
+ $zinc->bind('<ButtonRelease-3>', \&release);
+
+ $zinc->bind('<Shift-ButtonPress-3>', [\&press, \&zoom]);
+ $zinc->bind('<Shift-ButtonRelease-3>', \&release);
+
+ $zinc->bind('<Control-ButtonPress-3>', [\&press, \&rotate]);
+ $zinc->bind('<Control-ButtonRelease-3>', \&release);
+
+ $zinc->bind('current', '<Enter>', \&showbox);
+ $zinc->bind('current', '<Leave>', \&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('<Motion>', $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('<Motion>', '');
+}
+
+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('<Motion>', \&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('<Motion>', '');
+ $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 "<Motion>" "$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 "<Motion>" ""
-}
-
-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 "<Motion>" "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 "<Motion>" ""
- .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('<ButtonPress-1>', "start_lasso %x %y");
-$zinc->bind('<ButtonRelease-1>', \&fin_lasso);
-$zinc->bind('<ButtonPress-2>', sub { $closest = $zinc->find('closest', %x %y);
- print "at point=$closest\n" });
-
-$zinc->bind('<ButtonPress-3>', "press %x %y motion");
-$zinc->bind('<ButtonRelease-3>', \&release);
-
-$zinc->bind('<Shift-ButtonPress-3>', "press %x %y zoom");
-$zinc->bind('<Shift-ButtonRelease-3>', \&release);
-
-$zinc->bind('<Control-ButtonPress-3>' "press %x %y rotate");
-$zinc->bind('<Control-ButtonRelease-3>', \&release);
-
-$zinc->bind('current', '<Enter>', \&showbox);
-$zinc->bind('current', '<Leave>', {hidebox %x %y});
generated by cgit v1.1 at 2024-11-03 01:35:29 +0000