7 # This tests low level usage of the SDL_gfx extension.
8 # Therefore, you should *not* rely on *any* part of this API.
9 # It is subject to change, and will eventually
10 # be encapsulated by something such as SDL::Surface.
12 # Usage: testsprite.pl [-bpp N] [-hw] [-flip] [-fast] [-fullscreen] [-numsprites=X]
26 use vars qw/ $app $app_rect $background $event $sprite $sprite_rect $videoflags /;
28 ## Test for SDL_gfx support
30 die "Your system was not configured with SDL_gfx support!\n"
31 unless SDL::Config->has('SDL_gfx');
34 ## User tweakable settings (via cmd-line)
37 'screen_width' => 800,
38 'screen_height' => 600,
47 ## Process commandline arguments
51 GetOptions("width:i" => \$settings{screen_width},
52 "height:i" => \$settings{screen_height},
53 "bpp:i" => \$settings{bpp},
54 "fast!" => \$settings{fast},
55 "hw!" => \$settings{hw},
56 "flip!" => \$settings{flip},
57 "fullscreen!" => \$settings{fullscreen},
58 "numsprites=i" => \$settings{numsprites},
62 ## Initialize application options
66 $settings{bpp} ||= 8; # default to 8 bits per pix
68 $videoflags |= SDL_HWACCEL if $settings{hw};
69 $videoflags |= SDL_DOUBLEBUF if $settings{flip};
70 $videoflags |= SDL_FULLSCREEN if $settings{fullscreen};
78 -width => $settings{screen_width},
79 -height=> $settings{screen_height},
80 -title => "testsprite",
81 -icon => "data/logo.png",
82 -flags => $videoflags,
85 $app_rect= new SDL::Rect(
86 -height => $settings{screen_height},
87 -width => $settings{screen_width},
90 $background = $SDL::Color::black;
92 $sprite = new SDL::Surface -name =>"data/logo.png";
94 $sprite->display_format();
96 $sprite_rect = new SDL::Rect(-x => 0,
98 -width => $sprite->width,
99 -height=> $sprite->height,
102 $event = new SDL::Event();
105 ## Prints diagnostics
109 if ( ($app->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) {
110 printf("Screen is in video memory\n");
112 printf("Screen is in system memory\n");
115 if ( ($app->flags & SDL_DOUBLEBUF) == SDL_DOUBLEBUF ) {
116 printf("Screen has double-buffering enabled\n");
119 if ( ($sprite->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) {
120 printf("Sprite is in video memory\n");
122 printf("Sprite is in system memory\n");
125 # Run a sample blit to trigger blit (if posssible)
126 # acceleration before the check just after
127 put_sprite_rotated($sprite,
128 $settings{screen_width}/2, $settings{screen_height}/2,
131 if ( ($sprite->flags & SDL_HWACCEL) == SDL_HWACCEL ) {
132 printf("Sprite blit uses hardware acceleration\n");
134 if ( ($sprite->flags & SDL_RLEACCEL) == SDL_RLEACCEL ) {
135 printf("Sprite blit uses RLE acceleration\n");
143 # this can get silly in terms of
144 # memory usage, and maybe key lookup.
145 # it would be better to 'tie' the hash
146 # to an object which can
147 # better manage memory usage.
149 my %rotate_cache =();
151 sub generate_sprite_rotated
153 my ($surface, $angle, $zoom, $smooth) = @_;
156 my $key = "$surface$angle$zoom$smooth";
158 if ( $rotate_cache{$key} )
160 return $rotate_cache{$key};
164 my $sur = SDL::GFXRotoZoom($surface, $angle, $zoom, $smooth);
166 $rotate_cache{$key}= SDL::DisplayFormat($sur);
168 return $rotate_cache{$key};
171 sub put_sprite_rotated
173 my ($surface, $x, $y, $angle, $zoom, $smooth) = @_;
175 my $roto = generate_sprite_rotated($$surface, $angle, $zoom, $smooth);
177 die "Failed to create rotozoom surface" unless $roto;
179 my ($w,$h) = (SDL::SurfaceW($roto),SDL::SurfaceH($roto));;
182 my $dest_rect = new SDL::Rect
188 SDL::SetColorKey($roto, SDL_SRCCOLORKEY, SDL::SurfacePixel($roto,$w/2,$h/2));
190 SDL::BlitSurface($roto, 0, $$app, $$dest_rect);
196 my $ox=$settings{screen_width}>>1;;
197 my $oy=$settings{screen_height}>>1;
199 my $angleDelta = 360/$sectors;;
209 # process event queue
213 my $etype=$event->type();
216 last FRAME if ($etype == SDL_QUIT() );
217 last FRAME if (SDL::GetKeyState(SDLK_ESCAPE));
220 # needed for HW surface locking
221 #$app->lock() if $app->lockp();
223 $app->flip if $settings{flip};
225 ################################################
228 $app->fill($app_rect, $background);
232 put_sprite_rotated($sprite,
233 $settings{screen_width}/2, $settings{screen_height}/2,
234 $angle, $zoom, $smooth);
237 print "Cache entries: " . scalar(keys %rotate_cache) . "\n";