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