Commit | Line | Data |
8fde61e3 |
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 |
76272a9a |
205 | SDL::GFXFilledPieRGBA($surf,$surfMidWidth,$surfMidHeight, $surfMidWidth*.1, |
8fde61e3 |
206 | 0,90,0,0,255,255); |
207 | |
76272a9a |
208 | SDL::GFXFilledPieRGBA($surf,$surfMidWidth,$surfMidHeight, $surfMidWidth*.1, |
8fde61e3 |
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 | |