Commit | Line | Data |
8fde61e3 |
1 | #!/usr/bin/env perl |
2 | # |
3 | # testspite.pl |
4 | # |
5 | # adapted from SDL-1.2.x/test/testsprite.c |
6 | |
7 | # Usage: testsprite.pl [-bpp N] [-hw] [-flip] [-fast] [-fullscreen] [numsprites] |
8 | |
9 | use strict; |
10 | use Getopt::Long; |
11 | use Data::Dumper; |
12 | |
13 | use SDL; |
14 | use SDL::App; |
15 | use SDL::Event; |
16 | use SDL::Surface; |
17 | use SDL::Color; |
18 | use SDL::Rect; |
19 | |
20 | use vars qw/ $app $app_rect $background $event $sprite $sprite_rect $videoflags /; |
21 | |
22 | ## User tweakable settings (via cmd-line) |
23 | my %settings = ( |
24 | 'numsprites' => 75, |
25 | 'screen_width' => 640, |
26 | 'screen_height' => 480, |
27 | 'video_bpp' => 8, |
28 | 'fast' => 0, |
29 | 'hw' => 0, |
30 | 'flip' => 1, |
31 | 'fullscreen' => 0, |
32 | 'bpp' => undef, |
33 | ); |
34 | |
35 | ## Process commandline arguments |
36 | |
37 | sub get_cmd_args |
38 | { |
39 | GetOptions("width:i" => \$settings{screen_width}, |
40 | "height:i" => \$settings{screen_height}, |
41 | "bpp:i" => \$settings{bpp}, |
42 | "fast!" => \$settings{fast}, |
43 | "hw!" => \$settings{hw}, |
44 | "flip!" => \$settings{flip}, |
45 | "fullscreen!" => \$settings{fullscreen}, |
46 | "numsprites=i" => \$settings{numsprites}, |
47 | ); |
48 | } |
49 | |
50 | ## Initialize application options |
51 | |
52 | sub set_app_args |
53 | { |
54 | $settings{bpp} ||= 8; # default to 8 bits per pix |
55 | |
56 | $videoflags |= SDL_HWACCEL if $settings{hw}; |
57 | $videoflags |= SDL_DOUBLEBUF if $settings{flip}; |
58 | $videoflags |= SDL_FULLSCREEN if $settings{fullscreen}; |
59 | } |
60 | |
61 | ## Setup |
62 | |
63 | sub init_game_context |
64 | { |
65 | $app = new SDL::App ( |
66 | -width => $settings{screen_width}, |
67 | -height=> $settings{screen_height}, |
68 | -title => "testsprite", |
69 | -icon => "data/icon.bmp", |
70 | -flags => $videoflags, |
71 | ); |
72 | |
73 | $app_rect= new SDL::Rect( |
74 | -height => $settings{screen_height}, |
75 | -width => $settings{screen_width}, |
76 | ); |
77 | |
78 | $background = $SDL::Color::black; |
79 | |
80 | $sprite = new SDL::Surface(-name =>"data/icon.bmp"); |
81 | |
82 | # Set transparent pixel as the pixel at (0,0) |
83 | |
84 | $sprite->display_format(); |
85 | |
86 | $sprite->set_color_key(SDL_SRCCOLORKEY,$sprite->pixel(0,0)); # sets the transparent color to that at (0,0) |
87 | |
88 | |
89 | $sprite_rect = new SDL::Rect(-x => 0, |
90 | -y => 0, |
91 | -width => $sprite->width, |
92 | -height=> $sprite->height, |
93 | ); |
94 | |
95 | $event = new SDL::Event(); |
96 | } |
97 | |
98 | ## Prints diagnostics |
99 | |
100 | sub instruments |
101 | { |
102 | if ( ($app->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) { |
103 | printf("Screen is in video memory\n"); |
104 | } else { |
105 | printf("Screen is in system memory\n"); |
106 | } |
107 | |
108 | if ( ($app->flags & SDL_DOUBLEBUF) == SDL_DOUBLEBUF ) { |
109 | printf("Screen has double-buffering enabled\n"); |
110 | } |
111 | |
112 | if ( ($sprite->flags & SDL_HWSURFACE) == SDL_HWSURFACE ) { |
113 | printf("Sprite is in video memory\n"); |
114 | } else { |
115 | printf("Sprite is in system memory\n"); |
116 | } |
117 | |
118 | # Run a sample blit to trigger blit (if posssible) |
119 | # acceleration before the check just after |
120 | put_sprite(0,0); |
121 | |
122 | if ( ($sprite->flags & SDL_HWACCEL) == SDL_HWACCEL ) { |
123 | printf("Sprite blit uses hardware acceleration\n"); |
124 | } |
125 | if ( ($sprite->flags & SDL_RLEACCEL) == SDL_RLEACCEL ) { |
126 | printf("Sprite blit uses RLE acceleration\n"); |
127 | } |
128 | |
129 | } |
130 | |
131 | |
132 | |
133 | |
134 | sub put_sprite |
135 | { |
136 | my ($x,$y) = @_; |
137 | |
138 | my $dest_rect = new SDL::Rect(-x => $x, |
139 | -y => $y, |
140 | -width => $sprite->width, |
141 | -height => $sprite->height, |
142 | ); |
143 | $sprite->blit($sprite_rect, $app, $dest_rect); |
144 | } |
145 | |
146 | |
147 | |
148 | sub game_loop |
149 | { |
150 | my $x=0; |
151 | my $y=$settings{screen_height}>>1; |
152 | my $i=0; |
153 | |
154 | while (1) |
155 | { |
156 | # process event queue |
157 | $event->pump; |
158 | $event->poll; |
159 | my $etype=$event->type; |
160 | |
161 | # handle user events |
162 | last if ($etype eq SDL_QUIT ); |
163 | last if (SDL::GetKeyState(SDLK_ESCAPE)); |
164 | |
165 | #$app->lock() if $app->lockp(); |
166 | |
167 | # page flip |
168 | |
169 | # __draw gfx |
170 | |
171 | $app->fill($app_rect, $background); |
172 | |
173 | foreach (1..$settings{numsprites}) |
174 | { |
175 | put_sprite( $_*8, $y + (sin(($i+$_)*0.2)*($settings{screen_height}/3))); |
176 | } |
177 | $i+=30; |
178 | |
179 | # __graw gfx end |
180 | #$app->unlock(); |
181 | $app->flip if $settings{flip}; |
182 | } |
183 | } |
184 | |
185 | ## Main program loop |
186 | |
187 | get_cmd_args(); |
188 | set_app_args(); |
189 | init_game_context(); |
190 | instruments(); |
191 | game_loop(); |
192 | exit(0); |
193 | |