reduce drop point on strip A

[perl-landing-airplanes.git] / trace-path.pl

diff --git a/trace-path.pl b/trace-path.pl
index 202f8ac..9a6e865 100755 (executable)
--- a/trace-path.pl
+++ b/trace-path.pl
@@ -10,6 +10,7 @@ use SDL::Constants;
 use SDL::Event;
 use Math::CatmullRom;
 use Algorithm::Line::Bresenham qw(line);
+use Math::Bezier;
 
 use Carp qw(cluck);
 use Data::Dump qw(dump);
@@ -134,7 +135,23 @@ sub curve_catmull_rom {
 
        my $curve = Math::CatmullRom->new( @path );
        my $points = $#path + 1 - 4; # remove start/end points
-       my @curve = $curve->curve( $points );
+       return $curve->curve( $points );
+}
+
+sub curve_bezier {
+       my $curve = Math::Bezier->new( @path );
+       return $curve->curve( $#path + 1 );
+}
+
+our $curve_type = 0;
+
+sub curve {
+       # add landing path points
+       push @path, lading_points( $path[-2], $path[-1] ) if $#path > 1;
+
+       my $type = 1;
+
+       my @curve = $curve_type ? curve_catmull_rom : curve_bezier;
        debug 'curve' => @curve;
 
        my $i = 0;
@@ -147,22 +164,11 @@ sub curve_catmull_rom {
                        sub { $app->pixel( @_, $path_color ) }
                );
        }
-       push @airplanes, Airplane->new( $app );
-       $airplanes[-1]->set_path( @path );
        $app->sync;
-       reset_path;
-}
-
-sub curve {
-       # add landing path points
-       push @path, lading_points( $path[-2], $path[-1] ) if $#path > 1;
-
-       if ( 1 ) {
-               curve_catmull_rom;
-       } else {
-
-       }
 
+       push @airplanes, Airplane->new( $app );
+       $airplanes[-1]->set_path( @curve );
+       reset_path;
 }
 
 sub clear_screen {
@@ -208,6 +214,8 @@ sub handle_events {
                                $current_mask++;
                                $current_mask = 0 if $current_mask > $#masks;
                                clear_screen $current_mask;
+                       } elsif ( $key eq 't' ) { # XXX curve type
+                               $curve_type = ! $curve_type;
                        } else {
                                warn "unknown key $key";
                        }