#!/usr/bin/perl

############################################################################
#
# tkballs.pl 1.1 - Object-oriented Animation of a bunch of Balls in Perl/Tk.
#
# Copyright (C) 2015, 2017, Hauke Lubenow, Germany.
#
# License: GNU GPL (version 3 or above):
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
############################################################################

use warnings;
use strict;

use Tk;

package BallWindow {

    sub new {
        my $classname = shift;
        my $self = {screenx => 640,
                    screeny => 480,
                    speed   => 5,
                    running => 0};
        return bless($self, $classname);
    }

    sub runApplication {
        my $self = shift;
        $self->initBalls();
        $self->showWindow();
    }

    sub initBalls {
        my $self = shift;
        $self->{balls} = [Ball->new(name => "Ball1",
                                    x => $self->toX(40),
                                    y => $self->toY(30),
                                    color => "red",
                                    direction => "11"),

                          Ball->new(name => "Ball2",
                                    x => $self->toY(1.5),
                                    y => $self->toY(1.5),
                                    color => "blue"),

                          Ball->new(name => "Ball3",
                                    x => $self->toX(2.5),
                                    y => $self->toY(2.5),
                                    color => "green"),

                          Ball->new(name => "Ball4",
                                    x => $self->toX(2),
                                    y => $self->toY(10),
                                    color => "cyan"),

                          Ball->new(name => "Ball5",
                                    x => $self->toX(5),
                                    y => $self->toY(5),
                                    color => "yellow")];
    }

    sub toX {
        my $self = shift;
        return $self->{screenx} / shift;
    }

    sub toY {
        my $self = shift;
        return $self->{screeny} / shift;
    }

    sub showWindow {
        my $self = shift;
        $self->{mw} = MainWindow->new();
        $self->{mw}->optionAdd("*font", "Arial 12 normal");
        $self->{mw}->title("TkBalls");
        my $geomstr = int($self->{screenx} * 1.25);
        $geomstr .= "x";
        $geomstr .= int($self->{screeny} * 1.25);
        $geomstr .= "+108+64";
        $self->{mw}->geometry($geomstr);
        $self->{mw}->bind('<Control-q>', sub { $self->{mw}->destroy() });
        $self->{cv} = $self->{mw}->Canvas(bg => "white",
                                          width => $self->{screenx},
                                          height => $self->{screeny});
        $self->{cv}->pack(-padx => 20, -pady => 20);
        $self->{fr1} = $self->{mw}->Frame();
        $self->{btn_start} = $self->{fr1}->Button(-text => "Start",
                                                  -command => sub { $self->startMoving() });
        $self->{btn_start}->focus();
        $self->{btn_stop} = $self->{fr1}->Button(-text => "Stop",
                                                 -command => sub { $self->stopMoving() });
 
        $self->{btn_exit} = $self->{mw}->Button(-text => "Exit",
                                                -command => sub { $self->{mw}->destroy() });
        $self->{btn_start}->pack(-side => "left", -padx => 50);
        $self->{btn_stop}->pack(-side => "left", -padx => 50);
        $self->{fr1}->pack();
        $self->{btn_exit}->pack(-side => "right", -padx => 5, -pady => 5);
        $self->moveBalls();
        $self->{mw}->MainLoop();
    }

    sub moveBalls {
        my $self = shift;
        my @balls = @{$self->{balls}};
        my $i;
        foreach $i (@balls) {
            $i->clearDirChange();
            $self->checkCollisions();
            $i->moveBall($self->{screenx}, $self->{screeny});
            $self->{mw}->after($self->{speed}, sub { $self->drawBall($i) });
        }
        if ($self->{running} == 1) {
            $self->{mw}->after($self->{speed}, sub { $self->moveBalls() });
        }
    }

    sub startMoving {
        my $self = shift;
        if ($self->{running} == 1) {
            return;
        }
        $self->{running} = 1;
        $self->moveBalls();
    }

    sub stopMoving {
        my $self = shift;
        $self->{running} = 0;
    }

    sub checkCollisions {
        my $self = shift;
        my @balls = @{$self->{balls}};
        my $i;
        my $u;
        my @checkedballs = ();
        foreach $i (@balls) {
            foreach $u (@balls) {
                if ($i->getName() eq $u->getName()) {
                    next;
                }
                if ($self->alreadyChecked($u, @checkedballs) == 1) {
                    next;
                }
                $i->checkCollision($u, $self->{screenx}, $self->{screeny});
            }
            push(@checkedballs, $i);
        }
    }

    sub alreadyChecked {
        my $self = shift;
        my $ball = shift;
        my @checkedballs = @_;
        my $i;
        foreach $i (@checkedballs) {
            if($ball->getName() eq $i->getName()) {
                return 1;
            }
        }
        return 0;
    }

    sub drawBall {
        my $self = shift;
        my $ball = shift;
        my $id = $ball->getId();
        if ($id != -1) {
            $self->{cv}->delete($id);
        }
        my $x = $ball->getX();
        my $y = $ball->getY();
        my $color = $ball->getColor();
        my $size = $ball->getSize();
        $id = $self->{cv}->createOval($x - $size,
                                      $y - $size,
                                      $x + $size,
                                      $y + $size, -fill => $color);
        $ball->setId($id);
    }
}

