view release on metacpan or  search on metacpan

examples/pulley.pl  view on Meta::CPAN

use strict;
use warnings;
use Box2D;
use SDL;
use SDL::Video;
use SDL::Events ':type';
use SDLx::App;

# pixels
my $width  = 400;
my $height = 400;

# pixels per meter
my $ppm = 10;

# meters per pixel
my $mpp = 1.0 / $ppm;

# frames per second
my $fps      = 60.0;
my $timestep = 1.0 / $fps;

# velocity iterations
my $vIters = 30;

# position iterations
my $pIters = 30;

my $gravity = make_vec2( 0, 9.8 );
my $world = Box2D::b2World->new( $gravity, 1 );

my $ground = make_ground();

my $platformA = make_platform(
    x       => s2w( $width / 4.0 ),
    y       => s2w( $height / 2.0 ),
    width   => s2w( $width / 3.0 ),
    height  => s2w( $width / 20.0 ),
    density => 0.11,
    color   => 0xFF0000FF,
);

my $platformB = make_platform(
    x       => s2w( 3.0 * $width / 4.0 ),
    y       => s2w( $height / 2.0 ),
    width   => s2w( $width / 3.0 ),
    height  => s2w( $width / 20.0 ),
    density => 0.1,
    color   => 0x00FF00FF,
);

my $groundAnchorA = make_vec2( $platformA->{body}->GetWorldCenter->x,
    s2w( $height * 0.1 ) );
my $groundAnchorB = make_vec2( $platformB->{body}->GetWorldCenter->x,
    s2w( $height * 0.1 ) );

my $joint = make_pulley_joint(
    bodyA         => $platformA->{body},
    bodyB         => $platformB->{body},
    groundAnchorA => $groundAnchorA,
    groundAnchorB => $groundAnchorB,
    anchorA       => $platformA->{body}->GetWorldCenter(),
    anchorB       => $platformB->{body}->GetWorldCenter(),
    ratio         => 1.0,
    maxLengthA    => s2w( $height * 0.8 ),
    maxLengthB    => s2w( $height * 0.8 ),
);

my $app = SDLx::App->new(
    width  => $width,
    height => $height,
    dt     => $timestep,
    min_t  => $timestep / 2,
    flags  => SDL_DOUBLEBUF | SDL_HWSURFACE,
    eoq    => 1,
);

my @balls;

$app->add_event_handler(
    sub {
        my ($event) = @_;
        return unless $event->type == SDL_MOUSEBUTTONDOWN;
        my ( undef, $x, $y ) = @{ SDL::Events::get_mouse_state() };
        push @balls,
            make_ball(