x.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Gtk2 -init;
   7 use Cairo;
   8
   9 my $pi = 3.1415926536;
  10
  11 sub para($$$$$) {
  12         # draw a parabola y=a(x-x0)^2 + y0
  13         my ($cairo,$a,$x0,$y0,$ww) = @_;
  14         my $been = 0;
  15         for (my $x=0; $x<$ww; $x++) {
  16                 my $y = $a*($x-$x0)*($x-$x0) + $y0;
  17                 next if ($y < -10000 || $y > 10000);
  18                 if ($been++) {
  19                         $cairo->line_to($x, $y);
  20                 } else {
  21                         $cairo->move_to($x, $y);
  22                 }
  23         }
  24         $cairo->stroke;
  25 }
  26
  27 sub solve_para($$$) {
  28         my ($h0, $x0, $y0) = @_;
  29         my $h = $y0 - $h0;
  30         return (1/(2*$h), $x0, $h0 + $h/2);
  31 }
  32
  33 sub solve_circ($$$$$$) {
  34         my ($x0, $y0, $x1, $y1, $x2, $y2) = @_;
  35         my $axc = ($x0 + $x1) / 2;
  36         my $ayc = ($y0 + $y1) / 2;
  37         my $adx = $y1 - $y0;
  38         my $ady = $x0 - $x1;
  39         my $bxc = ($x1 + $x2) / 2;
  40         my $byc = ($y1 + $y2) / 2;
  41         my $bdx = $y2 - $y1;
  42         my $bdy = $x1 - $x2;
  43         my $alpha = (($bxc-$axc)*(-$bdy) - ($byc-$ayc)*(-$bdx)) /
  44                     ($adx*(-$bdy) - $ady*(-$bdx));
  45         my $x = $axc + $alpha*$adx;
  46         my $y = $ayc + $alpha*$ady;
  47         my $r = sqrt(($x-$x0)*($x-$x0) + ($y-$y0)*($y-$y0));
  48         return ($x, $y, $r);
  49 }
  50
  51 my $area = Gtk2::DrawingArea->new();
  52 my $cairo;
  53 my $dh = 625;
  54 sub draw() {
  55         my $win = $area->window;
  56         my $alloc = $area->allocation;
  57         my $w = $alloc->width;
  58         my $h = $alloc->height;
  59
  60         $cairo = Gtk2::Gdk::Cairo::Context->create($win);
  61         $cairo->rectangle(0, 0, $w, $h);
  62         $cairo->set_source_rgb(0, 0, 0);
  63         $cairo->fill;
  64
  65         my @pts = ( [$w/3, $h-600], [$w/2, $h-700], [2*$w/3, $h-650] );
  66         my ($cx, $cy, $cr) = solve_circ($pts[0]->[0], $pts[0]->[1], $pts[1]->[0], $pts[1]->[1], $pts[2]->[0], $pts[2]->[1]);
  67
  68         for (my $i=0; $i<$#pts; $i++) {
  69                 my $p = $pts[$i];
  70                 my $q = $pts[$i+1];
  71                 my $xc = ($p->[0] + $q->[0]) / 2;
  72                 my $yc = ($p->[1] + $q->[1]) / 2;
  73                 my $dx = ($q->[1] - $p->[1]);
  74                 my $dy = ($p->[0] - $q->[0]);
  75                 $cairo->set_source_rgb(0.5, 0, 0.5);
  76                 $cairo->move_to($xc - 10*$dx, $yc - 10*$dy);
  77                 $cairo->line_to($xc + 10*$dx, $yc + 10*$dy);
  78                 $cairo->stroke;
  79                 $cairo->set_source_rgb(0.5, 0.5, 0.5);
  80                 $cairo->move_to($p->[0], $p->[1]);
  81                 $cairo->line_to($q->[0], $q->[1]);
  82                 $cairo->stroke;
  83         }
  84         {
  85                 my $p = $pts[0];
  86                 my $q = $pts[2];
  87                 my $xc = ($p->[0] + $q->[0]) / 2;
  88                 my $yc = ($p->[1] + $q->[1]) / 2;
  89                 my $dx = ($q->[1] - $p->[1]);
  90                 my $dy = ($p->[0] - $q->[0]);
  91                 $cairo->set_source_rgb(0.5, 0, 0.5);
  92                 $cairo->move_to($xc - 10*$dx, $yc - 10*$dy);
  93                 $cairo->line_to($xc + 10*$dx, $yc + 10*$dy);
  94                 $cairo->stroke;
  95                 $cairo->set_source_rgb(0.5, 0.5, 0.5);
  96                 $cairo->move_to($p->[0], $p->[1]);
  97                 $cairo->line_to($q->[0], $q->[1]);
  98                 $cairo->stroke;
  99         }
 100
 101         $cairo->set_source_rgb(1, 0, 1);
 102         $cairo->arc($cx, $cy, $cr, 0, 2*$pi);
 103         $cairo->stroke;
 104
 105         $cairo->set_source_rgb(1, 1, 1);
 106         my $h0 = $h-$dh;
 107         $cairo->move_to(0, $h0);
 108         $cairo->line_to($w, $h0);
 109         $cairo->stroke;
 110
 111         foreach my $p (@pts) {
 112                 $cairo->arc($p->[0], $p->[1], 2, 0, 2*$pi);
 113                 $cairo->fill;
 114         }
 115
 116         $cairo->set_source_rgb(0, 1, 0);
 117         foreach my $p (@pts) {
 118                 next if ($p->[1] > $h0);
 119                 my ($pa,$px,$py) = solve_para($h0, $p->[0], $p->[1]);
 120                 para($cairo, $pa, $px, $py, $w);
 121         }
 122 }
 123
 124 my $timer;
 125 $area->signal_connect("expose-event" => sub {
 126         draw();
 127 });
 128
 129 my $window = Gtk2::Window->new ('toplevel');
 130 $window->signal_connect ("delete-event" => sub { Gtk2->main_quit });
 131 $window->set_title("Brum");
 132 $window->set_wmclass("anim", "Anim");
 133 $window->set_default_size(640, 480);
 134 $window->add ($area);
 135 $window->show_all;
 136 $window->fullscreen;
 137 $window->signal_connect("key-press-event" => sub {
 138         $dh -= 10;
 139         draw();
 140 });
 141
 142 Gtk2->main;