5 # Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
7 # ------------------------------------------------------------------------------
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.
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.
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
23 # ------------------------------------------------------------------------------
25 # Please feel free to send questions, suggestions or improvements to:
34 use MIME::Base64 qw(decode_base64);
44 use vars qw/ $app $app_rect $background $event $sprite $sprite_rect $videoflags /;
46 die "Your system is not configured with SDL_gfx support!\n"
47 unless (SDL::Config->has('SDL_gfx'));
49 ## User tweakable settings (via cmd-line)
52 'screen_width' => 640,
53 'screen_height' => 480,
61 ## Process commandline arguments
65 GetOptions( "width:i" => \$settings{screen_width},
66 "height:i" => \$settings{screen_height},
67 "bpp:i" => \$settings{bpp},
68 "fast!" => \$settings{fast},
69 "hw!" => \$settings{hw},
70 "fullscreen!" => \$settings{fullscreen},
71 "numsprites=i" => \$settings{numsprites},
75 ## Initialize application options
79 $settings{bpp} ||= 8; # default to 8 bits per pix
81 $videoflags |= SDL_HWACCEL if $settings{hw};
82 $videoflags |= SDL_FULLSCREEN if $settings{fullscreen};
90 -width => $settings{screen_width},
91 -height=> $settings{screen_height},
92 -title => "testsprite",
93 -flags => $videoflags;
95 $app_rect= new SDL::Rect
96 -height => $settings{screen_height},
97 -width => $settings{screen_width};
99 $background = $SDL::Color::black;
101 $sprite = new SDL::Surface -name =>"/tmp/icon.bmp";
103 # Set transparent pixel as the pixel at (0,0)
104 $sprite->set_color_key(SDL_SRCCOLORKEY,$sprite->pixel(0,0));
106 print STDERR "Got past that\n";
108 $sprite->display_format();
110 $sprite_rect = new SDL::Rect
113 -width => $sprite->width,
114 -height=> $sprite->height;
116 $event = new SDL::Event();
119 ## Prints diagnostics
123 if ( ($app->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) {
124 printf("Screen is in video memory\n");
126 printf("Screen is in system memory\n");
129 if ( ($app->flags & SDL_DOUBLEBUF) == SDL_DOUBLEBUF ) {
130 printf("Screen has double-buffering enabled\n");
133 if ( ($sprite->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) {
134 printf("Sprite is in video memory\n");
136 printf("Sprite is in system memory\n");
139 # Run a sample blit to trigger blit (if posssible)
140 # acceleration before the check just after
141 $sprite->blit(0,$app,0);
143 if ( ($sprite->flags & SDL_HWACCEL) == SDL_HWACCEL ) {
144 printf("Sprite blit uses hardware acceleration\n");
146 if ( ($sprite->flags & SDL_RLEACCEL) == SDL_RLEACCEL ) {
147 printf("Sprite blit uses RLE acceleration\n");
155 my $surfWidth=$settings{screen_width};
156 my $surfHeight=$settings{screen_height};
157 my $surfMidWidth=$settings{screen_width}>>1;;
158 my $surfMidHeight=$settings{screen_height}>>1;
160 $app->fill($app_rect, $background);
162 # TODO: polygon's, GFX*Color
166 SDL::GFXHlineRGBA($surf,
171 SDL::GFXVlineRGBA($surf,
178 SDL::GFXRectangleRGBA($surf,
180 $surfMidWidth/2,$surfMidHeight/2,
183 SDL::GFXBoxRGBA($surf,
185 $surfMidWidth/3,$surfMidHeight/3,
188 SDL::GFXLineRGBA($surf,
190 $surfWidth,$surfHeight,
193 SDL::GFXAalineRGBA($surf, $surfWidth,0,0,$surfHeight,0,255,255,255);
197 SDL::GFXCircleRGBA( $surf,$surfMidWidth*.3, $surfMidHeight,
198 $surfMidWidth*.3, 255,255,0,255);
201 SDL::GFXAacircleRGBA($surf, $surfMidWidth*.6, $surfMidHeight,
202 $surfMidWidth*.3, 255,255,0,255);
205 SDL::GFXFilledCircleRGBA($surf,$surfMidWidth*.3, $surfMidHeight,
206 $surfMidWidth*.25,255,255,0,255);
211 SDL::GFXEllipseRGBA($surf,$surfWidth- $surfMidWidth*.3, $surfMidHeight,
212 $surfMidWidth*.3,$surfMidHeight*.15, 255,255,0,255);
214 SDL::GFXAaellipseRGBA($surf,$surfWidth- $surfMidWidth*.6, $surfMidHeight,
215 $surfMidWidth*.3,$surfMidHeight*.15,255,255,0,255);
217 SDL::GFXFilledEllipseRGBA($surf,$surfWidth- $surfMidWidth*.3, $surfMidHeight,
218 $surfMidWidth*.25,$surfMidHeight*.10,255,255,0,255);
221 SDL::GFXFilledPieRGBA($surf,$surfMidWidth,$surfMidHeight, $surfMidWidth*.1,
224 SDL::GFXFilledPieRGBA($surf,$surfMidWidth,$surfMidHeight, $surfMidWidth*.1,
225 180,270,0,0,255,255);
232 # characters & strings
234 SDL::GFXCharacterRGBA($surf,$surfMidWidth,0,
235 "!",255,255,255,255);
237 SDL::GFXStringRGBA($surf,$surfMidWidth,$surfHeight*.75,
238 "SDL_Perl Primitive Test.",255,255,255,255);
243 SDL_QUIT() => sub { exit(0); },
244 SDL_KEYDOWN() => sub { exit(0) if (SDL::GetKeyState(SDLK_ESCAPE)); },
258 my $bmp = decode_base64 <<EOF;
259 Qk1CAgAAAAAAAEIAAAAoAAAAIAAAACAAAAABAAQAAAAAAAACAABtCwAAbQsAAAMAAAADAAAA////
260 AAAAAAAA//8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
261 AAAAAAAAAAAAAAAAAAAAAAAAAAAAABEREREAAAAAAAAAAAAAABEiIiIiEQAAAAAAAAAAAAEiIRER
262 EiIQAAAAAAAAAAASIRERERESIQAAAAAAAAABIhERERERESIQAAAAAAAAEiERIiIiIhESIQAAAAAA
263 ABIiIiIiIiIiIiEAAAAAAAEiIiIiIiIiIiIiEAAAAAABIiIiIiESIiIiIhAAAAAAASIiIiIhEiIi
264 IiIQAAAAAAEiIiIiIiIiIiIiEAAAAAABIiIiIiIiIiIiIhAAAAAAASIiEREiIhERIiIQAAAAAAEi
265 IhEBIiIRASIiEAAAAAAAEiIRESIiEREiIQAAAAAAABIiIiIiIiIiIiEAAAAAAAABIiIiIiIiIiIQ
266 AAAAAAAAABIiIiIiIiIhAAAAAAAAAAABIiIiIiIiEAAAAAAAAAAAABEiIiIiEQAAAAAAAAAAAAAA
267 EREREQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
268 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
271 open FP, "> /tmp/icon.bmp";