/examples/pixel_operations/fast_pixel_write.pl

http://github.com/PerlGameDev/SDL · Perl · 82 lines · 63 code · 19 blank · 0 comment · 3 complexity · 19f5926a3ddedcdeeab590e71d1c314c MD5 · raw file

  1. use strict;
  2. use warnings;
  3. use SDL;
  4. use SDLx::App; #this is in the github repo.
  5. use SDLx::Surface;
  6. use SDL::Event;
  7. use SDL::Events;
  8. use SDL::Rect;
  9. use SDL::Video;
  10. my $app = SDLx::App->new(
  11. title => 'Application Title',
  12. width => 640,
  13. height => 480,
  14. depth => 32
  15. );
  16. load_app();
  17. my $surface = load_surface();
  18. my $matrix = SDLx::Surface::pixel_array($surface);
  19. my $event = SDL::Event->new; # create a new event
  20. foreach ( 0 ... 100 ) {
  21. SDL::Events::pump_events();
  22. while ( SDL::Events::poll_event($event) ) {
  23. my $type = $event->type(); # get event type
  24. exit if $type == SDL_QUIT;
  25. }
  26. update();
  27. SDL::Video::update_rect( $app, 0, 0, $app->w, $app->h );
  28. }
  29. sub load_app {
  30. my $mapped_color = SDL::Video::map_RGB( $app->format(), 0, 0, 0 ); # blue
  31. SDL::Video::fill_rect(
  32. $app, SDL::Rect->new( 0, 0, $app->w, $app->h ),
  33. $mapped_color
  34. );
  35. return $app;
  36. }
  37. sub load_surface {
  38. my $surface = SDL::Surface->new( SDL_ANYFORMAT, 100, 100, 32, 0, 0, 0, 0 );
  39. my $mapped_color = SDL::Video::map_RGB( $surface->format(), 0, 0, 0 ); # blue
  40. SDL::Video::fill_rect(
  41. $surface,
  42. SDL::Rect->new( 0, 0, $surface->w, $surface->h ),
  43. $mapped_color
  44. );
  45. return $surface;
  46. }
  47. sub update {
  48. load_app();
  49. SDL::Video::blit_surface(
  50. $surface,
  51. SDL::Rect->new( 0, 0, $surface->w, $surface->h ),
  52. $app,
  53. SDL::Rect->new(
  54. ( $app->w - $surface->w ) / 2, ( $app->h - $surface->h ) / 2,
  55. $app->w, $app->h
  56. )
  57. );
  58. SDL::Video::lock_surface($surface);
  59. foreach ( 0 ... 100 ) {
  60. vec( ${ $matrix->[ $_ - 1 ][ rand( $surface->h ) - 1 ] }, 0, 32 ) = 0xFF0000FF;
  61. }
  62. SDL::Video::unlock_surface($surface);
  63. }