133 lines
2.8 KiB
Raku
133 lines
2.8 KiB
Raku
#!/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);
|
|
}
|
|
}
|
|
}
|
|
|