package Ball {

    sub new {
        my $classname = shift;
        my $args = {@_};
        my $self = {name       => $args->{name} || "Ball1",
                    x          => $args->{x} || 0,
                    y          => $args->{y} || 0,
                    color      => $args->{color} || "black",
                    size       => $args->{size} || 15,
                    id         => $args->{id} || -1,
                    direction  => $args->{direction} || "xx",
                    dirchanged => 0};
        if ($self->{direction} eq "xx") {
            my @directions = ("00", "01", "10", "11");
            $self->{direction} = $directions[int(rand(4))];
        }
        return bless($self, $classname);
    };

    sub getX {
        my $self = shift;
        return $self->{x};
    }

    sub setX {
        my $self = shift;
        $self->{x} = shift;
    }

    sub getY {
        my $self = shift;
        return $self->{y};
    }

    sub setY {
        my $self = shift;
        $self->{y} = shift;
    }

    sub getColor {
        my $self = shift;
        return $self->{color};
    }

    sub getName {
        my $self = shift;
        return $self->{name};
    }

    sub getId {
        my $self = shift;
        return $self->{id};
    }

    sub getSize {
        my $self = shift;
        return $self->{size};
    }

    sub setId {
        my $self = shift;
        $self->{id} = shift;
    }

    sub moveBall {
        my $self = shift;
        my $screenx = shift;
        my $screeny = shift;
        my $xdir = substr($self->{direction}, 0, 1);
        my $newxdir = $xdir;
        my $ydir = substr($self->{direction}, 1, 1);
        my $newydir = $ydir;
        if ($xdir == 0) {
            if ($self->{x} <= $self->{size}) {
                $newxdir = 1;
            } else {
                $self->{x}--;
            }
        }
        if ($xdir == 1) {
            if ($self->{x} >= $screenx - $self->{size}) {
                $newxdir = 0;
            } else {
                $self->{x}++;
            }
        }
        if ($ydir == 0) {
            if ($self->{y} <= $self->{size}) {
                $newydir = 1;
            } else {
                $self->{y}--;
            }
        }
        if ($ydir == 1) {
            if ($self->{y} >= $screeny - $self->{size}) {
                $newydir = 0;
            } else {
                $self->{y}++;
            }
        }
        $self->{direction} = "$newxdir$newydir";
    }

    sub checkCollision {
        my $self = shift;
        if ($self->{dirchanged} == 1) {
            return;
        }
        my $otherball = shift;
        my $screenx = shift;
        my $screeny = shift;
        my $otherx = $otherball->getX();
        my $othery = $otherball->getY();
        my $othersize = $otherball->getSize();

        if ($otherx - $othersize < $self->{x} + $self->{size} &&
            $otherx + $othersize > $self->{x} - $self->{size} &&
            $othery - $othersize < $self->{y} + $self->{size} &&
            $othery + $othersize > $self->{y} - $self->{size}) {
            $self->changeDirection();
            # If the balls are too close , they keep changing directions
            # and "stick" to each other. So at least on ball needs
            # to be moved away a bit:
            $self->moveBall($screenx, $screeny);
            $otherball->changeDirection();
        }
    }

    sub changeDirection {
        my $self = shift;
        my $newdir = "";
        if (substr($self->{direction}, 0, 1) eq "0") {
            $newdir .= "1";
        } else {
            $newdir .= "0";
        }
        if (substr($self->{direction}, 1, 1) eq "0") {
            $newdir .= "1";
        } else {
            $newdir .= "0";
        }
        $self->{direction} = $newdir;
        $self->{dirchanged} = 1;
    }

    sub clearDirChange {
        my $self = shift;
        $self->{dirchanged} = 0;
    }
}

my $bw = BallWindow->new();
$bw->runApplication();