#!/usr/bin/env perl # # testgfxroto.pl # # Copyright (C) 2005 David J. Goehrig # # ------------------------------------------------------------------------------ # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # ------------------------------------------------------------------------------ # # Please feel free to send questions, suggestions or improvements to: # # David J. Goehrig # dgoehrig@cpan.org # use strict; use Getopt::Long; use Data::Dumper; use MIME::Base64 qw(decode_base64); use SDL; use SDL::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 /; ## Test for SDL_gfx support die "Your system was 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' => 200, 'screen_height' => 200, 'video_bpp' => 8, 'fast' => 0, 'hw' => 0, 'flip' => 1, '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}, "flip!" => \$settings{flip}, "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_DOUBLEBUF if $settings{flip}; $videoflags |= SDL_FULLSCREEN if $settings{fullscreen}; } ## Setup sub init_game_context { $app = new SDL::App ( -width => $settings{screen_width}, -height=> $settings{screen_height}, -title => "testsprite", -flags => $videoflags, ); $app_rect= new SDL::Rect( -height => $settings{screen_height}, -width => $settings{screen_width}, ); $background = $SDL::Color::black; $sprite = new SDL::Surface -name =>"/tmp/spiral.png"; $sprite->display_format(); SDL::SetColorKey($$sprite, SDL_SRCCOLORKEY, SDL::SurfacePixel($$sprite,0,0)); $sprite_rect = new SDL::Rect(-x => 0, -y => 0, -width => $sprite->width, -height=> $sprite->height, ); $event = new SDL::Event(); } ## 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 put_sprite_rotated($sprite, $settings{screen_width}/2, $settings{screen_height}/2, 0,0,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"); } } # this can get silly in terms of # memory usage, and maybe key lookup. # it would be better to 'tie' the hash # to an object which can # better manage memory usage. my %rotate_cache =(); sub generate_sprite_rotated { my ($surface, $angle, $zoom, $smooth) = @_; $angle %= 360; my $key = "$surface$angle$zoom$smooth"; if ( $rotate_cache{$key} ) { return $rotate_cache{$key}; } else { my $sur = SDL::GFXRotoZoom($surface, $angle, $zoom, $smooth); $rotate_cache{$key}= SDL::DisplayFormat($sur); } return $rotate_cache{$key}; } sub put_sprite_rotated { my ($surface, $x, $y, $angle, $zoom, $smooth) = @_; my $roto = generate_sprite_rotated($$surface, $angle, $zoom, $smooth); die "Failed to create rotozoom surface" unless $roto; my ($w,$h) = (SDL::SurfaceW($roto),SDL::SurfaceH($roto));; my $dest_rect = new SDL::Rect -x => $x - ($w/2), -y => $y - ($h/2), -width => $w, -height => $h; SDL::BlitSurface($roto, 0, $$app, $$dest_rect); } sub game_loop { my $ox=$settings{screen_width}>>1;; my $oy=$settings{screen_height}>>1; my $sectors = 12; my $angleDelta = 360/$sectors;; my $zoom = 1; my $smooth =1; my $angle =0; my $radius =128; FRAME: while (1) { # process event queue $event->pump; if ($event->poll) { my $etype=$event->type(); # handle quit events last FRAME if ($etype == SDL_QUIT() ); last FRAME if (SDL::GetKeyState(SDLK_ESCAPE)); } # needed for HW surface locking #$app->lock() if $app->lockp(); #$app->unlock(); $app->flip if $settings{flip}; ################################################ # do some drawing $app->fill($app_rect, $background); $angle += 16; put_sprite_rotated($sprite, $settings{screen_width}/2, $settings{screen_height}/2, $angle, $zoom, $smooth); } print "Cache entries: " . scalar(keys %rotate_cache) . "\n"; } ## Main program loop write_spiral(); get_cmd_args(); set_app_args(); init_game_context(); instruments(); game_loop(); exit(0); sub write_spiral { my $png = decode_base64 < /tmp/spiral.png"; print FP $png; close FP; }