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