#!/usr/bin/perl -w
use strict;
use SDL;
use SDLMove;
use SDL::TTFont;

local *main::TEXT_SHADED = \&SDL::Event::TEXT_SHADED;

my $SPEED_MS    = 20;
my $FRAMES_PSEC = 1000.0/$SPEED_MS;
my $VTERM_FREE  = 50; # Terminal speed
my $VTERM_PARA  =  3; # ... with parachute
my $WIDTH       = 158;
my $HEIGHT      = 500;
my $G           = 9.81;
my $MAX_LAND    = 3.1;

my $bg_color = SDL::Color->new(
  -r => 0, -g => 0, -b => 0 );
my $fg_color = SDL::Color->new(
  -r => 0xff, -g => 0x0, -b => 0x0 );

my $logo = SDL::Surface->new(
              -name => "logo.png");
  # Load player icons
my $diver = SDL::Surface->new(
              -name => "dive.png");
my $para = SDL::Surface->new(
              -name => "para.png");

my $app = SDL::App->new(
  -title => "Skydive 1.0", -depth => 16,
  -width => $WIDTH, -height => $HEIGHT);

my $fontpath = "/usr/X11R6/lib/X11/fonts/TTF/VeraMono.ttf";
$fontpath = "/usr/share/fonts/truetype/ttf-bitstream-vera/VeraMono.ttf"
  if ! -f $fontpath;

my $font = SDL::TTFont->new(
  -name => $fontpath,
  -size=>15,
  -bg => $bg_color, -fg => $fg_color);

my $lrect = SDL::Rect->new(
  -width  => $logo->width, 
  -height => $logo->height,
  -x => 0, -y => 0);
$logo->blit(0, $app, $lrect);
$app->update($lrect);

my $event = new SDL::Event->new();
$event->set_key_repeat(200, 10);

my $record_time;
my $gtime;

  # Next game ...
GAME: while(1) {

  my $obj = SDLMove->new(
    app      => $app,
    bg_color => $bg_color,
    x  => $WIDTH/2 - $diver->width()/2, 
    y  => $logo->height,
    image => $diver,  # Start with diver
  );

  my $v     = 0;
  my $vterm = $VTERM_FREE;
  my $start = $app->ticks();
  
  while(1) {   # Frame loop
    my $synchro_ticks = $app->ticks;
  
      # Accelerate
    $v += ($G - deceleration($v, $vterm))
          / $FRAMES_PSEC;
      # Move player downwards 
    $obj->move("s", $v/$FRAMES_PSEC);
    
    if($obj->hit_bottom()) {
      if($v <= $MAX_LAND) { # soft enough?
        if(! defined $record_time or 
           $gtime < $record_time) {
            $record_time = $gtime;
        }
        nput($app, 0, $lrect->height + 20, 
             $record_time);
      } else {
          $obj->wipe();
          $obj->image($diver);
          $obj->move("s", # indicate crash
           $para->height - $diver->height);
      }
      sleep 5;
      $obj->wipe();
      next GAME;
    }
      # Process all queued events
    while ($event->poll != 0) {
      my $type = $event->type();
      exit if $type == SDL::Event::SDL_QUIT();
   
      if($type == SDL::Event::SDL_KEYDOWN()) {
        my $keypressed = $event->key_name;
  
        if($keypressed eq "left") {
            $obj->move("w", 0.1);
        } elsif($keypressed eq "right") {
            $obj->move("e", 0.1);
        } elsif($keypressed eq "up") {
          # deploy parachute
          $vterm = $VTERM_PARA;
          $obj->image($para);
        } elsif($keypressed eq "r") {
          $obj->wipe();
          next GAME;
        } elsif($keypressed eq "q") {
          exit 0; # quit
        }
      }
    }
    $gtime = ($app->ticks - $start)/1000.0;

    nput($app, 0, $lrect->height, $gtime);
    nput($app, 110, $lrect->height, $v);
  
    my $wait = $SPEED_MS - 
           ($app->ticks - $synchro_ticks);
    select undef, undef, 
          undef, $wait/1000.0 if $wait > 0;
  }
}

###########################################
sub deceleration {
###########################################
    my($v, $vterm) = @_;

    my $d = $v/$vterm*9.81;

    $d = 0 if $d < 0;
    $d = 2*$G if $d > 2*$G;

    return $d;
}

###########################################
sub nput {
###########################################
  my($app, $x, $y, $number) = @_;

  my $rect = SDL::Rect->new(
    "-height" => $font->height,
    "-width"  => $font->width($number),
    "-x"      => $x,
    "-y"      => $y);

  $app->fill($rect, $bg_color);
  my $string = sprintf "%-5.2f", $number;
  $font->print($app, $x, $y, $string);
  $app->sync();
}

@KT:Listado 2: SDLMove.pm
@LI:package SDLMove;
use strict;
use warnings;
use SDL;
use SDL::App;

###########################################
sub new {
###########################################
  my($class, %options) = @_;

  my $self = { %options };
  bless $self, $class;

  $self->image($self->{image});
  return $self;
}

###########################################
sub image {
###########################################
  my($self, $image) = @_;
  
  $self->{image} = $image;
  $self->{drect} = SDL::Rect->new(
    -width  => $image->width, 
    -height => $image->height,
    -x      => $self->{x},
    -y      => $self->{y},
  );
}

###########################################
sub move {
###########################################
  my($self, $direction, $pixels) = @_;

  my $rect = $self->{drect};
  my $app  = $self->{app};

  if($direction eq "w") {      # left
   $self->{x} -= $pixels if $self->{x} > 0;

  } elsif($direction eq "e") { # right
    $self->{x} += $pixels if $self->{x} < 
        $app->width - $rect->width;

  } elsif($direction eq "n") { # up
   $self->{y} -= $pixels if $self->{y} > 0;

  } elsif($direction eq "s") { # down
    $self->{y} += $pixels if $self->{y} < 
        $app->height - $rect->height;
  }

  $self->{old_rect} = SDL::Rect->new(
    -height => $rect->height,
    -width  => $rect->width,
    -x      => $rect->x,
    -y      => $rect->y,
  );

  $rect->x( $self->{x} );
  $rect->y( $self->{y} );
  $app->fill($self->{old_rect}, 
             $self->{bg_color});
  
  $self->{image}->blit(0, $self->{app}, 
                       $rect);
  $app->update($self->{old_rect}, $rect);
}

###########################################
sub wipe {
###########################################
  my($self) = @_;

  $self->{app}->fill($self->{drect}, 
             $self->{bg_color});
  $self->{app}->update($self->{drect});
}

###########################################
sub hit_bottom {
###########################################
  my($self) = @_;

  return $self->{y} >
    $self->{app}->height - 
    $self->{drect}->height;
}

1;