PageRenderTime 44ms CodeModel.GetById 1ms app.highlight 39ms RepoModel.GetById 2ms app.codeStats 0ms

/examples/SDLx/SDLx_controller_two_squares.pl

http://github.com/PerlGameDev/SDL
Perl | 152 lines | 117 code | 29 blank | 6 comment | 29 complexity | bd0ae8b746628da31870ffbc0ce781ce MD5 | raw file
  1use strict;
  2use warnings;
  3use Carp;
  4use SDL;
  5use SDL::Video;
  6use SDL::Surface;
  7use SDL::Rect;
  8use SDL::Event;
  9use SDL::Events;
 10use Data::Dumper;
 11use Math::Trig;
 12
 13use lib 'lib';
 14use SDLx::Controller;
 15
 16my $app = init();
 17
 18my $ball = {
 19	x     => 0,
 20	y     => 0,
 21	w     => 20,
 22	h     => 20,
 23	vel   => 20,
 24	x_vel => 0,
 25	y_vel => 0,
 26
 27};
 28
 29my $r_ball = {
 30	x       => 0,
 31	y       => 0,
 32	w       => 20,
 33	h       => 20,
 34	radians => 0,
 35	rot_vel => 10,
 36	radius  => 100,
 37	c_x     => $app->w / 2,
 38	c_y     => $app->h / 2,
 39};
 40
 41sub init {
 42
 43	# Initing video
 44	# Die here if we cannot make video init
 45	Carp::confess 'Cannot init  ' . SDL::get_error()
 46		if ( SDL::init(SDL_INIT_VIDEO) == -1 );
 47
 48	# Create our display window
 49	# This is our actual SDL application window
 50	my $a = SDL::Video::set_video_mode(
 51		800, 600, 32,
 52		SDL_HWSURFACE | SDL_DOUBLEBUF | SDL_HWACCEL
 53	);
 54
 55	Carp::confess 'Cannot init video mode 800x600x32: ' . SDL::get_error()
 56		unless $a;
 57
 58	return $a;
 59}
 60
 61my $game = SDLx::Controller->new();
 62
 63sub on_move {
 64	my $dt = shift;
 65	$ball->{x} += $ball->{x_vel} * $dt;
 66
 67	$ball->{y} += $ball->{y_vel} * $dt;
 68
 69	# Period = $r_ball->{vel}
 70	# cc_speed = 2 * pi * r / T
 71	$r_ball->{radians} += $r_ball->{rot_vel} * $dt;
 72	$r_ball->{x} = $r_ball->{c_x} + sin( $r_ball->{radians} * pi / 180 ) * $r_ball->{radius};
 73	$r_ball->{y} = $r_ball->{c_y} + cos( $r_ball->{radians} * pi / 180 ) * $r_ball->{radius};
 74
 75	return 1;
 76}
 77
 78sub on_event {
 79	my $event = shift;
 80
 81	if ( $event->type == SDL_KEYDOWN ) {
 82		my $key = $event->key_sym;
 83		if ( $key == SDLK_PRINT ) {
 84			my $screen_shot_index = 1;
 85			map { $screen_shot_index = $1 + 1 if $_ =~ /Shot(\d+)\.bmp/ && $1 >= $screen_shot_index } <Shot*\.bmp>;
 86			SDL::Video::save_BMP(
 87				$app,
 88				sprintf( "Shot%04d.bmp", $screen_shot_index )
 89			);
 90		}
 91		$ball->{y_vel} -= $ball->{vel} if $key == SDLK_UP;
 92		$ball->{y_vel} += $ball->{vel} if $key == SDLK_DOWN;
 93		$ball->{x_vel} -= $ball->{vel} if $key == SDLK_LEFT;
 94		$ball->{x_vel} += $ball->{vel} if $key == SDLK_RIGHT;
 95		$r_ball->{rot_vel} += 50 if $key == SDLK_SPACE;
 96
 97	} elsif ( $event->type == SDL_KEYUP ) {
 98		my $key = $event->key_sym;
 99		$ball->{y_vel} += $ball->{vel} if $key == SDLK_UP;
100		$ball->{y_vel} -= $ball->{vel} if $key == SDLK_DOWN;
101		$ball->{x_vel} += $ball->{vel} if $key == SDLK_LEFT;
102		$ball->{x_vel} -= $ball->{vel} if $key == SDLK_RIGHT;
103
104	} elsif ( $event->type == SDL_QUIT ) {
105		$_[0]->stop;
106	}
107
108}
109
110sub on_show {
111	SDL::Video::fill_rect(
112		$app,
113		SDL::Rect->new( 0, 0, $app->w, $app->h ),
114		SDL::Video::map_RGB( $app->format, 0, 0, 0 )
115	);
116
117	SDL::Video::fill_rect(
118		$app,
119		SDL::Rect->new( $ball->{x}, $ball->{y}, $ball->{w}, $ball->{h} ),
120		SDL::Video::map_RGB( $app->format, 0, 0, 255 )
121	);
122
123	SDL::Video::fill_rect(
124		$app,
125		SDL::Rect->new(
126			$r_ball->{x}, $r_ball->{y}, $r_ball->{w}, $r_ball->{h}
127		),
128		SDL::Video::map_RGB( $app->format, 255, 0, 0 )
129	);
130
131	SDL::Video::flip($app);
132
133	return 0;
134}
135
136my $move_id  = $game->add_move_handler( \&on_move );
137my $event_id = $game->add_event_handler( \&on_event );
138my $show_id  = $game->add_show_handler( \&on_show );
139
140print <<'EOT';
141In this example, you should see two small squares, one blue
142and one red. The red square should move around in circles, while
143you can control the blue one with the keyboard arrow keys.
144
145Also, if you press the "print screen" key, it will save an image
146called shot0001.bmp in your current dir. Pressing it again will
147create a new screenshot file, with the index incremented. That is,
148assuming your system will propagate the "print screen" event :)
149
150To exit the demo, just close the window normally.
151EOT
152$game->run();