PageRenderTime 33ms CodeModel.GetById 18ms app.highlight 12ms RepoModel.GetById 1ms app.codeStats 1ms

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