#!/usr/bin/perl -w ########################################### # skydive -- Skydive simulation # Mike Schilli, 2007 (m@perlmeister.com) # Thanks to Tobias Gneist for Debian patches ########################################### 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(); }