Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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.