Commit | Line | Data |
8fde61e3 |
1 | #!/usr/bin/env perl |
2 | # |
3 | # testgfxroto.pl |
4 | # |
5 | # *** WARNING *** |
6 | # |
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. |
11 | # |
12 | # Usage: testsprite.pl [-bpp N] [-hw] [-flip] [-fast] [-fullscreen] [-numsprites=X] |
13 | |
14 | use strict; |
15 | use Getopt::Long; |
16 | use Data::Dumper; |
17 | |
18 | use SDL; |
19 | use SDL::App; |
20 | use SDL::Event; |
21 | use SDL::Surface; |
22 | use SDL::Color; |
23 | use SDL::Rect; |
24 | use SDL::Config; |
25 | |
26 | use vars qw/ $app $app_rect $background $event $sprite $sprite_rect $videoflags /; |
27 | |
28 | ## Test for SDL_gfx support |
29 | |
30 | die "Your system was not configured with SDL_gfx support!\n" |
31 | unless SDL::Config->has('SDL_gfx'); |
32 | |
33 | |
34 | ## User tweakable settings (via cmd-line) |
35 | my %settings = ( |
36 | 'numsprites' => 10, |
37 | 'screen_width' => 800, |
38 | 'screen_height' => 600, |
39 | 'video_bpp' => 8, |
40 | 'fast' => 0, |
41 | 'hw' => 0, |
42 | 'flip' => 1, |
43 | 'fullscreen' => 0, |
44 | 'bpp' => undef, |
45 | ); |
46 | |
47 | ## Process commandline arguments |
48 | |
49 | sub get_cmd_args |
50 | { |
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}, |
59 | ); |
60 | } |
61 | |
62 | ## Initialize application options |
63 | |
64 | sub set_app_args |
65 | { |
66 | $settings{bpp} ||= 8; # default to 8 bits per pix |
67 | |
68 | $videoflags |= SDL_HWACCEL if $settings{hw}; |
69 | $videoflags |= SDL_DOUBLEBUF if $settings{flip}; |
70 | $videoflags |= SDL_FULLSCREEN if $settings{fullscreen}; |
71 | } |
72 | |
73 | ## Setup |
74 | |
75 | sub init_game_context |
76 | { |
77 | $app = new SDL::App ( |
78 | -width => $settings{screen_width}, |
79 | -height=> $settings{screen_height}, |
80 | -title => "testsprite", |
81 | -icon => "data/logo.png", |
82 | -flags => $videoflags, |
83 | ); |
84 | |
85 | $app_rect= new SDL::Rect( |
86 | -height => $settings{screen_height}, |
87 | -width => $settings{screen_width}, |
88 | ); |
89 | |
90 | $background = $SDL::Color::black; |
91 | |
92 | $sprite = new SDL::Surface -name =>"data/logo.png"; |
93 | |
94 | $sprite->display_format(); |
95 | |
96 | $sprite_rect = new SDL::Rect(-x => 0, |
97 | -y => 0, |
98 | -width => $sprite->width, |
99 | -height=> $sprite->height, |
100 | ); |
101 | |
102 | $event = new SDL::Event(); |
103 | } |
104 | |
105 | ## Prints diagnostics |
106 | |
107 | sub instruments |
108 | { |
109 | if ( ($app->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) { |
110 | printf("Screen is in video memory\n"); |
111 | } else { |
112 | printf("Screen is in system memory\n"); |
113 | } |
114 | |
115 | if ( ($app->flags & SDL_DOUBLEBUF) == SDL_DOUBLEBUF ) { |
116 | printf("Screen has double-buffering enabled\n"); |
117 | } |
118 | |
119 | if ( ($sprite->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) { |
120 | printf("Sprite is in video memory\n"); |
121 | } else { |
122 | printf("Sprite is in system memory\n"); |
123 | } |
124 | |
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, |
129 | 0,0,0); |
130 | |
131 | if ( ($sprite->flags & SDL_HWACCEL) == SDL_HWACCEL ) { |
132 | printf("Sprite blit uses hardware acceleration\n"); |
133 | } |
134 | if ( ($sprite->flags & SDL_RLEACCEL) == SDL_RLEACCEL ) { |
135 | printf("Sprite blit uses RLE acceleration\n"); |
136 | } |
137 | |
138 | } |
139 | |
140 | |
141 | |
142 | |
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. |
148 | |
149 | my %rotate_cache =(); |
150 | |
151 | sub generate_sprite_rotated |
152 | { |
153 | my ($surface, $angle, $zoom, $smooth) = @_; |
154 | |
155 | $angle %= 360; |
156 | my $key = "$surface$angle$zoom$smooth"; |
157 | |
158 | if ( $rotate_cache{$key} ) |
159 | { |
160 | return $rotate_cache{$key}; |
161 | } |
162 | else |
163 | { |
164 | my $sur = SDL::GFXRotoZoom($surface, $angle, $zoom, $smooth); |
165 | |
166 | $rotate_cache{$key}= SDL::DisplayFormat($sur); |
167 | } |
168 | return $rotate_cache{$key}; |
169 | } |
170 | |
171 | sub put_sprite_rotated |
172 | { |
173 | my ($surface, $x, $y, $angle, $zoom, $smooth) = @_; |
174 | |
175 | my $roto = generate_sprite_rotated($$surface, $angle, $zoom, $smooth); |
176 | |
177 | die "Failed to create rotozoom surface" unless $roto; |
178 | |
179 | my ($w,$h) = (SDL::SurfaceW($roto),SDL::SurfaceH($roto));; |
180 | |
181 | |
182 | my $dest_rect = new SDL::Rect |
183 | -x => $x - ($w/2), |
184 | -y => $y - ($h/2), |
185 | -width => $w, |
186 | -height => $h; |
187 | |
188 | SDL::SetColorKey($roto, SDL_SRCCOLORKEY, SDL::SurfacePixel($roto,$w/2,$h/2)); |
189 | |
190 | SDL::BlitSurface($roto, 0, $$app, $$dest_rect); |
191 | } |
192 | |
193 | |
194 | sub game_loop |
195 | { |
196 | my $ox=$settings{screen_width}>>1;; |
197 | my $oy=$settings{screen_height}>>1; |
198 | my $sectors = 12; |
199 | my $angleDelta = 360/$sectors;; |
200 | my $zoom = 1; |
201 | my $smooth =1; |
202 | |
203 | my $angle =0; |
204 | my $radius =128; |
205 | |
206 | FRAME: |
207 | while (1) |
208 | { |
209 | # process event queue |
210 | $event->pump; |
211 | if ($event->poll) |
212 | { |
213 | my $etype=$event->type(); |
214 | |
215 | # handle quit events |
216 | last FRAME if ($etype == SDL_QUIT() ); |
217 | last FRAME if (SDL::GetKeyState(SDLK_ESCAPE)); |
218 | } |
219 | |
220 | # needed for HW surface locking |
221 | #$app->lock() if $app->lockp(); |
222 | #$app->unlock(); |
223 | $app->flip if $settings{flip}; |
224 | |
225 | ################################################ |
226 | # do some drawing |
227 | |
228 | $app->fill($app_rect, $background); |
229 | |
230 | $angle += 16; |
231 | |
232 | put_sprite_rotated($sprite, |
233 | $settings{screen_width}/2, $settings{screen_height}/2, |
234 | $angle, $zoom, $smooth); |
235 | |
236 | } |
237 | print "Cache entries: " . scalar(keys %rotate_cache) . "\n"; |
238 | } |
239 | |
240 | |
241 | |
242 | ## Main program loop |
243 | |
244 | get_cmd_args(); |
245 | set_app_args(); |
246 | init_game_context(); |
247 | instruments(); |
248 | game_loop(); |
249 | exit(0); |
250 | |