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
10 # (plus, it's a bitch to use like this anyway)
13 # Usage: testgfxprm.pl [-bpp N] [-hw] [-fast] [-fullscreen]
27 use vars qw/ $app $app_rect $background $event $sprite $sprite_rect $videoflags /;
29 die "Your system is not configured with SDL_gfx support!\n"
30 unless (SDL::Config->has('SDL_gfx'));
32 ## User tweakable settings (via cmd-line)
35 'screen_width' => 640,
36 'screen_height' => 480,
44 ## Process commandline arguments
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},
58 ## Initialize application options
62 $settings{bpp} ||= 8; # default to 8 bits per pix
64 $videoflags |= SDL_HWACCEL if $settings{hw};
65 $videoflags |= SDL_FULLSCREEN if $settings{fullscreen};
73 -width => $settings{screen_width},
74 -height=> $settings{screen_height},
75 -title => "testsprite",
76 -icon => "data/icon.bmp",
77 -flags => $videoflags;
79 $app_rect= new SDL::Rect
80 -height => $settings{screen_height},
81 -width => $settings{screen_width};
83 $background = $SDL::Color::black;
85 $sprite = new SDL::Surface -name =>"data/icon.bmp";
87 # Set transparent pixel as the pixel at (0,0)
88 $sprite->set_color_key(SDL_SRCCOLORKEY,$sprite->pixel(0,0));
90 print STDERR "Got past that\n";
92 $sprite->display_format();
94 $sprite_rect = new SDL::Rect
97 -width => $sprite->width,
98 -height=> $sprite->height;
100 $event = new SDL::Event();
103 ## Prints diagnostics
107 if ( ($app->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) {
108 printf("Screen is in video memory\n");
110 printf("Screen is in system memory\n");
113 if ( ($app->flags & SDL_DOUBLEBUF) == SDL_DOUBLEBUF ) {
114 printf("Screen has double-buffering enabled\n");
117 if ( ($sprite->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) {
118 printf("Sprite is in video memory\n");
120 printf("Sprite is in system memory\n");
123 # Run a sample blit to trigger blit (if posssible)
124 # acceleration before the check just after
125 $sprite->blit(0,$app,0);
127 if ( ($sprite->flags & SDL_HWACCEL) == SDL_HWACCEL ) {
128 printf("Sprite blit uses hardware acceleration\n");
130 if ( ($sprite->flags & SDL_RLEACCEL) == SDL_RLEACCEL ) {
131 printf("Sprite blit uses RLE acceleration\n");
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;
144 $app->fill($app_rect, $background);
146 # TODO: polygon's, GFX*Color
150 SDL::GFXHlineRGBA($surf,
155 SDL::GFXVlineRGBA($surf,
162 SDL::GFXRectangleRGBA($surf,
164 $surfMidWidth/2,$surfMidHeight/2,
167 SDL::GFXBoxRGBA($surf,
169 $surfMidWidth/3,$surfMidHeight/3,
172 SDL::GFXLineRGBA($surf,
174 $surfWidth,$surfHeight,
177 SDL::GFXAalineRGBA($surf, $surfWidth,0,0,$surfHeight,0,255,255,255);
181 SDL::GFXCircleRGBA( $surf,$surfMidWidth*.3, $surfMidHeight,
182 $surfMidWidth*.3, 255,255,0,255);
185 SDL::GFXAacircleRGBA($surf, $surfMidWidth*.6, $surfMidHeight,
186 $surfMidWidth*.3, 255,255,0,255);
189 SDL::GFXFilledCircleRGBA($surf,$surfMidWidth*.3, $surfMidHeight,
190 $surfMidWidth*.25,255,255,0,255);
195 SDL::GFXEllipseRGBA($surf,$surfWidth- $surfMidWidth*.3, $surfMidHeight,
196 $surfMidWidth*.3,$surfMidHeight*.15, 255,255,0,255);
198 SDL::GFXAaellipseRGBA($surf,$surfWidth- $surfMidWidth*.6, $surfMidHeight,
199 $surfMidWidth*.3,$surfMidHeight*.15,255,255,0,255);
201 SDL::GFXFilledEllipseRGBA($surf,$surfWidth- $surfMidWidth*.3, $surfMidHeight,
202 $surfMidWidth*.25,$surfMidHeight*.10,255,255,0,255);
205 SDL::GFXFilledPieRGBA($surf,$surfMidWidth,$surfMidHeight, $surfMidWidth*.1,
208 SDL::GFXFilledPieRGBA($surf,$surfMidWidth,$surfMidHeight, $surfMidWidth*.1,
209 180,270,0,0,255,255);
216 # characters & strings
218 SDL::GFXCharacterRGBA($surf,$surfMidWidth,0,
219 "!",255,255,255,255);
221 SDL::GFXStringRGBA($surf,$surfMidWidth,$surfHeight*.75,
222 "SDL_Perl Primitive Test.",255,255,255,255);
227 SDL_QUIT() => sub { exit(0); },
228 SDL_KEYDOWN() => sub { exit(0) if (SDL::GetKeyState(SDLK_ESCAPE)); },