--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Gtk2 -init;
+use Cairo;
+
+my $pi = 3.1415926536;
+
+sub sqr($) {
+ my ($x) = @_;
+ return $x * $x;
+}
+
+sub is_zero($) {
+ my ($x) = @_;
+ return ($x < 1e-10 && $x > -1e-10);
+}
+
+sub draw_para($$$$$) {
+ # Draw a parabola y=a(x-x0)^2 + y0
+ my ($cairo,$a,$x0,$y0,$ww) = @_;
+ if (!defined($a)) {
+ # Degenerate parabola
+ $cairo->move_to($x0, $y0);
+ $cairo->line_to($x0, 0);
+ } else {
+ my $been = 0;
+ for (my $x=0; $x<$ww; $x++) {
+ my $y = $a*sqr($x-$x0) + $y0;
+ next if ($y < -10000 || $y > 10000);
+ if ($been++) {
+ $cairo->line_to($x, $y);
+ } else {
+ $cairo->move_to($x, $y);
+ }
+ }
+ }
+ $cairo->stroke;
+}
+
+sub solve_para($$$) {
+ my ($h0, $x0, $y0) = @_;
+ my $h = $y0 - $h0;
+ if (is_zero($h)) {
+ return (undef, $x0, $h0);
+ } else {
+ return (1/(2*$h), $x0, $h0 + $h/2);
+ }
+}
+
+sub solve_circ($$$$$$) {
+ my ($x0, $y0, $x1, $y1, $x2, $y2) = @_;
+ my $axc = ($x0 + $x1) / 2;
+ my $ayc = ($y0 + $y1) / 2;
+ my $adx = $y1 - $y0;
+ my $ady = $x0 - $x1;
+ my $bxc = ($x1 + $x2) / 2;
+ my $byc = ($y1 + $y2) / 2;
+ my $bdx = $y2 - $y1;
+ my $bdy = $x1 - $x2;
+ my $alpha = (($bxc-$axc)*(-$bdy) - ($byc-$ayc)*(-$bdx)) /
+ ($adx*(-$bdy) - $ady*(-$bdx));
+ my $x = $axc + $alpha*$adx;
+ my $y = $ayc + $alpha*$ady;
+ my $r = sqrt(sqr($x-$x0) + sqr($y-$y0));
+ return ($x, $y, $r);
+}
+
+sub para_isec($$$$$$) {
+ # Parameters of two parabolas
+ my ($a, $b, $c, $d, $e, $f) = @_;
+ if (!defined($a) || !defined($b)) {
+ # Either is degenerate
+ return;
+ }
+ # Coefficients of the corresponding quadratic equation
+ my $A = $a - $d;
+ my $B = 2*($d*$e - $a*$b);
+ my $C = $a*sqr($b) - $d*sqr($e) + $c - $f;
+ # Is the equation linear?
+ if (is_zero($A)) {
+ if (is_zero($B)) { return; }
+ my $x = -$C/$B;
+ my $y = $a*sqr($x-$b) + $c;
+ return [$x, $y];
+ }
+ # No, really quadratic. Consider its discriminant.
+ my $D = sqr($B) - 4*$A*$C;
+ if ($D < 0) {
+ return;
+ } elsif (is_zero($D)) {
+ my $x = -$B / (2*$A);
+ my $y = $a*sqr($x-$b) + $c;
+ return [$x, $y];
+ } else {
+ my $DD = sqrt($D);
+ my $x1 = (-$B + $DD) / (2*$A);
+ my $x2 = (-$B - $DD) / (2*$A);
+ if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); }
+ my $y1 = $a*sqr($x1-$b) + $c;
+ my $y2 = $a*sqr($x2-$b) + $c;
+ return ([$x1,$y1], [$x2,$y2]); # In order left, right
+ }
+}
+
+my $area = Gtk2::DrawingArea->new();
+my $cairo;
+my $dh = 620;
+sub draw() {
+ my $win = $area->window;
+ my $alloc = $area->allocation;
+ my $w = $alloc->width;
+ my $h = $alloc->height;
+
+ $cairo = Gtk2::Gdk::Cairo::Context->create($win);
+ $cairo->rectangle(0, 0, $w, $h);
+ $cairo->set_source_rgb(0, 0, 0);
+ $cairo->fill;
+
+ my @pts = ( [$w/3, $h-600], [$w/2, $h-700], [2*$w/3, $h-650] );
+ my ($cx, $cy, $cr) = solve_circ($pts[0]->[0], $pts[0]->[1], $pts[1]->[0], $pts[1]->[1], $pts[2]->[0], $pts[2]->[1]);
+ my $ch = $cy + $cr;
+ my $h0 = $h-$dh;
+ if (abs($ch-$h0) < 2) {
+ $h0 = $ch;
+ }
+
+ for (my $i=0; $i<$#pts; $i++) {
+ my $p = $pts[$i];
+ my $q = $pts[$i+1];
+ my $xc = ($p->[0] + $q->[0]) / 2;
+ my $yc = ($p->[1] + $q->[1]) / 2;
+ my $dx = ($q->[1] - $p->[1]);
+ my $dy = ($p->[0] - $q->[0]);
+ $cairo->set_source_rgb(0.5, 0, 0.5);
+ $cairo->move_to($xc - 10*$dx, $yc - 10*$dy);
+ $cairo->line_to($xc + 10*$dx, $yc + 10*$dy);
+ $cairo->stroke;
+ $cairo->set_source_rgb(0.5, 0.5, 0.5);
+ $cairo->move_to($p->[0], $p->[1]);
+ $cairo->line_to($q->[0], $q->[1]);
+ $cairo->stroke;
+ }
+ {
+ my $p = $pts[0];
+ my $q = $pts[2];
+ my $xc = ($p->[0] + $q->[0]) / 2;
+ my $yc = ($p->[1] + $q->[1]) / 2;
+ my $dx = ($q->[1] - $p->[1]);
+ my $dy = ($p->[0] - $q->[0]);
+ $cairo->set_source_rgb(0.5, 0, 0.5);
+ $cairo->move_to($xc - 10*$dx, $yc - 10*$dy);
+ $cairo->line_to($xc + 10*$dx, $yc + 10*$dy);
+ $cairo->stroke;
+ $cairo->set_source_rgb(0.5, 0.5, 0.5);
+ $cairo->move_to($p->[0], $p->[1]);
+ $cairo->line_to($q->[0], $q->[1]);
+ $cairo->stroke;
+ }
+
+ $cairo->set_source_rgb(1, 0, 1);
+ $cairo->arc($cx, $cy, $cr, 0, 2*$pi);
+ $cairo->stroke;
+
+ $cairo->set_source_rgb(1, 1, 1);
+ $cairo->move_to(0, $h0);
+ $cairo->line_to($w, $h0);
+ $cairo->stroke;
+
+ foreach my $p (@pts) {
+ $cairo->arc($p->[0], $p->[1], 2, 0, 2*$pi);
+ $cairo->fill;
+ }
+
+ $cairo->set_source_rgb(0, 1, 0);
+ my @paras = ();
+ foreach my $p (@pts) {
+ next if ($p->[1] > $h0);
+ my ($pa,$px,$py) = solve_para($h0, $p->[0], $p->[1]);
+ draw_para($cairo, $pa, $px, $py, $w);
+ push @paras, [$pa,$px,$py];
+ }
+ if ($h0 > $ch) {
+ splice @paras, 1, 1;
+ }
+ for (my $i=0; $i<$#paras; $i++) {
+ my $p = $paras[$i];
+ my $q = $paras[$i+1];
+ my @isec = para_isec($p->[0], $p->[1], $p->[2], $q->[0], $q->[1], $q->[2]);
+ foreach my $pt (@isec) {
+ $cairo->set_source_rgb(1, 0, 0);
+ $cairo->arc($pt->[0], $pt->[1], 2, 0, 2*$pi);
+ $cairo->fill;
+ }
+ }
+}
+
+my $timer;
+$area->signal_connect("expose-event" => sub {
+ draw();
+});
+
+my $window = Gtk2::Window->new ('toplevel');
+$window->signal_connect ("delete-event" => sub { Gtk2->main_quit });
+$window->set_title("Brum");
+$window->set_wmclass("anim", "Anim");
+$window->set_default_size(640, 480);
+$window->add ($area);
+$window->show_all;
+$window->fullscreen;
+$window->signal_connect("key-press-event" => sub {
+ my ($w, $evt) = @_;
+ my $k = Gtk2::Gdk::keyval_name(0, $evt->keyval);
+ if ($k eq "space" || $k eq "Right" || $k eq "Return") {
+ $dh -= 10;
+ draw();
+ } elsif ($k eq "q" || $k eq "Escape") {
+ Gtk2->main_quit;
+ }
+});
+
+Gtk2->main;
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Gtk2 -init;
-use Cairo;
-
-my $pi = 3.1415926536;
-
-sub para($$$$$) {
- # draw a parabola y=a(x-x0)^2 + y0
- my ($cairo,$a,$x0,$y0,$ww) = @_;
- my $been = 0;
- for (my $x=0; $x<$ww; $x++) {
- my $y = $a*($x-$x0)*($x-$x0) + $y0;
- next if ($y < -10000 || $y > 10000);
- if ($been++) {
- $cairo->line_to($x, $y);
- } else {
- $cairo->move_to($x, $y);
- }
- }
- $cairo->stroke;
-}
-
-sub solve_para($$$) {
- my ($h0, $x0, $y0) = @_;
- my $h = $y0 - $h0;
- return (1/(2*$h), $x0, $h0 + $h/2);
-}
-
-sub solve_circ($$$$$$) {
- my ($x0, $y0, $x1, $y1, $x2, $y2) = @_;
- my $axc = ($x0 + $x1) / 2;
- my $ayc = ($y0 + $y1) / 2;
- my $adx = $y1 - $y0;
- my $ady = $x0 - $x1;
- my $bxc = ($x1 + $x2) / 2;
- my $byc = ($y1 + $y2) / 2;
- my $bdx = $y2 - $y1;
- my $bdy = $x1 - $x2;
- my $alpha = (($bxc-$axc)*(-$bdy) - ($byc-$ayc)*(-$bdx)) /
- ($adx*(-$bdy) - $ady*(-$bdx));
- my $x = $axc + $alpha*$adx;
- my $y = $ayc + $alpha*$ady;
- my $r = sqrt(($x-$x0)*($x-$x0) + ($y-$y0)*($y-$y0));
- return ($x, $y, $r);
-}
-
-my $area = Gtk2::DrawingArea->new();
-my $cairo;
-my $dh = 625;
-sub draw() {
- my $win = $area->window;
- my $alloc = $area->allocation;
- my $w = $alloc->width;
- my $h = $alloc->height;
-
- $cairo = Gtk2::Gdk::Cairo::Context->create($win);
- $cairo->rectangle(0, 0, $w, $h);
- $cairo->set_source_rgb(0, 0, 0);
- $cairo->fill;
-
- my @pts = ( [$w/3, $h-600], [$w/2, $h-700], [2*$w/3, $h-650] );
- my ($cx, $cy, $cr) = solve_circ($pts[0]->[0], $pts[0]->[1], $pts[1]->[0], $pts[1]->[1], $pts[2]->[0], $pts[2]->[1]);
-
- for (my $i=0; $i<$#pts; $i++) {
- my $p = $pts[$i];
- my $q = $pts[$i+1];
- my $xc = ($p->[0] + $q->[0]) / 2;
- my $yc = ($p->[1] + $q->[1]) / 2;
- my $dx = ($q->[1] - $p->[1]);
- my $dy = ($p->[0] - $q->[0]);
- $cairo->set_source_rgb(0.5, 0, 0.5);
- $cairo->move_to($xc - 10*$dx, $yc - 10*$dy);
- $cairo->line_to($xc + 10*$dx, $yc + 10*$dy);
- $cairo->stroke;
- $cairo->set_source_rgb(0.5, 0.5, 0.5);
- $cairo->move_to($p->[0], $p->[1]);
- $cairo->line_to($q->[0], $q->[1]);
- $cairo->stroke;
- }
- {
- my $p = $pts[0];
- my $q = $pts[2];
- my $xc = ($p->[0] + $q->[0]) / 2;
- my $yc = ($p->[1] + $q->[1]) / 2;
- my $dx = ($q->[1] - $p->[1]);
- my $dy = ($p->[0] - $q->[0]);
- $cairo->set_source_rgb(0.5, 0, 0.5);
- $cairo->move_to($xc - 10*$dx, $yc - 10*$dy);
- $cairo->line_to($xc + 10*$dx, $yc + 10*$dy);
- $cairo->stroke;
- $cairo->set_source_rgb(0.5, 0.5, 0.5);
- $cairo->move_to($p->[0], $p->[1]);
- $cairo->line_to($q->[0], $q->[1]);
- $cairo->stroke;
- }
-
- $cairo->set_source_rgb(1, 0, 1);
- $cairo->arc($cx, $cy, $cr, 0, 2*$pi);
- $cairo->stroke;
-
- $cairo->set_source_rgb(1, 1, 1);
- my $h0 = $h-$dh;
- $cairo->move_to(0, $h0);
- $cairo->line_to($w, $h0);
- $cairo->stroke;
-
- foreach my $p (@pts) {
- $cairo->arc($p->[0], $p->[1], 2, 0, 2*$pi);
- $cairo->fill;
- }
-
- $cairo->set_source_rgb(0, 1, 0);
- foreach my $p (@pts) {
- next if ($p->[1] > $h0);
- my ($pa,$px,$py) = solve_para($h0, $p->[0], $p->[1]);
- para($cairo, $pa, $px, $py, $w);
- }
-}
-
-my $timer;
-$area->signal_connect("expose-event" => sub {
- draw();
-});
-
-my $window = Gtk2::Window->new ('toplevel');
-$window->signal_connect ("delete-event" => sub { Gtk2->main_quit });
-$window->set_title("Brum");
-$window->set_wmclass("anim", "Anim");
-$window->set_default_size(640, 480);
-$window->add ($area);
-$window->show_all;
-$window->fullscreen;
-$window->signal_connect("key-press-event" => sub {
- $dh -= 10;
- draw();
-});
-
-Gtk2->main;
projects / anim.git / commitdiff