Perl SDL -> Drawing

Drawing

SDL provides several ways to draw graphical elements on the screen in three general categories: primitives, images, and text. All drawing occurs on a surface, represented by the SDLx::Surface class. Even the SDLx::App is a SDLx::Surface. Though this means it's possible to draw directly to the app's surface, there are several advantages to drawing on multiple surfaces.

3.1 Coordinates

SDL's surface coordinate system has its origin (where both the x and y coordinates have the value of zero) in the upper left corner. As the value of x increases, the position moves downward from the origin. The API always lists coordinates in x, y order.

The SDL library documentation has an extended discussion on coordinates: http://sdltutorials.com/sdl-coordinates-and-blitting.

3.2 Drawing

You can produce original pictures knowing little more than how to draw to a surface with SDL. As mentioned earlier, all drawing in SDL requires a surface. The SDLx::Surface object provides access to methods in the form of :

--------------------------------------------------------------------------------------------------------------------

$surface->draw_{something}(.......);

--------------------------------------------------------------------------------------------------------------------

Parameters to these methods are generally coordinates and colors, provided as array referances.

Rectangular Parameters

Some parameters are sets of coordinate positions and dimentions. For example, parameters to describe a rectangle af 40x40 pixels placed at (20, 20) pixel units on the screen make a four element array of x, y, width, height:

-----------------------------------------------------------------------------------------------------------------

my $rect = [20, 20, 40, 40];

-----------------------------------------------------------------------------------------------------------------

Color

SDL color parameters require four-element array references. The first three numbers define the Red, Green, and Blue intensity of the color. The final number defines the transparency of the color.

-------------------------------------------------------------------------------------------------------------------

my $color = [ 255, 255, 255, 255];

--------------------------------------------------------------------------------------------------------------------

The magnitude of each color value determins how much of that color component will be mixed into the resulting color. A 0 value specifies that none of the color channel should be used while 255 specifies a maximum intencity for a particular channel. The first value coresponds with the Red channel, so a higher number there means more red will be mixed into the resulting color. It is a common practice to achieve a grayscale of varying intencity by specifying the same value for each of the Red, Green, and Blue color channels. The fourth and final value designates the transparency (or Alpha channel) where a 0 value makes the resuting color fully transparent and 255 makes it entirely opaque. A trancparency value somewhare in between will allow underlying (pixel data of surfaces below the current one) colors to be blended with the specified RGB values into the final output.

You may also represent a color as hexadecimal values, where the values of the numbers range from 0-255 for 32 bit depth in RGBA format:

-----------------------------------------------------------------------------------------------------------------------------

my $color = 0xFFFFFFFF;

my $white= 0xFFFFFFFF;

my $black= 0x000000FF;

my $red   = 0xFF0000FF;

my $green=0x00FF00FF;

my $blue  = 0x0000FFFF;

--------------------------------------------------------------------------------------------------------------------------

... or as four-byte hexadecimal values, where each two-digit byte encodes the same RGBA values:

--------------------------------------------------------------------------------------------------------------------------

my $goldenrod  = 0xDAA520FF;

--------------------------------------------------------------------------------------------------------------------------

The color depth of the surface-how many bits are available to describe color is a property of the relevant SDLx::Surface or SDLx::App. Set it in its constructor: 

-------------------------------------------------------------------------------------------------------------------------

my $app = SDLx::App->new ( depth => 32, );

--------------------------------------------------------------------------------------------------------------------------

 The default bit depth is 32, such that each color component has 256 possible values. Other options are 24, 16, and 8.

3.2.2 Pixels

All SDLx::Surfaces are collections of pixels. You can read from and write to these pixels by treating the surface as an array reference:

----------------------------------------------------------------------------------------------------------------------------

$app->[$x][$y] = $color;

----------------------------------------------------------------------------------------------------------------------------

... where $color is an unsigned integer value using the hexadecimal format (0xRRGGBBAA) or un anonymous array of the form [$red, $green, $blue, $alpha].

3.2.3 Primitives

Drawing primitives are simple shapes that SDL supports natively.

Lines

A line is a series of contiguous pixels between two points. The draw_line method causes SDL to draw a line to a sourface:

-----------------------------------------------------------------------------------------------------------------------

