Commit | Line | Data |
bfd90409 |
1 | #!/usr/bin/env perl |
2 | # |
3 | # testgfxprim.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 Getopt::Long; |
33 | use Data::Dumper; |
34 | use MIME::Base64 qw(decode_base64); |
35 | |
36 | use SDL; |
37 | use SDL::App; |
38 | use SDL::Event; |
39 | use SDL::Surface; |
40 | use SDL::Color; |
41 | use SDL::Rect; |
42 | use SDL::Config; |
43 | |
44 | use vars qw/ $app $app_rect $background $event $sprite $sprite_rect $videoflags /; |
45 | |
46 | die "Your system is not configured with SDL_gfx support!\n" |
47 | unless (SDL::Config->has('SDL_gfx')); |
48 | |
49 | ## User tweakable settings (via cmd-line) |
50 | my %settings = ( |
51 | 'numsprites' => 10, |
52 | 'screen_width' => 640, |
53 | 'screen_height' => 480, |
54 | 'video_bpp' => 8, |
55 | 'fast' => 0, |
56 | 'hw' => 0, |
57 | 'fullscreen' => 0, |
58 | 'bpp' => undef, |
59 | ); |
60 | |
61 | ## Process commandline arguments |
62 | |
63 | sub get_cmd_args |
64 | { |
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}, |
72 | ); |
73 | } |
74 | |
75 | ## Initialize application options |
76 | |
77 | sub set_app_args |
78 | { |
79 | $settings{bpp} ||= 8; # default to 8 bits per pix |
80 | |
81 | $videoflags |= SDL_HWACCEL if $settings{hw}; |
82 | $videoflags |= SDL_FULLSCREEN if $settings{fullscreen}; |
83 | } |
84 | |
85 | ## Setup |
86 | |
87 | sub init_game_context |
88 | { |
89 | $app = new SDL::App |
90 | -width => $settings{screen_width}, |
91 | -height=> $settings{screen_height}, |
92 | -title => "testsprite", |
93 | -flags => $videoflags; |
94 | |
95 | $app_rect= new SDL::Rect |
96 | -height => $settings{screen_height}, |
97 | -width => $settings{screen_width}; |
98 | |
99 | $background = $SDL::Color::black; |
100 | |
101 | $sprite = new SDL::Surface -name =>"/tmp/icon.bmp"; |
102 | |
103 | # Set transparent pixel as the pixel at (0,0) |
104 | $sprite->set_color_key(SDL_SRCCOLORKEY,$sprite->pixel(0,0)); |
105 | |
106 | print STDERR "Got past that\n"; |
107 | |
108 | $sprite->display_format(); |
109 | |
110 | $sprite_rect = new SDL::Rect |
111 | -x => 0, |
112 | -y => 0, |
113 | -width => $sprite->width, |
114 | -height=> $sprite->height; |
115 | |
116 | $event = new SDL::Event(); |
117 | } |
118 | |
119 | ## Prints diagnostics |
120 | |
121 | sub instruments |
122 | { |
123 | if ( ($app->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) { |
124 | printf("Screen is in video memory\n"); |
125 | } else { |
126 | printf("Screen is in system memory\n"); |
127 | } |
128 | |
129 | if ( ($app->flags & SDL_DOUBLEBUF) == SDL_DOUBLEBUF ) { |
130 | printf("Screen has double-buffering enabled\n"); |
131 | } |
132 | |
133 | if ( ($sprite->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) { |
134 | printf("Sprite is in video memory\n"); |
135 | } else { |
136 | printf("Sprite is in system memory\n"); |
137 | } |
138 | |
139 | # Run a sample blit to trigger blit (if posssible) |
140 | # acceleration before the check just after |
141 | $sprite->blit(0,$app,0); |
142 | |
143 | if ( ($sprite->flags & SDL_HWACCEL) == SDL_HWACCEL ) { |
144 | printf("Sprite blit uses hardware acceleration\n"); |
145 | } |
146 | if ( ($sprite->flags & SDL_RLEACCEL) == SDL_RLEACCEL ) { |
147 | printf("Sprite blit uses RLE acceleration\n"); |
148 | } |
149 | |
150 | } |
151 | |
152 | sub game_loop |
153 | { |
154 | my $surf = $$app; |
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; |
159 | |
160 | $app->fill($app_rect, $background); |
161 | |
162 | # TODO: polygon's, GFX*Color |
163 | |
164 | #lines |
165 | |
166 | SDL::GFXHlineRGBA($surf, |
167 | 0,$surfWidth, |
168 | $surfMidHeight, |
169 | 255,255,255,255); |
170 | |
171 | SDL::GFXVlineRGBA($surf, |
172 | $surfMidWidth, |
173 | 0,$surfHeight, |
174 | 255,255,255,255); |
175 | |
176 | # rectangles |
177 | |
178 | SDL::GFXRectangleRGBA($surf, |
179 | 0,0, |
180 | $surfMidWidth/2,$surfMidHeight/2, |
181 | 255,0,0,255); |
182 | |
183 | SDL::GFXBoxRGBA($surf, |
184 | 0,0, |
185 | $surfMidWidth/3,$surfMidHeight/3, |
186 | 0,255,0,255); |
187 | |
188 | SDL::GFXLineRGBA($surf, |
189 | 0,0, |
190 | $surfWidth,$surfHeight, |
191 | 0,255,255,255); |
192 | |
193 | SDL::GFXAalineRGBA($surf, $surfWidth,0,0,$surfHeight,0,255,255,255); |
194 | |
195 | # circles |
196 | |
197 | SDL::GFXCircleRGBA( $surf,$surfMidWidth*.3, $surfMidHeight, |
198 | $surfMidWidth*.3, 255,255,0,255); |
199 | |
200 | |
201 | SDL::GFXAacircleRGBA($surf, $surfMidWidth*.6, $surfMidHeight, |
202 | $surfMidWidth*.3, 255,255,0,255); |
203 | |
204 | |
205 | SDL::GFXFilledCircleRGBA($surf,$surfMidWidth*.3, $surfMidHeight, |
206 | $surfMidWidth*.25,255,255,0,255); |
207 | |
208 | |
209 | # ellipses |
210 | |
211 | SDL::GFXEllipseRGBA($surf,$surfWidth- $surfMidWidth*.3, $surfMidHeight, |
212 | $surfMidWidth*.3,$surfMidHeight*.15, 255,255,0,255); |
213 | |
214 | SDL::GFXAaellipseRGBA($surf,$surfWidth- $surfMidWidth*.6, $surfMidHeight, |
215 | $surfMidWidth*.3,$surfMidHeight*.15,255,255,0,255); |
216 | |
217 | SDL::GFXFilledEllipseRGBA($surf,$surfWidth- $surfMidWidth*.3, $surfMidHeight, |
218 | $surfMidWidth*.25,$surfMidHeight*.10,255,255,0,255); |
219 | |
220 | # pie slices |
221 | SDL::GFXFilledPieRGBA($surf,$surfMidWidth,$surfMidHeight, $surfMidWidth*.1, |
222 | 0,90,0,0,255,255); |
223 | |
224 | SDL::GFXFilledPieRGBA($surf,$surfMidWidth,$surfMidHeight, $surfMidWidth*.1, |
225 | 180,270,0,0,255,255); |
226 | |
227 | # polygons |
228 | |
229 | # TBD... |
230 | |
231 | |
232 | # characters & strings |
233 | |
234 | SDL::GFXCharacterRGBA($surf,$surfMidWidth,0, |
235 | "!",255,255,255,255); |
236 | |
237 | SDL::GFXStringRGBA($surf,$surfMidWidth,$surfHeight*.75, |
238 | "SDL_Perl Primitive Test.",255,255,255,255); |
239 | |
240 | $app->flip(); |
241 | |
242 | $app->loop({ |
243 | SDL_QUIT() => sub { exit(0); }, |
244 | SDL_KEYDOWN() => sub { exit(0) if (SDL::GetKeyState(SDLK_ESCAPE)); }, |
245 | }); |
246 | } |
247 | |
248 | ## Main program loop |
249 | |
250 | write_bmp(); |
251 | get_cmd_args(); |
252 | set_app_args(); |
253 | init_game_context(); |
254 | instruments(); |
255 | game_loop(); |
256 | |
257 | sub write_bmp { |
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 |
269 | AAAAAAAAAAA= |
270 | EOF |
271 | open FP, "> /tmp/icon.bmp"; |
272 | print FP $bmp; |
273 | close FP; |
274 | } |
275 | |