/t_backcompat/testsprite.pl

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