Viewing file:  anim.pl (2.77 KB) -rw-r--r--
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
#!/usr/bin/perl
use X11::Protocol;
use IO::Select;
$pi = 3.1415926535898;
$r = 1;
$theta = 0;
$size = 250;
$x = X11::Protocol->new;
$win = $x->new_rsrc;
$x->CreateWindow($win, $x->root, 'InputOutput', $x->root_depth,
'CopyFromParent', (0, 0), 2 * $size, 2 * $size, 1,
# 'backing_store' => 'Always',
'background_pixel' => $x->white_pixel);
$x->ChangeProperty($win, $x->atom('WM_NAME'), $x->atom('STRING'), 8,
'Replace', "Animation test");
$x->MapWindow($win);
$pm = $x->new_rsrc;
$x->CreatePixmap($pm, $win, $x->root_depth, 2 * $size, 2 * $size);
$gc = $x->new_rsrc;
$x->CreateGC($gc, $pm, 'foreground' => $x->black_pixel,
'graphics_exposures' => 0);
$egc = $x->new_rsrc;
$x->CreateGC($egc, $pm, 'foreground' => $x->white_pixel,
'graphics_exposures' => 0);
$x->PolyFillRectangle($pm, $egc, [(0, 0), 2 * $size, 2 * $size]);
$sel = IO::Select->new($x->connection->fh);
sub r2p {
my($x, $y) = @_;
$x -= .5;
$x *= .75;
$y -= .5;
return [-atan2($y, $x), sqrt($x*$x + $y*$y)];
}
$P = [[['Simple', $gc],
[r2p(0, 0),
r2p(.75, 0),
r2p(1, .25),
r2p(.75, .5),
r2p(.15, .5),
r2p(.15, 1),
r2p(0, 1)]],
[['Convex', $egc],
[r2p(.15, .15),
r2p(.75, .15),
r2p(.85, .25),
r2p(.75, .35),
r2p(.15, .35)]]];
$E = [[['Simple', $gc],
[r2p(0, 0),
r2p(1, 0),
r2p(1, .2),
r2p(.2, .2),
r2p(.2, .4),
r2p(.75, .4),
r2p(.75, .6),
r2p(.2, .6),
r2p(.2, .8),
r2p(1, .8),
r2p(1, 1),
r2p(0, 1)]]];
$R = [[['Simple', $gc],
[r2p(0, 0),
r2p(.75, 0),
r2p(1, .25),
r2p(.75, .5),
r2p(1, 1),
r2p(.85, 1),
r2p(.6, .5),
r2p(.15, .5),
r2p(.15, 1),
r2p(0, 1)]],
[['Convex', $egc],
[r2p(.15, .15),
r2p(.75, .15),
r2p(.85, .25),
r2p(.75, .35),
r2p(.15, .35)]]];
$L = [[['Simple', $gc],
[r2p(0, 0),
r2p(.2, 0),
r2p(.2, .8),
r2p(1, .8),
r2p(1, 1),
r2p(0, 1)]]];
for (;;) {
for $img ($P, $E, $R, $L) {
$r = 5;
while ($r < 6.25 * $size) {
@polys = ();
for $poly (@$img) {
@a = ($poly->[0]);
for $p (@{$poly->[1]}) {
push @{$a[1]}, $size +
$r * $p->[1] * sin($theta + $p->[0]);
push @{$a[1]}, $size +
$r * $p->[1] * cos($theta + $p->[0]);
}
push @polys, [@a];
}
for $poly (@old_polys) {
$x->FillPoly($pm, $egc, $poly->[0][0], 'Origin', @{$poly->[1]})
if $poly->[0][1] != $egc;
}
for $poly (@polys) {
$x->FillPoly($pm, $poly->[0][1], $poly->[0][0], 'Origin',
@{$poly->[1]});
}
$x->CopyArea($pm, $win, $gc, (0, 0), 2 * $size, 2 * $size, (0, 0));
# On my Linux/x86 2.0, anything less than 1/100 sec causes
# other things (e.g., mouse tracking) to slow down terribly.
$x->flush();
select(undef, undef, undef, 1/99);
@old_polys = @polys;
$r *= 1.05;
$theta += .1;
$x->handle_input if $sel->can_read(0);
}
}
}
|