#!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDL::Event;
use SDL::Events;
use SDLx::App;

my $app =SDLx::App->new (
    w    => 500,
    h    => 500,
    d     => 32,
    title    => 'QUIT EVENTS',
    exit_on_quit => 1,
);
# this will draw a line from position (200, 20) to (20, 200)
$app->draw_line([200, 20], [20, 200], [255,255,0,255]);

$app->run();

--------------------------------------------------------------------------------------------------------------------------------

 Rectangles

 A rectangle is a four-sides, filled polygon. Rectangles are a common building block for games. In SDL, rectangles are the most cost effective  of the primitives to draw. The draw_rect method draws a rectangle on a surface:

----------------------------------------------------------------------------------------------------------------------------------

#!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDL::Event;
use SDL::Events;
use SDLx::App;

my $app =SDLx::App->new (
    w    => 500,
    h    => 500,
    d     => 32,
    title    => 'QUIT EVENTS',
    exit_on_quit => 1,
);
# draw a rectangle of size 20x200 at position 200,20)
$app->draw_rect([200, 20, 20, 200], [255,255,0,255]);

$app->run();

-------------------------------------------------------------------------------------------------------------------------

  

Perl SDL -> Handling Events

SDL provides an event queue which holds all events that occur.
----------------------------------------------------------------------------------------------------------------------------
#!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDL::Event;
use SDL::Events;
use SDLx::App;

my $app =SDLx::App->new (
    w    => 500,
    h    => 500,
    d     => 32,
    title    => 'QUIT EVENTS',
    exit_on_quit => 1,
);

$app->run();
----------------------------------------------------------------------------------------------------------------------------

------------------------------------------------------------------------------------------------------------------------------

#!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDL::Event;
use SDL::Events;
use SDLx::App;

my $app =SDLx::App->new (
    w    => 500,
    h    => 500,
    d     => 32,
    title    => 'QUIT EVENTS',
    exit_on_quit => 1,
);

$app->add_event_handler(    \&quit_event);

$app->run();

sub quit_event {
    # the callback receives the appropriate SDL::Event
    my ($event, $controller ) = @_;
    # stopping the controller will exit $app->run() for as
    $controller->stop if $event->type == SDL_QUIT;
}
----------------------------------------------------------------------------------------------------------------------------

Perl SDL -> Laser

#!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDL::Event;
use SDLx::App;

my $app = SDLx::App->new (
    w    => 500,
    h    => 500,
    title    => 'SDL Laser',
    exit_on_quit => 1,
);

my $laser = 0;

my $velocity = 10;

$app->add_event_handler( \&quit);
$app->add_move_handler( \&calculate_laser);
$app->add_show_handler( \&render_laser);

$app->run();

sub quit {
    my $event = shift;
    my $controller = shift;
    $controller->stop if $event->type == SDL_QUIT;
}

sub calculate_laser {
    my ( $step, $app, $t ) = @_;
    $laser += $velocity * $step;
    $laser = 0 if $laser > $app->w;
}

sub render_laser {
    my ( $delta, $app ) = @_;
    $app->draw_rect( [0, 0, $app->w, $app->h], 0);
    $app->draw_rect( [$laser, $app->h/2, 10, 2], [250, 0, 0, 255]);
   
    $app->update();
}
-------------------------------------------------------------------------------------------------------------------------------

Perl SDL -> New Game!

#!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDL::Events;
use SDLx::App;
use SDLx::Rect;
use SDLx::Text;
# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'New Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player = {
    x             =>  $app->w/2,
    y             => $app->h-20,
    w         => 80,
    h             => 20,
    vel       => 250,
    y_vel     => 0,
};
my $minge = {
    x    => $app->w/2,
    y    => $app->h/2,
    dim    => 10,
};

$app->add_show_handler( \&show);
$app->run;

sub show {
    # first, clear the screen
    $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
    $app->draw_rect([$player->{x}, $player->{y}, $player->{w}, $player->{h}], 0xFF0000FF);
    $app->draw_circle_filled([$minge->{x}, $minge->{y}], $minge->{dim}, [0, 0,255, 255]);
    $app->update();
}
-------------------------------------------------------------------------------------------------------------------------------

------------------------------------------------------------------------------------------------------------------------------

