+++ /dev/null
-#!/usr/bin/env perl
-#
-# testsprite.pl
-#
-# Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
-#
-# ------------------------------------------------------------------------------
-#
-# 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 <<EOF;
-Qk1CAgAAAAAAAEIAAAAoAAAAIAAAACAAAAABAAQAAAAAAAACAABtCwAAbQsAAAMAAAADAAAA////
-AAAAAAAA//8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
-AAAAAAAAAAAAAAAAAAAAAAAAAAAAABEREREAAAAAAAAAAAAAABEiIiIiEQAAAAAAAAAAAAEiIRER
-EiIQAAAAAAAAAAASIRERERESIQAAAAAAAAABIhERERERESIQAAAAAAAAEiERIiIiIhESIQAAAAAA
-ABIiIiIiIiIiIiEAAAAAAAEiIiIiIiIiIiIiEAAAAAABIiIiIiESIiIiIhAAAAAAASIiIiIhEiIi
-IiIQAAAAAAEiIiIiIiIiIiIiEAAAAAABIiIiIiIiIiIiIhAAAAAAASIiEREiIhERIiIQAAAAAAEi
-IhEBIiIRASIiEAAAAAAAEiIRESIiEREiIQAAAAAAABIiIiIiIiIiIiEAAAAAAAABIiIiIiIiIiIQ
-AAAAAAAAABIiIiIiIiIhAAAAAAAAAAABIiIiIiIiEAAAAAAAAAAAABEiIiIiEQAAAAAAAAAAAAAA
-EREREQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
-AAAAAAAAAAA=
-EOF
- open FP, "> /tmp/icon.bmp";
- print FP $bmp;
- close FP;
-}
-
projects / sdlgit/SDL_perl.git / blobdiff