test/testsprite.sdlpl

   1 #!/usr/bin/env perl
   2 #
   3 # testsprite.pl
   4 #
   5 # Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
   6 #
   7 # ------------------------------------------------------------------------------
   8 #
   9 # This library is free software; you can redistribute it and/or
  10 # modify it under the terms of the GNU Lesser General Public
  11 # License as published by the Free Software Foundation; either
  12 # version 2.1 of the License, or (at your option) any later version.
  13 #
  14 # This library is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 # Lesser General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU Lesser General Public
  20 # License along with this library; if not, write to the Free Software
  21 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  22 #
  23 # ------------------------------------------------------------------------------
  24 #
  25 # Please feel free to send questions, suggestions or improvements to:
  26 #
  27 #       David J. Goehrig
  28 #       dgoehrig@cpan.org
  29 #
  30
  31 use strict;
  32 use Data::Dumper;
  33 use MIME::Base64 qw(decode_base64);
  34
  35 use SDL;
  36 use SDL::App;
  37 use SDL::Event;
  38 use SDL::Surface;
  39 use SDL::Color;
  40 use SDL::Rect;
  41
  42 use vars qw/ $app $app_rect $background $event $sprite $sprite_rect $videoflags /;
  43
  44 ## User tweakable settings (via cmd-line)
  45 my %settings = (
  46         'numsprites'    => 75,
  47         'screen_width'  => 640,
  48         'screen_height' => 480,
  49         'video_bpp'     => 8,
  50         'fast'          => 0,
  51         'hw'            => 0,
  52         'flip'          => 1,
  53         'fullscreen'    => 0,
  54         'bpp'           => undef,
  55 );
  56
  57 ## Initialize application options
  58
  59 sub set_app_args
  60 {
  61   $settings{bpp} ||= 8;         # default to 8 bits per pix
  62   $videoflags |= SDL_HWACCEL     if $settings{hw};
  63   $videoflags |= SDL_DOUBLEBUF   if $settings{flip};
  64   $videoflags |= SDL_FULLSCREEN  if $settings{fullscreen};
  65 }
  66
  67 ## Setup
  68
  69 our $bmp;
  70
  71 sub  init_game_context
  72 {
  73   write_bmp();
  74   $app = new SDL::App (
  75                        -width => $settings{screen_width},
  76                        -height=> $settings{screen_height},
  77                        -title => "testsprite",
  78                        -icon  => "/tmp/icon.bmp",
  79                        -flags => $videoflags,
  80                         );
  81
  82   $app_rect= new SDL::Rect(
  83                            -height => $settings{screen_height},
  84                            -width  => $settings{screen_width},
  85                           );
  86
  87   $background = $SDL::Color::black;
  88
  89   $sprite = new SDL::Surface(-name => '/tmp/icon.bmp');
  90
  91   # Set transparent pixel as the pixel at (0,0)
  92
  93   $sprite->display_format();
  94
  95   $sprite->set_color_key(SDL_SRCCOLORKEY,$sprite->pixel(0,0));  # sets the transparent color to that at (0,0)
  96
  97
  98   $sprite_rect = new SDL::Rect(-x     => 0,
  99                                -y     => 0,
 100                                -width => $sprite->width,
 101                                -height=> $sprite->height,
 102                               );
 103
 104   $event = new SDL::Event();
 105 }
 106
 107 ## Prints diagnostics
 108
 109 sub instruments
 110 {
 111   if ( ($app->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) {
 112     printf("Screen is in video memory\n");
 113   } else {
 114     printf("Screen is in system memory\n");
 115   }
 116
 117   if ( ($app->flags & SDL_DOUBLEBUF) == SDL_DOUBLEBUF ) {
 118     printf("Screen has double-buffering enabled\n");
 119   }
 120
 121   if ( ($sprite->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) {
 122     printf("Sprite is in video memory\n");
 123   } else {
 124     printf("Sprite is in system memory\n");
 125   }
 126
 127   # Run a sample blit to trigger blit (if posssible)
 128   # acceleration before the check just after
 129   put_sprite(0,0);
 130
 131   if ( ($sprite->flags & SDL_HWACCEL) == SDL_HWACCEL ) {
 132     printf("Sprite blit uses hardware acceleration\n");
 133   }
 134   if ( ($sprite->flags & SDL_RLEACCEL) == SDL_RLEACCEL ) {
 135     printf("Sprite blit uses RLE acceleration\n");
 136   }
 137
 138 }
 139
 140
 141
 142
 143 sub put_sprite
 144 {
 145   my ($x,$y) = @_;
 146
 147   my $dest_rect = new SDL::Rect(-x => $x,
 148                                -y => $y,
 149                                -width  => $sprite->width,
 150                                -height => $sprite->height,
 151                               );
 152   $sprite->blit($sprite_rect, $app, $dest_rect);
 153 }
 154
 155
 156
 157 sub game_loop
 158 {
 159   my $x=0;
 160   my $y=$settings{screen_height}>>1;
 161   my $i=0;
 162
 163   while (1)
 164   {
 165     # process event queue
 166     $event->pump;
 167     $event->poll;
 168     my $etype=$event->type;
 169
 170     # handle user events
 171     last if ($etype eq SDL_QUIT );
 172     last if (SDL::GetKeyState(SDLK_ESCAPE));
 173
 174     #$app->lock() if $app->lockp();
 175
 176     # page flip
 177
 178     # __draw gfx
 179
 180     $app->fill($app_rect, $background);
 181
 182     foreach (1..$settings{numsprites})
 183     {
 184       put_sprite( $_*8, $y + (sin(($i+$_)*0.2)*($settings{screen_height}/3)));
 185     }
 186     $i+=30;
 187
 188     # __graw gfx end
 189     #$app->unlock();
 190     $app->flip if $settings{flip};
 191   }
 192 }
 193
 194 ## Main program loop
 195
 196 set_app_args();
 197 init_game_context();
 198 instruments();
 199 game_loop();
 200 system 'rm /tmp/icon.bmp';
 201 exit(0);
 202
 203
 204 sub write_bmp {
 205         $bmp = decode_base64 <<EOF;
 206 Qk1CAgAAAAAAAEIAAAAoAAAAIAAAACAAAAABAAQAAAAAAAACAABtCwAAbQsAAAMAAAADAAAA////
 207 AAAAAAAA//8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
 208 AAAAAAAAAAAAAAAAAAAAAAAAAAAAABEREREAAAAAAAAAAAAAABEiIiIiEQAAAAAAAAAAAAEiIRER
 209 EiIQAAAAAAAAAAASIRERERESIQAAAAAAAAABIhERERERESIQAAAAAAAAEiERIiIiIhESIQAAAAAA
 210 ABIiIiIiIiIiIiEAAAAAAAEiIiIiIiIiIiIiEAAAAAABIiIiIiESIiIiIhAAAAAAASIiIiIhEiIi
 211 IiIQAAAAAAEiIiIiIiIiIiIiEAAAAAABIiIiIiIiIiIiIhAAAAAAASIiEREiIhERIiIQAAAAAAEi
 212 IhEBIiIRASIiEAAAAAAAEiIRESIiEREiIQAAAAAAABIiIiIiIiIiIiEAAAAAAAABIiIiIiIiIiIQ
 213 AAAAAAAAABIiIiIiIiIhAAAAAAAAAAABIiIiIiIiEAAAAAAAAAAAABEiIiIiEQAAAAAAAAAAAAAA
 214 EREREQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
 215 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
 216 AAAAAAAAAAA=
 217 EOF
 218         open FP, "> /tmp/icon.bmp";
 219         print FP $bmp;
 220         close FP;
 221 }
 222