File: anim.pl

package info (click to toggle)
libx11-protocol-perl 0.55-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 500 kB
  • ctags: 687
  • sloc: perl: 8,324; ansic: 580; makefile: 55
file content (132 lines) | stat: -rw-r--r-- 2,837 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
#!/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);
	}
    }
}