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(); 153