/t_backcompat/testsprite.pl

http://github.com/PerlGameDev/SDL · Perl · 180 lines · 115 code · 42 blank · 23 comment · 20 complexity · 748d15e7f83a6fc3fbfb4392b5d9173f MD5 · raw file

  1. #!/usr/bin/env perl
  2. #
  3. # testspite.pl
  4. #
  5. # adapted from SDL-1.2.x/test/testsprite.c
  6. # Usage: testsprite.pl [-bpp N] [-hw] [-flip] [-fast] [-fullscreen] [numsprites]
  7. use strict;
  8. use warnings;
  9. use Getopt::Long;
  10. use Data::Dumper;
  11. use Carp;
  12. use SDL;
  13. use SDLx::App;
  14. use SDL::Video;
  15. use SDL::Event;
  16. use SDL::Events;
  17. use SDL::Surface;
  18. use SDL::Color;
  19. use SDL::Rect;
  20. use vars qw/ $app $app_rect $background $event $sprite $sprite_rect $videoflags /;
  21. ## User tweakable settings (via cmd-line)
  22. my %settings = (
  23. 'numsprites' => 75,
  24. 'screen_width' => 640,
  25. 'screen_height' => 480,
  26. 'video_bpp' => 8,
  27. 'fast' => 0,
  28. 'hw' => 0,
  29. 'flip' => 1,
  30. 'fullscreen' => 0,
  31. 'bpp' => undef,
  32. );
  33. ## Process commandline arguments
  34. sub get_cmd_args {
  35. GetOptions(
  36. "width:i" => \$settings{screen_width},
  37. "height:i" => \$settings{screen_height},
  38. "bpp:i" => \$settings{bpp},
  39. "fast!" => \$settings{fast},
  40. "hw!" => \$settings{hw},
  41. "flip!" => \$settings{flip},
  42. "fullscreen!" => \$settings{fullscreen},
  43. "numsprites=i" => \$settings{numsprites},
  44. );
  45. }
  46. ## Initialize application options
  47. sub set_app_args {
  48. $settings{bpp} ||= 8; # default to 8 bits per pix
  49. $videoflags |= SDL_HWACCEL if $settings{hw};
  50. $videoflags |= SDL_DOUBLEBUF if $settings{flip};
  51. $videoflags |= SDL_FULLSCREEN if $settings{fullscreen};
  52. }
  53. ## Setup
  54. sub init_game_context {
  55. $app = SDLx::App->new(
  56. -width => $settings{screen_width},
  57. -height => $settings{screen_height},
  58. -title => "testsprite",
  59. -icon => "data/icon.bmp",
  60. -flags => $videoflags,
  61. );
  62. $app_rect = SDL::Rect->new( 0, 0, $app->w, $app->h );
  63. $background = SDL::Video::map_RGB( $app->format, 0x00, 0x00, 0x00 );
  64. $sprite = SDL::Video::load_BMP("data/icon.bmp");
  65. Carp::confess 'Cannot make sprite:' . SDL::get_error() if !$sprite;
  66. # Set transparent pixel as the pixel at (0,0)
  67. SDL::Video::display_format($sprite);
  68. my $pixel = SDL::Color->new( 0xff, 0xff, 0xff );
  69. SDL::Video::set_color_key( $sprite, SDL_SRCCOLORKEY, $pixel ); # sets the transparent color to that at (0,0)
  70. $sprite_rect = SDL::Rect->new( 0, 0, $sprite->w, $sprite->h );
  71. $event = SDL::Event->new();
  72. }
  73. ## Prints diagnostics
  74. sub instruments {
  75. if ( ( $app->flags & SDL_HWSURFACE ) == SDL_HWSURFACE ) {
  76. printf("Screen is in video memory\n");
  77. } else {
  78. printf("Screen is in system memory\n");
  79. }
  80. if ( ( $app->flags & SDL_DOUBLEBUF ) == SDL_DOUBLEBUF ) {
  81. printf("Screen has double-buffering enabled\n");
  82. }
  83. if ( ( $sprite->flags & SDL_HWSURFACE ) == SDL_HWSURFACE ) {
  84. printf("Sprite is in video memory\n");
  85. } else {
  86. printf("Sprite is in system memory\n");
  87. }
  88. # Run a sample blit to trigger blit (if posssible)
  89. # acceleration before the check just after
  90. put_sprite( 0, 0 );
  91. if ( ( $sprite->flags & SDL_HWACCEL ) == SDL_HWACCEL ) {
  92. printf("Sprite blit uses hardware acceleration\n");
  93. }
  94. if ( ( $sprite->flags & SDL_RLEACCEL ) == SDL_RLEACCEL ) {
  95. printf("Sprite blit uses RLE acceleration\n");
  96. }
  97. }
  98. sub put_sprite {
  99. my ( $x, $y ) = @_;
  100. my $dest_rect = SDL::Rect->new( $x, $y, $sprite->w, $sprite->h );
  101. SDL::Video::blit_surface( $sprite, $sprite_rect, $app, $dest_rect );
  102. }
  103. sub game_loop {
  104. my $x = 0;
  105. my $y = $settings{screen_height} >> 1;
  106. my $i = 0;
  107. while (1) {
  108. # process event queue
  109. SDL::Events::pump_events();
  110. if ( SDL::Events::poll_event($event) ) {
  111. my $etype = $event->type;
  112. # handle user events
  113. last if ( $etype eq SDL_QUIT );
  114. #last if (SDL::Events::get_key_state() );
  115. }
  116. #$app->lock() if $app->lockp();
  117. # page flip
  118. # __draw gfx
  119. SDL::Video::fill_rect( $app, $app_rect, $background );
  120. foreach ( 1 .. $settings{numsprites} ) {
  121. put_sprite(
  122. $_ * 8,
  123. $y + ( sin( ( $i + $_ ) * 0.2 ) * ( $settings{screen_height} / 3 ) )
  124. );
  125. }
  126. $i += 30;
  127. # __graw gfx end
  128. #$app->unlock();
  129. SDL::Video::flip($app) if $settings{flip};
  130. }
  131. }
  132. ## Main program loop
  133. get_cmd_args();
  134. set_app_args();
  135. init_game_context();
  136. instruments();
  137. game_loop();
  138. exit(0);