/examples/pixel_operations/sols/ch02.pl

http://github.com/PerlGameDev/SDL · Perl · 75 lines · 53 code · 22 blank · 0 comment · 13 complexity · 31b3cb388927e77634d71b21522c2198 MD5 · raw file

  1. package SDL::Tutorial::Sol::Two;
  2. use strict;
  3. use warnings;
  4. use Carp;
  5. use SDL v2.3;
  6. use SDL::Video;
  7. use SDL::Event;
  8. use SDL::Events;
  9. use SDL::Surface;
  10. my $screen;
  11. sub putpixel {
  12. my ( $x, $y, $color ) = @_;
  13. my $lineoffset = $y * ( $screen->pitch / 4 );
  14. $screen->set_pixels( $lineoffset + $x, $color );
  15. }
  16. sub render {
  17. if ( SDL::Video::MUSTLOCK($screen) ) {
  18. return if ( SDL::Video::lock_surface($screen) < 0 );
  19. }
  20. my $ticks = SDL::get_ticks();
  21. my ( $i, $y, $yofs, $ofs ) = ( 0, 0, 0, 0 );
  22. for ( $i = 0; $i < 480; $i++ ) {
  23. for ( my $j = 0, $ofs = $yofs; $j < 640; $j++, $ofs++ ) {
  24. $screen->set_pixels( $ofs, ( $i * $i + $j * $j + $ticks ) );
  25. }
  26. $yofs += $screen->pitch / 4;
  27. }
  28. putpixel( 10, 10, 0xff0000 );
  29. putpixel( 11, 10, 0xff0000 );
  30. putpixel( 10, 11, 0xff0000 );
  31. putpixel( 11, 11, 0xff0000 );
  32. SDL::Video::unlock_surface($screen) if ( SDL::Video::MUSTLOCK($screen) );
  33. SDL::Video::update_rect( $screen, 0, 0, 640, 480 );
  34. return 0;
  35. }
  36. sub main {
  37. Carp::cluck 'Unable to init SDL: ' . SDL::get_error()
  38. if ( SDL::init(SDL_INIT_VIDEO) < 0 );
  39. $screen = SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE );
  40. Carp::cluck 'Unable to set 640x480x32 video' . SDL::get_error() if ( !$screen );
  41. while (1) {
  42. render();
  43. my $event = SDL::Event->new();
  44. while ( SDL::Events::poll_event($event) ) {
  45. my $type = $event->type;
  46. return 0 if ( $type == SDL_KEYDOWN );
  47. return 0 if ( $type == SDL_QUIT );
  48. }
  49. SDL::Events::pump_events();
  50. }
  51. }
  52. main;
  53. SDL::quit;