#!/usr/bin/env perl # # testsprite.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 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 vars qw/ $app $app_rect $background $event $sprite $sprite_rect $videoflags /; ## User tweakable settings (via cmd-line) my %settings = ( 'numsprites' => 75, 'screen_width' => 640, 'screen_height' => 480, 'video_bpp' => 8, 'fast' => 0, 'hw' => 0, 'flip' => 1, 'fullscreen' => 0, 'bpp' => undef, ); ## 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 our $bmp; sub init_game_context { write_bmp(); $app = new SDL::App ( -width => $settings{screen_width}, -height=> $settings{screen_height}, -title => "testsprite", -icon => "/tmp/icon.bmp", -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/icon.bmp'); # Set transparent pixel as the pixel at (0,0) $sprite->display_format(); $sprite->set_color_key(SDL_SRCCOLORKEY,$sprite->pixel(0,0)); # sets the transparent color to that at (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(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"); } } sub put_sprite { my ($x,$y) = @_; my $dest_rect = new SDL::Rect(-x => $x, -y => $y, -width => $sprite->width, -height => $sprite->height, ); $sprite->blit($sprite_rect, $app, $dest_rect); } sub game_loop { my $x=0; my $y=$settings{screen_height}>>1; my $i=0; while (1) { # process event queue $event->pump; $event->poll; my $etype=$event->type; # handle user events last if ($etype eq SDL_QUIT ); last if (SDL::GetKeyState(SDLK_ESCAPE)); #$app->lock() if $app->lockp(); # page flip # __draw gfx $app->fill($app_rect, $background); foreach (1..$settings{numsprites}) { put_sprite( $_*8, $y + (sin(($i+$_)*0.2)*($settings{screen_height}/3))); } $i+=30; # __graw gfx end #$app->unlock(); $app->flip if $settings{flip}; } } ## Main program loop set_app_args(); init_game_context(); instruments(); game_loop(); system 'rm /tmp/icon.bmp'; exit(0); sub write_bmp { $bmp = decode_base64 < /tmp/icon.bmp"; print FP $bmp; close FP; }