test/testsprite.pl

   1 #!/usr/bin/env perl
   2 #
   3 # testspite.pl
   4 #
   5 # adapted from SDL-1.2.x/test/testsprite.c
   6
   7 # Usage: testsprite.pl [-bpp N] [-hw] [-flip] [-fast] [-fullscreen] [numsprites]
   8
   9 use strict;
  10 use Getopt::Long;
  11 use Data::Dumper;
  12
  13 use SDL;
  14 use SDL::App;
  15 use SDL::Event;
  16 use SDL::Surface;
  17 use SDL::Color;
  18 use SDL::Rect;
  19
  20 use vars qw/ $app $app_rect $background $event $sprite $sprite_rect $videoflags /;
  21
  22 ## User tweakable settings (via cmd-line)
  23 my %settings = (
  24         'numsprites'    => 75,
  25         'screen_width'  => 640,
  26         'screen_height' => 480,
  27         'video_bpp'     => 8,
  28         'fast'          => 0,
  29         'hw'            => 0,
  30         'flip'          => 1,
  31         'fullscreen'    => 0,
  32         'bpp'           => undef,
  33 );
  34
  35 ## Process commandline arguments
  36
  37 sub get_cmd_args
  38 {
  39   GetOptions("width:i"  => \$settings{screen_width},
  40              "height:i" => \$settings{screen_height},
  41              "bpp:i"    => \$settings{bpp},
  42              "fast!"   => \$settings{fast},
  43              "hw!"     => \$settings{hw},
  44              "flip!"    => \$settings{flip},
  45              "fullscreen!" => \$settings{fullscreen},
  46              "numsprites=i" => \$settings{numsprites},
  47             );
  48 }
  49
  50 ## Initialize application options
  51
  52 sub set_app_args
  53 {
  54   $settings{bpp} ||= 8;         # default to 8 bits per pix
  55
  56   $videoflags |= SDL_HWACCEL     if $settings{hw};
  57   $videoflags |= SDL_DOUBLEBUF   if $settings{flip};
  58   $videoflags |= SDL_FULLSCREEN  if $settings{fullscreen};
  59 }
  60
  61 ## Setup
  62
  63 sub  init_game_context
  64 {
  65   $app = new SDL::App (
  66                        -width => $settings{screen_width},
  67                        -height=> $settings{screen_height},
  68                        -title => "testsprite",
  69                        -icon  => "data/icon.bmp",
  70                        -flags => $videoflags,
  71                         );
  72
  73   $app_rect= new SDL::Rect(
  74                            -height => $settings{screen_height},
  75                            -width  => $settings{screen_width},
  76                           );
  77
  78   $background = $SDL::Color::black;
  79
  80   $sprite = new SDL::Surface(-name =>"data/icon.bmp");
  81
  82   # Set transparent pixel as the pixel at (0,0)
  83
  84   $sprite->display_format();
  85
  86   $sprite->set_color_key(SDL_SRCCOLORKEY,$sprite->pixel(0,0));  # sets the transparent color to that at (0,0)
  87
  88
  89   $sprite_rect = new SDL::Rect(-x     => 0,
  90                                -y     => 0,
  91                                -width => $sprite->width,
  92                                -height=> $sprite->height,
  93                               );
  94
  95   $event = new SDL::Event();
  96 }
  97
  98 ## Prints diagnostics
  99
 100 sub instruments
 101 {
 102   if ( ($app->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) {
 103     printf("Screen is in video memory\n");
 104   } else {
 105     printf("Screen is in system memory\n");
 106   }
 107
 108   if ( ($app->flags & SDL_DOUBLEBUF) == SDL_DOUBLEBUF ) {
 109     printf("Screen has double-buffering enabled\n");
 110   }
 111
 112   if ( ($sprite->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) {
 113     printf("Sprite is in video memory\n");
 114   } else {
 115     printf("Sprite is in system memory\n");
 116   }
 117
 118   # Run a sample blit to trigger blit (if posssible)
 119   # acceleration before the check just after
 120   put_sprite(0,0);
 121
 122   if ( ($sprite->flags & SDL_HWACCEL) == SDL_HWACCEL ) {
 123     printf("Sprite blit uses hardware acceleration\n");
 124   }
 125   if ( ($sprite->flags & SDL_RLEACCEL) == SDL_RLEACCEL ) {
 126     printf("Sprite blit uses RLE acceleration\n");
 127   }
 128
 129 }
 130
 131
 132
 133
 134 sub put_sprite
 135 {
 136   my ($x,$y) = @_;
 137
 138   my $dest_rect = new SDL::Rect(-x => $x,
 139                                -y => $y,
 140                                -width  => $sprite->width,
 141                                -height => $sprite->height,
 142                               );
 143   $sprite->blit($sprite_rect, $app, $dest_rect);
 144 }
 145
 146
 147
 148 sub game_loop
 149 {
 150   my $x=0;
 151   my $y=$settings{screen_height}>>1;
 152   my $i=0;
 153
 154   while (1)
 155   {
 156     # process event queue
 157     $event->pump;
 158     $event->poll;
 159     my $etype=$event->type;
 160
 161     # handle user events
 162     last if ($etype eq SDL_QUIT );
 163     last if (SDL::GetKeyState(SDLK_ESCAPE));
 164
 165     #$app->lock() if $app->lockp();
 166
 167     # page flip
 168
 169     # __draw gfx
 170
 171     $app->fill($app_rect, $background);
 172
 173     foreach (1..$settings{numsprites})
 174     {
 175       put_sprite( $_*8, $y + (sin(($i+$_)*0.2)*($settings{screen_height}/3)));
 176     }
 177     $i+=30;
 178
 179     # __graw gfx end
 180     #$app->unlock();
 181     $app->flip if $settings{flip};
 182   }
 183 }
 184
 185 ## Main program loop
 186
 187 get_cmd_args();
 188 set_app_args();
 189 init_game_context();
 190 instruments();
 191 game_loop();
 192 exit(0);
 193