PERL SDL Game development

SDL Perl are a set of bindings to the Simple DirectMedia Layer (SDL).
'Simple DirectMedia Layer is a cross-platform multimedia library designed to provide low level access to audio, keyboard, mouse, joystick, 3D hardware via OpenGL, and 2D video framebuffer. It is used by MPEG playback software, emulators, and many popular games, including the award winning Linux port of "Civilization: Call To Power."' --www.libsdl.org
SDL Perl is an active and exciting project with many facets. Explore this website to learn more.
 --------------------------------------------------------------------------------------------------------------------
#!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDLx::App;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

# let's roll!
$app->run;
--------------------------------------------------------------------------------------------------------------------------

--------------------------------------------------------------------------------------------------------------------------
#!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
           
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
           
            $app->update();
    }
);
# let's roll!
$app->run;
------------------------------------------------------------------------------------------------------------------------------------

------------------------------------------------------------------------------------------------------------------------------

#!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
          
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# let's roll!
$app->run;
--------------------------------------------------------------------------------------------------------------------

------------------------------------------------------------------------------------------------------------------------------

 #!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
};

my $ball = {
    rect => SDLx::Rect->new($app->w/2, $app->h/2, 10, 10),
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
            # render the ball
            $app->draw_rect( $ball->{rect}, 0xFF0000FF);
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# let's roll!
$app->run;
------------------------------------------------------------------------------------------------------------------------------

----------------------------------------------------------------------------------------------------------------------------------

 #!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
    v_y        => 0,
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
};

my $ball = {
    rect => SDLx::Rect->new($app->w/2, $app->h/2, 10, 10),
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
            # render the ball
            $app->draw_rect( $ball->{rect}, 0xFF0000FF);
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# ---- handles the player's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player1->{paddle};
            my $v_y        = $player1->{v_y};
          
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# let's roll!
$app->run;
-----------------------------------------------------------------------------------------------------------------------------

---------------------------------------------------------------------------------------------------------------------------

 #!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
    v_y        => 0,
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
    v_y       => 0,
};

my $ball = {
    rect => SDLx::Rect->new($app->w/2, $app->h/2, 10, 10),
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
            # render the ball
            $app->draw_rect( $ball->{rect}, 0xFF0000FF);
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# ---- handles the player's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player1->{paddle};
            my $v_y        = $player1->{v_y};
          
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# handles AI's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player2->{paddle};
            my $v_y        = $player2->{v_y};
          
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# let's roll!
$app->run;
---------------------------------------------------------------------------------------------------------------------

------------------------------------------------------------------------------------------------------------------------------

 #!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
    v_y        => 0,
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
    v_y       => 0,
};

my $ball = {
    rect => SDLx::Rect->new($app->w/2, $app->h/2, 10, 10),
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
            # render the ball
            $app->draw_rect( $ball->{rect}, 0xFF0000FF);
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# ---- handles the player's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player1->{paddle};
            my $v_y        = $player1->{v_y};
          
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# handles AI's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player2->{paddle};
            my $v_y        = $player2->{v_y};
          
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# let's roll!
$app->run;
-----------------------------------------------------------------------------------------------------------------------
#!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDL::Events;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
    v_y        => 0,
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
    v_y       => 0,
};

my $ball = {
    rect => SDLx::Rect->new($app->w/2, $app->h/2, 10, 10),
    v_x => -2.7,
    v_y => 1.8,
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
            # render the ball
            $app->draw_rect( $ball->{rect}, 0xFF0000FF);
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# ---- handles the player's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player1->{paddle};
            my $v_y        = $player1->{v_y};
           
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# handles AI's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player2->{paddle};
            my $v_y        = $player2->{v_y};
           
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# ---- handles Keyboard events
$app->add_event_handler(
    sub {
            my ( $event, $app ) = @_;
            # user pressing a key
            if ( $event->type == SDL_KEYDOWN ) {
                # up arrow key means going up (negative velocity)
                if ( $event->key_sym == SDLK_UP ) {
                    $player1->{v_y} = -500;
                }
                # down arrow key means going down (positive velocity)
                elsif ( $event->key_sym == SDLK_DOWN ) {
                    $player1->{v_y} = 500;
                }
            }
            # user releasing a key
            elsif ( $event->type == SDL_KEYUP ) {
                # up or down arrow keys released, stop the paddle
                if ( $event->key_sym==SDLK_UP or $event->key_sym== SDLK_DOWN ) {
                    $player1->{v_y} = $app->width/2;
                   
            }
        }
    }
);
# handles the ball movement
$app->add_move_handler (
    sub {
        my ( $step, $app )  = @_;
        my $ball_rect     = $ball->{rect};
       
        $ball_rect->x( $ball_rect->x +( $ball->{v_x} * $step));
        $ball_rect->y( $ball_rect->y +( $ball->{v_y} * $step));
    }
);

# let's roll!
$app->run;
--------------------------------------------------------------------------------------------------------------------------------

--------------------------------------------------------------------------------------------------------------------------------

 #!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDL::Events;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
    v_y        => 0,
    score   => 0,
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
    v_y       => 0,
    score  => 0,
};

