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