test/testgfxprim.pl

   1 #!/usr/bin/env perl
   2 #
   3 # testgfxprim.pl
   4 #
   5 # This tests low level usage of the SDL_gfx extension.
   6 # Therefore, you should *not* rely on *any* part of this API.
   7 # It is subject to change, and will eventually
   8 # be encapsulated by something such as SDL::GraphicTool
   9 #
  10 # (plus, it's a bitch to use like this anyway)
  11 #
  12
  13 # Usage: testgfxprm.pl [-bpp N] [-hw] [-fast] [-fullscreen]
  14
  15 use strict;
  16 use Getopt::Long;
  17 use Data::Dumper;
  18
  19 use SDL;
  20 use SDL::App;
  21 use SDL::Event;
  22 use SDL::Surface;
  23 use SDL::Color;
  24 use SDL::Rect;
  25 use SDL::Config;
  26
  27 use vars qw/ $app $app_rect $background $event $sprite $sprite_rect $videoflags /;
  28
  29 die "Your system is not configured with SDL_gfx support!\n"
  30         unless (SDL::Config->has('SDL_gfx'));
  31
  32 ## User tweakable settings (via cmd-line)
  33 my %settings = (
  34         'numsprites'            => 10,
  35         'screen_width'  => 640,
  36         'screen_height' => 480,
  37         'video_bpp'              => 8,
  38         'fast'                                  => 0,
  39         'hw'                                            => 0,
  40         'fullscreen'            => 0,
  41         'bpp'                                    => undef,
  42 );
  43
  44 ## Process commandline arguments
  45
  46 sub get_cmd_args
  47 {
  48         GetOptions(     "width:i"       => \$settings{screen_width},
  49                          "height:i" => \$settings{screen_height},
  50                          "bpp:i"                => \$settings{bpp},
  51                          "fast!"         => \$settings{fast},
  52                          "hw!"           => \$settings{hw},
  53                          "fullscreen!" => \$settings{fullscreen},
  54                          "numsprites=i" => \$settings{numsprites},
  55                 );
  56 }
  57
  58 ## Initialize application options
  59
  60 sub set_app_args
  61 {
  62         $settings{bpp} ||= 8;           # default to 8 bits per pix
  63
  64         $videoflags |= SDL_HWACCEL               if $settings{hw};
  65         $videoflags |= SDL_FULLSCREEN   if $settings{fullscreen};
  66 }
  67
  68 ## Setup
  69
  70 sub init_game_context
  71 {
  72         $app = new SDL::App
  73                         -width => $settings{screen_width},
  74                         -height=> $settings{screen_height},
  75                         -title => "testsprite",
  76                         -icon   => "data/icon.bmp",
  77                         -flags => $videoflags;
  78
  79         $app_rect= new SDL::Rect
  80                                 -height => $settings{screen_height},
  81                                 -width  => $settings{screen_width};
  82
  83         $background = $SDL::Color::black;
  84
  85         $sprite = new SDL::Surface -name =>"data/icon.bmp";
  86
  87         # Set transparent pixel as the pixel at (0,0)
  88         $sprite->set_color_key(SDL_SRCCOLORKEY,$sprite->pixel(0,0));
  89
  90         print STDERR "Got past that\n";
  91
  92         $sprite->display_format();
  93
  94         $sprite_rect = new SDL::Rect
  95                                 -x => 0,
  96                                 -y => 0,
  97                                 -width => $sprite->width,
  98                                 -height=> $sprite->height;
  99
 100         $event = new SDL::Event();
 101 }
 102
 103 ## Prints diagnostics
 104
 105 sub instruments
 106 {
 107         if ( ($app->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) {
 108                 printf("Screen is in video memory\n");
 109         } else {
 110                 printf("Screen is in system memory\n");
 111         }
 112
 113         if ( ($app->flags & SDL_DOUBLEBUF) == SDL_DOUBLEBUF ) {
 114                 printf("Screen has double-buffering enabled\n");
 115         }
 116
 117         if ( ($sprite->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) {
 118                 printf("Sprite is in video memory\n");
 119         } else {
 120                 printf("Sprite is in system memory\n");
 121         }
 122
 123         # Run a sample blit to trigger blit (if posssible)
 124         # acceleration before the check just after
 125         $sprite->blit(0,$app,0);
 126
 127         if ( ($sprite->flags & SDL_HWACCEL) == SDL_HWACCEL ) {
 128                 printf("Sprite blit uses hardware acceleration\n");
 129         }
 130         if ( ($sprite->flags & SDL_RLEACCEL) == SDL_RLEACCEL ) {
 131                 printf("Sprite blit uses RLE acceleration\n");
 132         }
 133
 134 }
 135
 136 sub game_loop
 137 {
 138         my $surf = $$app;
 139         my $surfWidth=$settings{screen_width};
 140         my $surfHeight=$settings{screen_height};
 141         my $surfMidWidth=$settings{screen_width}>>1;;
 142         my $surfMidHeight=$settings{screen_height}>>1;
 143
 144         $app->fill($app_rect, $background);
 145
 146         # TODO: polygon's, GFX*Color
 147
 148         #lines
 149
 150         SDL::GFXHlineRGBA($surf,
 151                                  0,$surfWidth,
 152                                  $surfMidHeight,
 153                                  255,255,255,255);
 154
 155         SDL::GFXVlineRGBA($surf,
 156                                  $surfMidWidth,
 157                                  0,$surfHeight,
 158                                  255,255,255,255);
 159
 160         # rectangles
 161
 162         SDL::GFXRectangleRGBA($surf,
 163                          0,0,
 164                          $surfMidWidth/2,$surfMidHeight/2,
 165                          255,0,0,255);
 166
 167         SDL::GFXBoxRGBA($surf,
 168                          0,0,
 169                          $surfMidWidth/3,$surfMidHeight/3,
 170                          0,255,0,255);
 171
 172         SDL::GFXLineRGBA($surf,
 173                                 0,0,
 174                                 $surfWidth,$surfHeight,
 175                                 0,255,255,255);
 176
 177         SDL::GFXAalineRGBA($surf, $surfWidth,0,0,$surfHeight,0,255,255,255);
 178
 179         # circles
 180
 181         SDL::GFXCircleRGBA( $surf,$surfMidWidth*.3, $surfMidHeight,
 182                 $surfMidWidth*.3, 255,255,0,255);
 183
 184
 185         SDL::GFXAacircleRGBA($surf, $surfMidWidth*.6, $surfMidHeight,
 186                 $surfMidWidth*.3, 255,255,0,255);
 187
 188
 189         SDL::GFXFilledCircleRGBA($surf,$surfMidWidth*.3, $surfMidHeight,
 190                 $surfMidWidth*.25,255,255,0,255);
 191
 192
 193         # ellipses
 194
 195         SDL::GFXEllipseRGBA($surf,$surfWidth- $surfMidWidth*.3, $surfMidHeight,
 196                 $surfMidWidth*.3,$surfMidHeight*.15, 255,255,0,255);
 197
 198         SDL::GFXAaellipseRGBA($surf,$surfWidth- $surfMidWidth*.6, $surfMidHeight,
 199                 $surfMidWidth*.3,$surfMidHeight*.15,255,255,0,255);
 200
 201         SDL::GFXFilledEllipseRGBA($surf,$surfWidth- $surfMidWidth*.3, $surfMidHeight,
 202                 $surfMidWidth*.25,$surfMidHeight*.10,255,255,0,255);
 203
 204         # pie slices
 205         SDL::GFXFilledPieRGBA($surf,$surfMidWidth,$surfMidHeight, $surfMidWidth*.1,
 206                 0,90,0,0,255,255);
 207
 208         SDL::GFXFilledPieRGBA($surf,$surfMidWidth,$surfMidHeight, $surfMidWidth*.1,
 209                 180,270,0,0,255,255);
 210
 211         # polygons
 212
 213         # TBD...
 214
 215
 216         # characters & strings
 217
 218         SDL::GFXCharacterRGBA($surf,$surfMidWidth,0,
 219                 "!",255,255,255,255);
 220
 221         SDL::GFXStringRGBA($surf,$surfMidWidth,$surfHeight*.75,
 222                 "SDL_Perl Primitive Test.",255,255,255,255);
 223
 224         $app->flip();
 225
 226         $app->loop({
 227                 SDL_QUIT() => sub { exit(0); },
 228                 SDL_KEYDOWN() => sub { exit(0) if (SDL::GetKeyState(SDLK_ESCAPE)); },
 229         });
 230 }
 231
 232 ## Main program loop
 233
 234 get_cmd_args();
 235 set_app_args();
 236 init_game_context();
 237 instruments();
 238 game_loop();
 239