my $ball = {
    rect => SDLx::Rect->new($app->w/2, $app->h/2, 10, 10),
    v_x => -2.7,
    v_y => 1.8,
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
            # render the ball
            $app->draw_rect( $ball->{rect}, 0xFF0000FF);
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# ---- handles the player's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player1->{paddle};
            my $v_y        = $player1->{v_y};
           
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# handles AI's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player2->{paddle};
            my $v_y        = $player2->{v_y};
           
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# ---- handles Keyboard events
$app->add_event_handler(
    sub {
            my ( $event, $app ) = @_;
            # user pressing a key
            if ( $event->type == SDL_KEYDOWN ) {
                # up arrow key means going up (negative velocity)
                if ( $event->key_sym == SDLK_UP ) {
                    $player1->{v_y} = -500;
                }
                # down arrow key means going down (positive velocity)
                elsif ( $event->key_sym == SDLK_DOWN ) {
                    $player1->{v_y} = 500;
                }
            }
            # user releasing a key
            elsif ( $event->type == SDL_KEYUP ) {
                # up or down arrow keys released, stop the paddle
                if ( $event->key_sym==SDLK_UP or $event->key_sym== SDLK_DOWN ) {
                    $player1->{v_y} = $app->width/2;
                   
            }
        }
    }
);
# handles the ball movement
$app->add_move_handler (
    sub {
        my ( $step, $app )  = @_;
        my $ball_rect     = $ball->{rect};
       
        $ball_rect->x( $ball_rect->x +( $ball->{v_x} * $step));
        $ball_rect->y( $ball_rect->y +( $ball->{v_y} * $step));
       
        # collision to the bottom of the screen
        if ( $ball_rect->bottom >= $app->h ) {
            $ball_rect->bottom( $app->h );
            $ball->{v_y} *= -1;
        }
        # collision to the top of the screen
        elsif ( $ball_rect->top <= 0 ) {
            $ball_rect->top( 0 );
            $ball->{v_y} *= -1
        }
        # collision to the right: player1 score!
        elsif ( $ball_rect->right >= $app->w ) {
            $player1->{score}++;
            reset_game();
            return;
        }
        # collision to the right: player2 score!
        elsif ( $ball_rect->left <= 0 ) {
            $player2->{score}++;
            reset_game();
            return;
        }
    }
);

# let's roll!
$app->run;

sub reset_game {
    $ball->{rect}->x( $app->w/2 );
    $ball->{rect}->y( $app->h/2 );
}
-------------------------------------------------------------------------------------------------------------------------------

----------------------------------------------------------------------------------------------------------------------
 #!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDL::Events;
use SDLx::App;
use SDLx::Rect;
use SDLx::Text;
# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
    v_y        => 1,
    score   => 0,
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
    v_y       => 10,
    score  => 0,
};

my $ball = {
    rect => SDLx::Rect->new($app->w/2, $app->h/2, 10, 10),
    v_x => -2.7,
    v_y => 1.8,
};

