add/collapse/explode bouncing balls

ball.pl

#!/usr/bin/env perl

=head1 NAME

balls.pl - add/collapse/explode bouncing balls

=head1 SYNOPSIS

    ./balls.pl

=head1 USAGE

Press "a" to add more bouncing balls on the screen and enjoy.
Press "esc" to exit.

=head1 DESCRIPTION

Simple bouncing ball SDL example/demo for fun to watch.

Video/Screencast: L<https://youtu.be/Y8Mo77MufJM>,
Blog Post: L<https://blog.kutej.net/2018/12/balls-pl>

=cut

use 5.010;
use utf8;
use strict;
use warnings;

use SDL;
use SDL::Video;
use SDL::Rect;
use SDL::Events;
use SDLx::Controller;
use SDLx::Surface;
use SDLx::Text;

use List::Util qw(max);
use Time::HiRes qw(time);
use Carp qw(confess);


my $app          = init();
my $game         = SDLx::Controller->new(dt => 0.2, delay => 10);
my $add_time     = 0;
my $add_key_time = 0;
my $key_add_down = 0;
my $text         = SDLx::Text->new(h_align => 'center');

my @balls;

sub init {
    confess 'Cannot init  ' . SDL::get_error()
        if (SDL::init(SDL_INIT_VIDEO) == -1);

    my $win =
        SDL::Video::set_video_mode(800, 600, 32, SDL_HWSURFACE | SDL_DOUBLEBUF | SDL_HWACCEL);
    confess 'Cannot init video mode 800x600x32: ' . SDL::get_error()
        unless $win;

    return SDLx::Surface->new(surface => $win);
}

sub on_event {
    my ($event, $app) = @_;

    if ($event->type == SDL_KEYDOWN) {
        my $key = $event->key_sym;
        if ($key == SDLK_ESCAPE) {
            exit();
        }
        if ($key == ord('a')) {
            $key_add_down = 1;
        }
    }
    elsif ($event->type == SDL_KEYUP) {
        my $key = $event->key_sym;

        if ($key == ord('a')) {
            $key_add_down = 0;
        }
    }
    elsif ($event->type == SDL_QUIT) {
        exit;
    }
}

sub on_move {
    my $dt = shift;

    # add balls while key pressed or after some time
    if (($key_add_down && $add_key_time <= time()) || (($add_time <= time()) && (@balls < 100))) {
        add_ball();
    }

    foreach my $r_ball (@balls) {
        my $transform = ball_confine($app->w, $app->h, $r_ball->{x}, $r_ball->{y}, $r_ball->{r});
        $r_ball->{x_vel} *= $transform->[0];
        $r_ball->{y_vel} *= $transform->[1];

        # special cases when ball grows outside the range, bouncing will not help, force direction inside
        $r_ball->{x_vel} = abs($r_ball->{x_vel})
            if ($r_ball->{x} < $r_ball->{r});
        $r_ball->{x_vel} = abs($r_ball->{x_vel}) * -1
            if ($r_ball->{x} + $r_ball->{r} > $app->w);
        $r_ball->{y_vel} = abs($r_ball->{y_vel})
            if ($r_ball->{y} < $r_ball->{r});
        $r_ball->{y_vel} = abs($r_ball->{y_vel}) * -1
            if ($r_ball->{y} + $r_ball->{r} > $app->h);

        $r_ball->{x} += $r_ball->{x_vel} * $dt;
        $r_ball->{y} += $r_ball->{y_vel} * $dt;
    }

    for (my $i = 0; $i < @balls; $i++) {
        my $cball = $balls[$i];
        next unless $cball;

        # check for collision
        my $i2 = $i + 1;
        my $oball;
        for (; $i2 < @balls; $i2++) {
            $oball = $balls[$i2];
            next unless $oball;
            my $dist_2 =
                abs(($cball->{x} - $oball->{x})**2) + abs(($cball->{y} - $oball->{y})**2);
            my $r1r2_2 = ($cball->{r} + $oball->{r})**2;
            last if $dist_2 <= $r1r2_2;
        }

        # found collision
        if ($i2 < @balls) {

            # bigger ball surface will grow by the surface of the smaller one
            my $cball_new_r = sqrt($cball->{r}**2 + $oball->{r}**2);
            if ($cball->{r} < $oball->{r}) {
                %$cball = %$oball;
            }
            $cball->{r} = $cball_new_r;

            # if grown too big → explode into small balls
            if ($cball->{r} > 20 && (rand(max(1, 50 - $cball->{r})) < 1)) {
                while (1) {
                    my $nball = add_ball();
                    $nball->{x} = $cball->{x} + $nball->{x_vel};
                    $nball->{y} = $cball->{y} + $nball->{y_vel};
                    $nball->{r} = 2 + rand(8);
                    my $cball_new_r2 = $cball->{r}**2 - $nball->{r}**2;
                    last if $cball_new_r2 <= 0;
                    $cball->{r} = sqrt($cball_new_r2);
                }
                $balls[$i] = undef;
            }
            $balls[$i2] = undef;
        }
    }
    @balls = grep {$_} @balls;

    return 1;
}

sub on_show {
    # clear window
    SDL::Video::fill_rect(
        $app,
        SDL::Rect->new(0, 0, $app->w, $app->h),
        SDL::Video::map_RGB($app->format, 0, 0, 0)
    );

    for (my $i = 0; $i < @balls; $i++) {
        my $cball = $balls[$i];
        $app->draw_circle_filled([$cball->{x}, $cball->{y}], $cball->{r}, $cball->{color});
    }

    # show number of balls
    $text->bold(1);
    $text->text(scalar(@balls));
    $text->write_xy($app, ($app->w - $text->w) / 2, ($app->h - $text->h) / 2);

    SDL::Video::flip($app);

    return 0;
}

sub add_ball {
    $add_time     = time() + 30;
    $add_key_time = time() + 0.3;
    my $nball = {
        x     => $app->w / 2,
        y     => $app->h / 2,
        r     => 5 + rand(10),
        x_vel => (1 + rand(100)) * (int(rand(2)) == 0 ? -1 : 1),
        y_vel => (1 + rand(100)) * (int(rand(2)) == 0 ? -1 : 1),
        color => [rand(255), rand(255), rand(255)],
    };
    push(@balls, $nball);
    return $nball;
}

sub ball_confine {
    my ($w, $h, $x, $y, $r) = @_;

    my ($m_x, $m_y) = (1, 1);
    $m_x = -1 if $x + $r >= $w || $x <= $r;
    $m_y = -1 if $y + $r >= $h || $y <= $r;

    return [$m_x, $m_y];
}

my $move_id  = $game->add_move_handler(\&on_move);
my $event_id = $game->add_event_handler(\&on_event);
my $show_id  = $game->add_show_handler(\&on_show);

say 'press "a" to add more bouncing balls';
say 'press "esc" to exit';
$game->run();