1#!/usr/bin/perl
2
3use X11::Protocol;
4use IO::Select;
5
6$pi = 3.1415926535898;
7$r = 1;
8$theta = 0;
9$size = 250;
10
11$x = X11::Protocol->new;
12$win = $x->new_rsrc;
13$x->CreateWindow($win, $x->root, 'InputOutput', $x->root_depth,
14		 'CopyFromParent', (0, 0), 2 * $size, 2 * $size, 1,
15#		 'backing_store' => 'Always',
16		 'background_pixel' => $x->white_pixel);
17$x->ChangeProperty($win, $x->atom('WM_NAME'), $x->atom('STRING'), 8,
18		   'Replace', "Animation test");
19$x->MapWindow($win);
20$pm = $x->new_rsrc;
21$x->CreatePixmap($pm, $win, $x->root_depth, 2 * $size, 2 * $size);
22$gc = $x->new_rsrc;
23$x->CreateGC($gc, $pm, 'foreground' => $x->black_pixel,
24	     'graphics_exposures' => 0);
25$egc = $x->new_rsrc;
26$x->CreateGC($egc, $pm, 'foreground' => $x->white_pixel,
27	     'graphics_exposures' => 0);
28$x->PolyFillRectangle($pm, $egc, [(0, 0), 2 * $size, 2 * $size]);
29
30$sel = IO::Select->new($x->connection->fh);
31
32sub r2p {
33    my($x, $y) = @_;
34    $x -= .5;
35    $x *= .75;
36    $y -= .5;
37    return [-atan2($y, $x), sqrt($x*$x + $y*$y)];
38}
39
40$P = [[['Simple', $gc],
41       [r2p(0, 0),
42	r2p(.75, 0),
43	r2p(1, .25),
44	r2p(.75, .5),
45	r2p(.15, .5),
46	r2p(.15, 1),
47	r2p(0, 1)]],
48      [['Convex', $egc],
49       [r2p(.15, .15),
50	r2p(.75, .15),
51	r2p(.85, .25),
52	r2p(.75, .35),
53	r2p(.15, .35)]]];
54
55$E = [[['Simple', $gc],
56       [r2p(0, 0),
57	r2p(1, 0),
58	r2p(1, .2),
59	r2p(.2, .2),
60	r2p(.2, .4),
61	r2p(.75, .4),
62	r2p(.75, .6),
63	r2p(.2, .6),
64	r2p(.2, .8),
65	r2p(1, .8),
66	r2p(1, 1),
67	r2p(0, 1)]]];
68
69$R = [[['Simple', $gc],
70       [r2p(0, 0),
71	r2p(.75, 0),
72	r2p(1, .25),
73	r2p(.75, .5),
74	r2p(1, 1),
75	r2p(.85, 1),
76	r2p(.6, .5),
77	r2p(.15, .5),
78	r2p(.15, 1),
79	r2p(0, 1)]],
80      [['Convex', $egc],
81       [r2p(.15, .15),
82	r2p(.75, .15),
83	r2p(.85, .25),
84	r2p(.75, .35),
85	r2p(.15, .35)]]];
86
87$L = [[['Simple', $gc],
88       [r2p(0, 0),
89	r2p(.2, 0),
90	r2p(.2, .8),
91	r2p(1, .8),
92	r2p(1, 1),
93	r2p(0, 1)]]];
94
95for (;;) {
96    for $img ($P, $E, $R, $L) {
97	$r = 5;
98	while ($r < 6.25 * $size) {
99	    @polys = ();
100	    for $poly (@$img) {
101		@a = ($poly->[0]);
102		for $p (@{$poly->[1]}) {
103		    push @{$a[1]}, $size +
104			$r * $p->[1] * sin($theta + $p->[0]);
105		    push @{$a[1]}, $size +
106			$r * $p->[1] * cos($theta + $p->[0]);
107		}
108		push @polys, [@a];
109	    }
110	    for $poly (@old_polys) {
111		$x->FillPoly($pm, $egc, $poly->[0][0], 'Origin', @{$poly->[1]})
112		    if $poly->[0][1] != $egc;
113	    }
114	    for $poly (@polys) {
115		$x->FillPoly($pm, $poly->[0][1], $poly->[0][0], 'Origin',
116			     @{$poly->[1]});
117	    }
118	    $x->CopyArea($pm, $win, $gc, (0, 0), 2 * $size, 2 * $size, (0, 0));
119
120	    # On my Linux/x86 2.0, anything less than 1/100 sec causes
121	    # other things (e.g., mouse tracking) to slow down terribly.
122	    $x->flush();
123	    select(undef, undef, undef, 1/99);
124
125	    @old_polys = @polys;
126	    $r *= 1.05;
127	    $theta += .1;
128	    $x->handle_input if $sel->can_read(0);
129	}
130    }
131}
132
133