my $score = SDLx::Text->new( font=>'font.ttf', h_align=>'center' );

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
            # render the ball
            $app->draw_rect( $ball->{rect}, 0xFF0000FF);
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# ---- handles the player's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player1->{paddle};
            my $v_y        = $player1->{v_y};
          
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# handles AI's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player2->{paddle};
            my $v_y        = $player2->{v_y};
          
            if ( $ball->{rect}->y > $paddle->y ) {
                $player2->{v_y} = 1.5;
            }
            elsif ( $ball->{rect}->y < $paddle->y) {
                $player2->{v_y} = -1.5;
            }
            else {
                $player2->{v_y} = 0;
            }
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# ---- handles Keyboard events
$app->add_event_handler(
    sub {
            my ( $event, $app ) = @_;
            # user pressing a key
            if ( $event->type == SDL_KEYDOWN ) {
                # up arrow key means going up (negative velocity)
                if ( $event->key_sym == SDLK_UP ) {
                    $player1->{v_y} = -500;
                }
                # down arrow key means going down (positive velocity)
                elsif ( $event->key_sym == SDLK_DOWN ) {
                    $player1->{v_y} = 50;
                }
            }
            # user releasing a key
            elsif ( $event->type == SDL_KEYUP ) {
                # up or down arrow keys released, stop the paddle
                if ( $event->key_sym==SDLK_UP or $event->key_sym== SDLK_DOWN ) {
                    $player1->{v_y} = 500;
                  
            }
        }
    }
);
# handles the ball movement
$app->add_move_handler (
    sub {
        my ( $step, $app )  = @_;
        my $ball_rect     = $ball->{rect};
      
        $ball_rect->x( $ball_rect->x +( $ball->{v_x} * $step));
        $ball_rect->y( $ball_rect->y +( $ball->{v_y} * $step));
      
        # collision to the bottom of the screen
        if ( $ball_rect->bottom >= $app->h ) {
            $ball_rect->bottom( $app->h );
            $ball->{v_y} *= -1;
        }
        # collision to the top of the screen
        elsif ( $ball_rect->top <= 0 ) {
            $ball_rect->top( 0 );
            $ball->{v_y} *= -1
        }
        # collision to the right: player1 score!
        elsif ( $ball_rect->right >= $app->w ) {
            $player1->{score}++;
            reset_game();
            return;
        }
        # collision to the right: player2 score!
        elsif ( $ball_rect->left <= 0 ) {
            $player2->{score}++;
            reset_game();
            return;
        }
        # collision width player1's paddle
        elsif ( check_collision( $ball_rect, $player1->{paddle} )) {
            $ball_rect->left( $player1->{paddle}->right );
            $ball->{v_x} *= -1;
        }
        # collision width player2's paddle
        elsif ( check_collision($ball_rect, $player2->{paddle} )) {
            $ball->{v_x} *= -1;
            $ball_rect->right($player2->{paddle}->left );
        }  
    }
);

# let's roll!
$app->run;

sub reset_game {
    $ball->{rect}->x( $app->w/2 );
    $ball->{rect}->y( $app->h/2 );
}

sub check_collision {
    my ( $A, $B ) = @_;
  
    return if $A->bottom < $B->top;
    return if $A->top        > $B->bottom;
    return if $A->right      < $B->left;
    return if $A->left       > $B->right;
  
    # we have collision
    return 1;  
}
-----------------------------------------------------------------------------------------------------------------------

 --------------------------------------------- SFARSIT -----------------------------------------------------

Invata Perl

Articole de pe perltrick.com

What's new on CPAN - September 2017
Mock APIs for free using JSON Schemas
What's new on CPAN - August 2017
Plotting With Perl 6
Git bisect and Perl
What's new on CPAN - July 2017
Pretty Printing Perl 6
What's new on CPAN - June 2017
What's New on CPAN - Annual Edition
What's new on CPAN - May 2017
On Sigils
What's new on CPAN - April 2017
Getting started with XS
Thinking about Perl 6
What's new on CPAN - March 2017
AWS Cloudfront cache invalidation with Paws
Track Module Changes While You Sleep
What's new on CPAN - February 2017
Deploy a static website with AWS S3 and Paws
What's new on CPAN - January 2017
Six more things I like about 6
Laptop review: Dell XPS 13 2-in-1 (9365)
What's new on CPAN - December 2016
Obscure Perl trick: single-quote separators
Perl module names are filepaths - and that's all
What's new on CPAN - November 2016
How to build a base module
I'm speaking at the London Perl Workshop 2016
How to upload a script to CPAN
What's new on CPAN - October 2016