Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

274 lines (214 sloc) 5.636 kB
#!/usr/bin/env perl
#
# testgfxprim.pl
#
# This tests low level usage of the SDL_gfx extension.
# Therefore, you should *not* rely on *any* part of this API.
# It is subject to change, and will eventually
# be encapsulated by something such as SDL::GraphicTool
#
# (plus, it's a bitch to use like this anyway)
#
# Usage: testgfxprm.pl [-bpp N] [-hw] [-fast] [-fullscreen]
use strict;
use Getopt::Long;
use Data::Dumper;
use SDL;
use SDLx::App;
use SDL::Event;
use SDL::Surface;
use SDL::Color;
use SDL::Rect;
use SDL::Config;
use vars qw/ $app $app_rect $background $event $sprite $sprite_rect $videoflags /;
die "Your system is not configured with SDL_gfx support!\n"
unless ( SDL::Config->has('SDL_gfx') );
## User tweakable settings (via cmd-line)
my %settings = (
'numsprites' => 10,
'screen_width' => 640,
'screen_height' => 480,
'video_bpp' => 8,
'fast' => 0,
'hw' => 0,
'fullscreen' => 0,
'bpp' => undef,
);
## Process commandline arguments
sub get_cmd_args {
GetOptions(
"width:i" => \$settings{screen_width},
"height:i" => \$settings{screen_height},
"bpp:i" => \$settings{bpp},
"fast!" => \$settings{fast},
"hw!" => \$settings{hw},
"fullscreen!" => \$settings{fullscreen},
"numsprites=i" => \$settings{numsprites},
);
}
## Initialize application options
sub set_app_args {
$settings{bpp} ||= 8; # default to 8 bits per pix
$videoflags |= SDL_HWACCEL if $settings{hw};
$videoflags |= SDL_FULLSCREEN if $settings{fullscreen};
}
## Setup
sub init_game_context {
$app = SDLx::App->new(
-width => $settings{screen_width},
-height => $settings{screen_height},
-title => "testsprite",
-icon => "data/icon.bmp",
-flags => $videoflags
);
$app_rect = SDL::Rect->new(
-height => $settings{screen_height},
-width => $settings{screen_width}
);
$background = $SDL::Color::black;
$sprite = SDL::Surface->new( -name => "data/icon.bmp" );
# Set transparent pixel as the pixel at (0,0)
$sprite->set_color_key( SDL_SRCCOLORKEY, $sprite->pixel( 0, 0 ) );
print STDERR "Got past that\n";
$sprite->display_format();
$sprite_rect = SDL::Rect->new(
-x => 0,
-y => 0,
-width => $sprite->width,
-height => $sprite->height
);
$event = SDL::Event->new();
}
## Prints diagnostics
sub instruments {
if ( ( $app->flags & SDL_HWSURFACE ) == SDL_HWSURFACE ) {
printf("Screen is in video memory\n");
} else {
printf("Screen is in system memory\n");
}
if ( ( $app->flags & SDL_DOUBLEBUF ) == SDL_DOUBLEBUF ) {
printf("Screen has double-buffering enabled\n");
}
if ( ( $sprite->flags & SDL_HWSURFACE ) == SDL_HWSURFACE ) {
printf("Sprite is in video memory\n");
} else {
printf("Sprite is in system memory\n");
}
# Run a sample blit to trigger blit (if posssible)
# acceleration before the check just after
$sprite->blit( 0, $app, 0 );
if ( ( $sprite->flags & SDL_HWACCEL ) == SDL_HWACCEL ) {
printf("Sprite blit uses hardware acceleration\n");
}
if ( ( $sprite->flags & SDL_RLEACCEL ) == SDL_RLEACCEL ) {
printf("Sprite blit uses RLE acceleration\n");
}
}
sub game_loop {
my $surf = $$app;
my $surfWidth = $settings{screen_width};
my $surfHeight = $settings{screen_height};
my $surfMidWidth = $settings{screen_width} >> 1;
my $surfMidHeight = $settings{screen_height} >> 1;
$app->fill( $app_rect, $background );
# TODO: polygon's, GFX*Color
#lines
SDL::GFXHlineRGBA(
$surf, 0, $surfWidth, $surfMidHeight, 255, 255, 255,
255
);
SDL::GFXVlineRGBA(
$surf, $surfMidWidth, 0, $surfHeight, 255, 255, 255,
255
);
# rectangles
SDL::GFXRectangleRGBA(
$surf, 0, 0,
$surfMidWidth / 2,
$surfMidHeight / 2,
255, 0, 0, 255
);
SDL::GFXBoxRGBA(
$surf, 0, 0,
$surfMidWidth / 3,
$surfMidHeight / 3,
0, 255, 0, 255
);
SDL::GFXLineRGBA( $surf, 0, 0, $surfWidth, $surfHeight, 0, 255, 255, 255 );
SDL::GFXAalineRGBA(
$surf, $surfWidth, 0, 0, $surfHeight, 0, 255, 255,
255
);
# circles
SDL::GFXCircleRGBA(
$surf, $surfMidWidth * .3,
$surfMidHeight, $surfMidWidth * .3,
255, 255, 0, 255
);
SDL::GFXAacircleRGBA(
$surf, $surfMidWidth * .6,
$surfMidHeight, $surfMidWidth * .3,
255, 255, 0, 255
);
SDL::GFXFilledCircleRGBA(
$surf, $surfMidWidth * .3,
$surfMidHeight, $surfMidWidth * .25,
255, 255, 0, 255
);
# ellipses
SDL::GFXEllipseRGBA(
$surf, $surfWidth - $surfMidWidth * .3,
$surfMidHeight,
$surfMidWidth * .3,
$surfMidHeight * .15,
255, 255, 0, 255
);
SDL::GFXAaellipseRGBA(
$surf, $surfWidth - $surfMidWidth * .6,
$surfMidHeight,
$surfMidWidth * .3,
$surfMidHeight * .15,
255, 255, 0, 255
);
SDL::GFXFilledEllipseRGBA(
$surf, $surfWidth - $surfMidWidth * .3,
$surfMidHeight,
$surfMidWidth * .25,
$surfMidHeight * .10,
255, 255, 0, 255
);
# pie slices
SDL::GFXFilledPieRGBA(
$surf, $surfMidWidth, $surfMidHeight,
$surfMidWidth * .1,
0, 90, 0, 0, 255, 255
);
SDL::GFXFilledPieRGBA(
$surf, $surfMidWidth, $surfMidHeight,
$surfMidWidth * .1,
180, 270, 0, 0, 255, 255
);
# polygons
# TBD...
# characters & strings
SDL::GFXCharacterRGBA( $surf, $surfMidWidth, 0, "!", 255, 255, 255, 255 );
SDL::GFXStringRGBA(
$surf, $surfMidWidth,
$surfHeight * .75,
"SDL_Perl Primitive Test.",
255, 255, 255, 255
);
$app->flip();
$app->loop(
{ SDL_QUIT() => sub { exit(0); },
SDL_KEYDOWN() =>
sub { exit(0) if ( SDL::GetKeyState(SDLK_ESCAPE) ); },
}
);
}
## Main program loop
get_cmd_args();
set_app_args();
init_game_context();
instruments();
game_loop();
Jump to Line
Something went wrong with that request. Please try again.